VBA-FOR-AutoCAD

1、 AutoCAD培訓(xùn)-高級(jí)篇AutoCAD Training-Advanced Yard of Choice07/17/201302021/8/6Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇1為什么要學(xué)為什么要學(xué)VBAVBA呢？呢？大家試想一下，我們每天畫圖過程中有哪些工作是重復(fù)性大家試想一下，我們每天畫圖過程中有哪些工作是重復(fù)性的呢？這些重復(fù)性的工作當(dāng)然有些可以用復(fù)制粘貼來實(shí)現(xiàn)，有的呢？這些重復(fù)性的工作當(dāng)然有些可以用復(fù)制粘貼來實(shí)現(xiàn)，有些只是相似的呢？是不是可以用程序來實(shí)現(xiàn)。些只是相似的呢？是不是可以

2、用程序來實(shí)現(xiàn)。大家試一下畫一個(gè)下面的圖形?？赡芎芎唵?，我改變一下大家試一下畫一個(gè)下面的圖形。可能很簡單，我改變一下尺寸呢？尺寸呢？編程的語言有很多種，為什么要選擇編程的語言有很多種，為什么要選擇VBAVBA呢？呢？lAutoCADAutoCAD內(nèi)置，不必安裝單獨(dú)的編程語言；內(nèi)置，不必安裝單獨(dú)的編程語言；l語言的可讀性強(qiáng)，易于上手，對(duì)于業(yè)余的我們更適合；語言的可讀性強(qiáng)，易于上手，對(duì)于業(yè)余的我們更適合；用得人多，易于交流學(xué)習(xí)。用得人多，易于交流學(xué)習(xí)。為什么要學(xué)VBA1Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇

3、高級(jí)篇2 AutoCAD自帶的批量處理命令 VBA直線、圓與圓弧 VBA多義線 VBA編輯-COPY, MOVE, Array, Offset, Rotate, Mirror VBA文字標(biāo)注 VBA其它輔助功能-Debug.Print, MsgBox 從Excel中讀取數(shù)據(jù)目錄Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇3第1部分：AutoCAD自帶的批量處理命令3內(nèi)容Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高

4、級(jí)篇4第2部分：VBA直線、圓與圓弧4課后練習(xí)具體內(nèi)容，1，2，3Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇5第3部分：VBA多義線5課后練習(xí)具體內(nèi)容，1，2，3Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇6第4部分：VBA編輯-COPY, MOVE, Array, Offset, Rotate, Mirror6課后練習(xí)具體內(nèi)容，1，2，3Yard of ChoiceCIMC RAFFLES 2013 AL

5、L RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇7第5部分：VBA文字標(biāo)注7課后練習(xí)具體內(nèi)容，1，2，3Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇8第5部分：VBA其它輔助功能-Debug.Print, MsgBox8課后練習(xí)具體內(nèi)容，1，2，3Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇9第6部分：從Excel中讀取數(shù)據(jù)9課后練習(xí)具體內(nèi)容，1，2，3Yard of ChoiceCIM

6、C RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇10大家感覺怎么樣呢？這些內(nèi)容是不是可以做一些略復(fù)雜的圖形了呢？下面我們來做一個(gè)綜合的練習(xí)吧。10大家如果有興趣進(jìn)一步學(xué)習(xí)，大家可以一起學(xué)習(xí)。最后，給大家留個(gè)課后作業(yè)，看一下這個(gè)圖形如何用程序來實(shí)現(xiàn)。Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇11我的聯(lián)系方式11電話內(nèi)線：79166手機(jī)mail: Guangyin.Xiacimc-Yard of

7、 ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇12Your Offshore Partner12Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇13ArrayTrim動(dòng)態(tài)塊Quick Select格式刷繪圖模板AutoCAD自帶的批量處理命令下面就各個(gè)功能簡單作一下示例Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇14我們知道，在我們知道

8、，在CADCAD中，畫直線需要確實(shí)中，畫直線需要確實(shí)2 2個(gè)點(diǎn)，起點(diǎn)和終點(diǎn)，個(gè)點(diǎn)，起點(diǎn)和終點(diǎn)，同樣，在同樣，在VBAVBA中，也是確定兩個(gè)點(diǎn)。中，也是確定兩個(gè)點(diǎn)。第一種方式，以坐標(biāo)的形式給定兩個(gè)點(diǎn)。第一種方式，以坐標(biāo)的形式給定兩個(gè)點(diǎn)。Sub Line0()Sub Line0()Dim MyLine as AcadLineDim MyLine as AcadLineDim PntSt(2) as double, PntEn(2) as doubleDim PntSt(2) as double, PntEn(2) as doublePntSt(0)=0#:PntSt(1)=0#:PntSt(2)=

9、0#PntSt(0)=0#:PntSt(1)=0#:PntSt(2)=0#PntEn(0)=100:PntEn(1)=100:PntEn(2)=0#PntEn(0)=100:PntEn(1)=100:PntEn(2)=0#Set MyLine=Thisdrawing.Modelspace.Addline(PntSt, PSet MyLine=Thisdrawing.Modelspace.Addline(PntSt, PntEn)ntEn)Myline.Color=acRedMyline.Color=acRedEnd subEnd subVBA直線、圓與圓弧14Yard of ChoiceCIM

10、C RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇15第二種方式，以拾取的形式給定兩個(gè)點(diǎn)。第二種方式，以拾取的形式給定兩個(gè)點(diǎn)。Sub Line0()Sub Line0()Dim MyLine as AcadLineDim MyLine as AcadLineDim PntSt as Variant, PntEn as VariantDim PntSt as Variant, PntEn as VariantWith Thisdrawing.UtilityWith Thisdrawing.UtilityPntSt=.getPoint(, Pi

11、ck the start point:)PntSt=.getPoint(, Pick the start point:)PntEn=.getPoint(, Pick the end point:)PntEn=.getPoint(, Pick the end point:)End withEnd withSet MyLine=Thisdrawing.Modelspace.Addline(PntSt, PSet MyLine=Thisdrawing.Modelspace.Addline(PntSt, PntEn)ntEn)Myline.Color=acRedMyline.Color=acRedEn

12、d subEnd subVBA直線、圓與圓弧15Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇16利用判斷來連續(xù)畫線，以回車或利用判斷來連續(xù)畫線，以回車或ESCESC鍵來結(jié)束畫線鍵來結(jié)束畫線Sub MyLine()Sub MyLine()On Error Resume NextOn Error Resume NextDim Pt0 As VariantDim Pt0 As VariantPt0 = ThisDrawing.Utility.GetPoint(, Start point)Pt0 = This

13、Drawing.Utility.GetPoint(, Start point) If Err Then If Err Then Err.Clear Err.Clear Exit Sub Exit Sub End If End IfDim PtPrevious As Variant, PtCurrent As VariantDim PtPrevious As Variant, PtCurrent As VariantPtPrevious = Pt0PtPrevious = Pt0VBA直線、圓與圓弧16Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESE

14、RVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇17NextPoint:NextPoint:PtCurrent = ThisDrawing.Utility.GetPoint(PtPrevious, NePtCurrent = ThisDrawing.Utility.GetPoint(PtPrevious, Next point)xt point) If Err Then If Err Then Err.Clear Err.Clear Exit Sub Exit Sub End If End IfDim MyLine As AcadLineDim MyLine As AcadLine Set MyL

15、ine = ThisDrawing.ModelSpace.AddLine(PtPrevio Set MyLine = ThisDrawing.ModelSpace.AddLine(PtPrevious, PtCurrent)us, PtCurrent)PtPrevious = PtCurrentPtPrevious = PtCurrentGoTo NextPointGoTo NextPointEnd SubEnd SubVBA直線、圓與圓弧17Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇18用用VBA

16、VBA畫圓畫圓我們知道，在我們知道，在CADCAD中有多種畫圓的方式，包括圓心、半徑；中有多種畫圓的方式，包括圓心、半徑；圓心、直徑；三點(diǎn)；切點(diǎn)、切點(diǎn)和半徑。而程序中只給出了一圓心、直徑；三點(diǎn)；切點(diǎn)、切點(diǎn)和半徑。而程序中只給出了一種方式畫圓，也就是圓心、半徑，其余的要通過程序計(jì)算來得種方式畫圓，也就是圓心、半徑，其余的要通過程序計(jì)算來得到。到。圓心與半徑畫圓，圓心可以是圓心與半徑畫圓，圓心可以是doubledouble型數(shù)組，也可以是強(qiáng)型數(shù)組，也可以是強(qiáng)制賦值的變量，但是，最終用在畫圓是它都是一維的數(shù)組。制賦值的變量，但是，最終用在畫圓是它都是一維的數(shù)組。Sub Circle0()Sub Ci

17、rcle0()Dim MyCir as AcadCircle, MyCir0 as AcadCircleDim MyCir as AcadCircle, MyCir0 as AcadCircleDim PntCen as VariantDim PntCen as Variantdim PntCen0(2) as double, Dim Radius as doubledim PntCen0(2) as double, Dim Radius as doubleVBA直線、圓與圓弧18Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCA

18、D培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇19With Thisdrawing.UtilityWith Thisdrawing.UtilityPntCen=.getPoint(, Pick the center of the circle:)PntCen=.getPoint(, Pick the center of the circle:)Radius=.getDistance(, Input the radius of the circle:)Radius=.getDistance(, Input the radius of the circle:)End withEnd withPntCen0(0)=0#:

19、PntCen0(1)=0#:PntCen0(2)=0#PntCen0(0)=0#:PntCen0(1)=0#:PntCen0(2)=0#With Thisdrawing.ModelSpaceWith Thisdrawing.ModelSpaceSet MyCir=.AddCircle(PntCen, Radius)Set MyCir=.AddCircle(PntCen, Radius)Set MyCir0=.AddCircle(PntCen0, Radius)Set MyCir0=.AddCircle(PntCen0, Radius)End WithEnd WithMyCir.Color=ac

20、RedMyCir.Color=acRedMyCir0.Color=acMagentaMyCir0.Color=acMagentaEnd subEnd subVBA直線、圓與圓弧19Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇20用用VBAVBA畫圓弧畫圓弧VBAVBA中只有一種畫圓弧的方式，包括圓心、半徑、起始角、中只有一種畫圓弧的方式，包括圓心、半徑、起始角、終止角。其余的要通過程序計(jì)算來得到。終止角。其余的要通過程序計(jì)算來得到。圓心與圓一樣可以是圓心與圓一樣可以是doubledouble型數(shù)組，也

21、可以是強(qiáng)制賦值的型數(shù)組，也可以是強(qiáng)制賦值的變量，但是，最終用在畫圓弧是它都是一維的數(shù)組。起始角與變量，但是，最終用在畫圓弧是它都是一維的數(shù)組。起始角與終止角都是弧度，范圍為終止角都是弧度，范圍為0, 20, 2) )Sub Arc0()Sub Arc0()Dim Arc0 as AcadArcDim Arc0 as AcadArcDim PntCen as VariantDim PntCen as Variantdim Radius as double, AngSt as double, AngEn as dodim Radius as double, AngSt as double, Ang

22、En as doubleubleVBA直線、圓與圓弧20Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇21With Thisdrawing.UtilityWith Thisdrawing.UtilityPntCen=.getPoint(, Pick the center of the arc:)PntCen=.getPoint(, Pick the center of the arc:)Radius=.getDistance(, Input the radius of the circle:)Radiu

23、s=.getDistance(, Input the radius of the circle:)End withEnd withDim Pi as doubleDim Pi as doublePi=4Pi=4* *Atn(1)Atn(1)AngSt=-Pi/4AngSt=-Pi/4AngEn=3AngEn=3* *pi/4pi/4Set Arc0=Set Arc0=Thisdrawing.ModelSpaceThisdrawing.ModelSpace.AddArc(PntCen, Radius, Ang.AddArc(PntCen, Radius, AngSt, AngEn)St, Ang

24、En)Arc0.Color=acBlueArc0.Color=acBlueEnd subEnd subVBA直線、圓與圓弧21思考題：如何用三點(diǎn)來畫一個(gè)圓思考題：如何用三點(diǎn)來畫一個(gè)圓Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇22在在VBAVBA中用三點(diǎn)畫一個(gè)圓中用三點(diǎn)畫一個(gè)圓我們先來回顧一下用尺規(guī)作圖時(shí)如何用三點(diǎn)來作圓的。我們是我們先來回顧一下用尺規(guī)作圖時(shí)如何用三點(diǎn)來作圓的。我們是先來做其中兩條張的垂直平分線。在先來做其中兩條張的垂直平分線。在VBAVBA中我們也可以用這個(gè)思中我們也可以用這個(gè)思路來

25、做這個(gè)圓。下面的圖中給出了作圖的順序。路來做這個(gè)圓。下面的圖中給出了作圖的順序。VBA直線、圓與圓弧22Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇23下面我們來看在下面我們來看在VBAVBA中用三點(diǎn)畫一個(gè)圓的程序代碼中用三點(diǎn)畫一個(gè)圓的程序代碼Sub ThreePointCircle()Sub ThreePointCircle()Dim Pnt0 as Variant, Pnt1 as Variant, Pnt2 as VariantDim Pnt0 as Variant, Pnt1 as Varia

26、nt, Pnt2 as VariantDim Ang01 as double, Ang02 as doubleDim Ang01 as double, Ang02 as doubleDim Pi as doubleDim Pi as doublePi=4Pi=4* *Atn(1)Atn(1)Dim Arc01 as AcadArc, Arc02 as AcadArcDim Arc01 as AcadArc, Arc02 as AcadArcDim Line01 as AcadLine, Line02 as AcadLineDim Line01 as AcadLine, Line02 as Ac

27、adLineDim PntCen as VariantDim PntCen as VariantDim Pnt01S as Variant, Pnt01E as Variant, Pnt02S as VaDim Pnt01S as Variant, Pnt01E as Variant, Pnt02S as Variant, Pnt02E as Variantriant, Pnt02E as VariantVBA直線、圓與圓弧23Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇24With Thisdraw

28、ing.UtilityWith Thisdrawing.UtilityPnt0=.getPoint(, Pnt0=.getPoint(, Pick the first point:Pick the first point: ) )Pnt1=.getPoint(, Pnt1=.getPoint(, Pick the second point:Pick the second point: ) )Pnt2=.getPoint(, Pnt2=.getPoint(, Pick the third point:Pick the third point: ) )Ang01=.AngleFromXAxis(P

29、nt0, Pnt1)Ang01=.AngleFromXAxis(Pnt0, Pnt1)Ang02=.AngleFromXAxis(Pnt0, Pnt2)Ang02=.AngleFromXAxis(Pnt0, Pnt2)End withEnd withDim Pnt01(2) as double, Pnt02(2) as double, Dim Pnt01(2) as double, Pnt02(2) as double, i as integeri as integerFor i=0 to 2 Step 1For i=0 to 2 Step 1Pnt01(i)=(Pnt0(i)+Pnt1(i)

30、/2Pnt01(i)=(Pnt0(i)+Pnt1(i)/2Pnt02(i)=(Pnt0(i)+Pnt2(i)/2Pnt02(i)=(Pnt0(i)+Pnt2(i)/2Next iNext iVBA直線、圓與圓弧24Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇25With TWith Thisdrawing.ModelSpacehisdrawing.ModelSpaceSet Arc01=.AddArc(Pnt01, 100, Ang01-Pi/2, Ang01+Pi/2)Set Arc01=.AddA

31、rc(Pnt01, 100, Ang01-Pi/2, Ang01+Pi/2)Set Arc02=.AddArc(Pnt02, 100, Ang02-Pi/2, Ang02+Pi/2)Set Arc02=.AddArc(Pnt02, 100, Ang02-Pi/2, Ang02+Pi/2)Pnt01S=Arc01.StartPointPnt01S=Arc01.StartPointPnt01E=Arc01.EndPointPnt01E=Arc01.EndPointPnt02S=Arc02.StartPointPnt02S=Arc02.StartPointPnt02E=Arc02.EndPointP

32、nt02E=Arc02.EndPointSet Line01=.AddLine(Pnt01S, Pnt01E)Set Line01=.AddLine(Pnt01S, Pnt01E)Set Line02=.Addline(Pnt02S, Pnt02E)Set Line02=.Addline(Pnt02S, Pnt02E)End WithEnd WithPntCen=Line01.IntersectWith(Line02, AcExtendBoth)PntCen=Line01.IntersectWith(Line02, AcExtendBoth)Dim Radius as doubleDim Ra

33、dius as doubleVBA直線、圓與圓弧25Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇26Radius=Distance(PntCen, Pnt0)Radius=Distance(PntCen, Pnt0)Dim MyCir as AcadCirCleDim MyCir as AcadCirCleSet MyCir=ThisDrawing.Modelspace.AddCircle(PntCen, Radius)Set MyCir=ThisDrawing.Modelspace.AddCircl

34、e(PntCen, Radius)Line01.deleteLine01.deleteLine02.DeleteLine02.DeleteArc01.DeleteArc01.DeleteArc02.DeleteArc02.DeleteEnd subEnd sub其中的其中的DistanceDistance是求兩點(diǎn)之間的矩離，而是求兩點(diǎn)之間的矩離，而VBAVBA本身并沒有提供這個(gè)函數(shù)，本身并沒有提供這個(gè)函數(shù)，需要自己定義一個(gè)這樣的函數(shù)。這樣的函數(shù)就是先用兩點(diǎn)畫一條直線，需要自己定義一個(gè)這樣的函數(shù)。這樣的函數(shù)就是先用兩點(diǎn)畫一條直線，VBAVBA中提供了直線的長度這個(gè)函數(shù)，所以可以用直線的長度得到。

35、之后中提供了直線的長度這個(gè)函數(shù)，所以可以用直線的長度得到。之后我們把這條直線再刪除就可以了。我們把這條直線再刪除就可以了。VBA直線、圓與圓弧26Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇27Private Function Distance(Pt0 as Variant, Pnt1 as Variant) aPrivate Function Distance(Pt0 as Variant, Pnt1 as Variant) as doubles doubleDim Line0 as AcadLin

36、eDim Line0 as AcadLineSet Line0=Thisdrawing.ModelSpace.AddLine(Pt0, Pt1)Set Line0=Thisdrawing.ModelSpace.AddLine(Pt0, Pt1)Distance=Line0.LengthDistance=Line0.LengthLine0.DeleteLine0.DeleteEnd FunctionEnd FunctionVBA直線、圓與圓弧27思考題：思考題：如何用起點(diǎn)、終點(diǎn)和半徑畫圓??？如何用起點(diǎn)、終點(diǎn)和半徑畫圓??？Yard of ChoiceCIMC RAFFLES 2013 ALL RI

37、GHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇28在在VBAVBA中有多義線和二維多義線，其中的二維多義線一個(gè)頂點(diǎn)有中有多義線和二維多義線，其中的二維多義線一個(gè)頂點(diǎn)有2 2個(gè)坐個(gè)坐標(biāo)值，而多義線的一個(gè)頂點(diǎn)有標(biāo)值，而多義線的一個(gè)頂點(diǎn)有3 3個(gè)坐標(biāo)值。我們只講二維多義線，定義個(gè)坐標(biāo)值。我們只講二維多義線，定義為為AcadLWPolylineAcadLWPolyline。Sub MyPolyline()Sub MyPolyline()Dim MyPline as acadLWPolylineDim MyPline as acadLWPolylineDim Pnt(7) as doub

38、leDim Pnt(7) as doubleDim PntSt as VariantDim PntSt as VariantPntSt=Thisdrawing.Utility.getPoint(, PntSt=Thisdrawing.Utility.getPoint(, Pick the start pointPick the start point ) )Pnt(0)=PntSt(0):Pnt(1)=PntSt(1)Pnt(0)=PntSt(0):Pnt(1)=PntSt(1)Pnt(2)=PntSt(0)+200:Pnt(3)=PntSt(1)Pnt(2)=PntSt(0)+200:Pnt

39、(3)=PntSt(1)Pnt(4)=PntSt(0)+200:Pnt(5)=PntSt(1)+18Pnt(4)=PntSt(0)+200:Pnt(5)=PntSt(1)+18Pnt(6)=PntSt(0):pnt(7)=PntSt(1)+18Pnt(6)=PntSt(0):pnt(7)=PntSt(1)+18Set MyPline=Thisdrawing.ModelSpace.AddLightWeightPolyline(PnSet MyPline=Thisdrawing.ModelSpace.AddLightWeightPolyline(Pnt)t)VBA多義線28Yard of Choi

40、ceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇29MyPline.Closed=TrueMyPline.Closed=TrueMyPline.Color=acGreenMyPline.Color=acGreenEnd subEnd subVBA多義線29二維多義線的凸度問題。我們知道，在二維多義線的凸度問題。我們知道，在CADCAD的二維多義線中有圓弧的問的二維多義線中有圓弧的問題，在題，在VBAVBA中同樣也有這個(gè)問題。它所實(shí)現(xiàn)圓弧的作法就是設(shè)置它的凸中同樣也有這個(gè)問題。它所實(shí)現(xiàn)圓弧的作法就是設(shè)置它的凸度。凸度的值為圓心角的

41、度。凸度的值為圓心角的1/41/4的正切值。下面以實(shí)例來說明這個(gè)問題。的正切值。下面以實(shí)例來說明這個(gè)問題。我們先來畫個(gè)人孔。下面的我們先來畫個(gè)人孔。下面的0 0，與，與2 2是圓弧的起始點(diǎn)，圓心角為是圓弧的起始點(diǎn)，圓心角為，所，所以它的以它的1/41/4為為/4,/4,正切值為正切值為1 1。其余點(diǎn)的凸度都設(shè)為。其余點(diǎn)的凸度都設(shè)為0.0.Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇30Sub Manhole()Sub Manhole()Dim MyPline as acadLWPolylineDim

42、MyPline as acadLWPolylineDim Pnt(7) as double, MhLength as double, MhHeight as doubleDim Pnt(7) as double, MhLength as double, MhHeight as doubleDim PntBt as Variant, PntLf as VariantDim PntBt as Variant, PntLf as VariantWith With Thisdrawing.UtilityThisdrawing.UtilityPntBt=.getPoint(, PntBt=.getPoi

43、nt(, Pick the bottom edgePick the bottom edge ) )PntLf=.getPoint(, Pick the left edge)PntLf=.getPoint(, Pick the left edge)MhLength=.getDistance(, Input the manhole length )MhLength=.getDistance(, Input the manhole length )MhHeight=.getDistance(, Input the manhole height )MhHeight=.getDistance(, Inp

44、ut the manhole height )End WithEnd WithPnt(0)=PntLf(0)+MhLength-MhHeight/2:Pnt(1)=PntBt(1)Pnt(0)=PntLf(0)+MhLength-MhHeight/2:Pnt(1)=PntBt(1)VBA多義線30Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇31Pnt(2)= Pnt(2)= PntLf(0)+MhLength-MhHeight/2PntLf(0)+MhLength-MhHeight/2:Pnt(3)=

45、PntBt(1)+MhHe:Pnt(3)=PntBt(1)+MhHeightightPnt(4)=PntLf(0)+MhHeight/2:Pnt(5)=Pnt(4)=PntLf(0)+MhHeight/2:Pnt(5)=PntBt(1)+MhHeightPntBt(1)+MhHeightPnt(6)= Pnt(6)= PntLf(0)+MhHeight/2:PntLf(0)+MhHeight/2:Pnt(7)=Pnt(7)=PntBt(1)PntBt(1)Set MyPline=Thisdrawing.ModelSpace.AddLightWeightPolyline(PnSet MyPlin

46、e=Thisdrawing.ModelSpace.AddLightWeightPolyline(Pnt)t)MyPline.Closed=TrueMyPline.Closed=TrueMyPline.SetBulge 0, 1MyPline.SetBulge 0, 1MyPline.SetBulge 1, 0MyPline.SetBulge 1, 0MyPline.SetBulge 2, 1MyPline.SetBulge 2, 1MyPline.SetBulge 3, 0MyPline.SetBulge 3, 0MyPline.Color=acCyanMyPline.Color=acCyan

47、End subEnd subVBA多義線31Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇32下面再以一個(gè)常用的三角肘板的程序說明一下凸度的問題。下面再以一個(gè)常用的三角肘板的程序說明一下凸度的問題。VBA多義線32Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇33Sub Bracket()Sub Bracket()Dim MyPline as acadLWPolylineDim MyPline as acadLW

48、PolylineDim Pnt(11) as double, Radius as double, BraLength as doubleDim Pnt(11) as double, Radius as double, BraLength as doubleDim PtSt as VariantDim PtSt as VariantWith With Thisdrawing.UtilityThisdrawing.UtilityPtSt=.getPoint(, PtSt=.getPoint(, Pick the insert pointPick the insert point ) )BraLen

49、gth=.getDistance(, Input the bracket length )BraLength=.getDistance(, Input the bracket length )End WithEnd WithPnt(0)=PtSt(0)+BraLength:Pnt(1)=PtSt(1)Pnt(0)=PtSt(0)+BraLength:Pnt(1)=PtSt(1)Pnt(2)=PtSt(0)+BraLength:Pnt(3)=PtSt(1)+20Pnt(2)=PtSt(0)+BraLength:Pnt(3)=PtSt(1)+20Pnt(4)=PtSt(0)+20:Pnt(5)=P

50、tSt(1)+BraLengthPnt(4)=PtSt(0)+20:Pnt(5)=PtSt(1)+BraLengthPnt(6) = PtSt(0): Pnt(7) = PtSt(1) + BraLengthPnt(6) = PtSt(0): Pnt(7) = PtSt(1) + BraLengthVBA多義線33Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇34Pnt(8) = PtSt(0): Pnt(9) = PtSt(1) + 50Pnt(8) = PtSt(0): Pnt(9) = PtSt(

51、1) + 50Pnt(10) = PtSt(0) + 50: Pnt(11) = PtSt(1)Pnt(10) = PtSt(0) + 50: Pnt(11) = PtSt(1)Set MyPline=Thisdrawing.ModelSpace.AddLightWeightPolylSet MyPline=Thisdrawing.ModelSpace.AddLightWeightPolyline(Pnt)ine(Pnt)MyPline.closed=TrueMyPline.closed=TrueMyPline.Color=acYellowMyPline.Color=acYellowRadiu

52、s=0.12Radius=0.12* *BraLengthBraLengthRadius=Int(Radius)Radius=Int(Radius)* *1010Dim Ang21 as double, Pt1(2) as double, Pt2(2) as DoublDim Ang21 as double, Pt1(2) as double, Pt2(2) as Double eDim Arc0 as acadArc, Arc1 as AcadArcDim Arc0 as acadArc, Arc1 as AcadArcDim PtCen as VariantDim PtCen as Var

53、iantVBA多義線34Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇35Dim Pi as doubleDim Pi as doublePi=4Pi=4* *Atn(1)Atn(1)Pt1(0)=PtSt(0)+BraLength:Pt1(1)=PtSt(1)+20:Pt1(2)=0#Pt1(0)=PtSt(0)+BraLength:Pt1(1)=PtSt(1)+20:Pt1(2)=0#Pt2(0)=PtSt(0)+20:Pt2(1)=PtSt(1)+BraLength:Pt2(2)=0#Pt2(0)

54、=PtSt(0)+20:Pt2(1)=PtSt(1)+BraLength:Pt2(2)=0#Ang21=Thisdrawing.Utility.AngleFromXAxis(Pt2, Pt1)Ang21=Thisdrawing.Utility.AngleFromXAxis(Pt2, Pt1)With Thisdrawing.ModelSpaceWith Thisdrawing.ModelSpaceSet Arc0=.AddArc(Pt1, Radius, Ang21, Ang21+Pi)Set Arc0=.AddArc(Pt1, Radius, Ang21, Ang21+Pi)Set Arc1

55、=.AddArc(Pt2, Radius , Ang21, Ang21+Pi)Set Arc1=.AddArc(Pt2, Radius , Ang21, Ang21+Pi)End withEnd withPtCen=Arc0.InterSectWith(Arc1, acExtendNone)PtCen=Arc0.InterSectWith(Arc1, acExtendNone)Dim AngSt as Double, AngEn as DoubleDim AngSt as Double, AngEn as DoubleVBA多義線35Yard of ChoiceCIMC RAFFLES 201

56、3 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇36AngSt=ThisDrawing.Utility.AngleFromXAxis(PtCen, Pt1)AngSt=ThisDrawing.Utility.AngleFromXAxis(PtCen, Pt1)AngEn=ThisDrawing.Utility.AngleFromXAxis(PtCen, Pt2)AngEn=ThisDrawing.Utility.AngleFromXAxis(PtCen, Pt2)MyPline.SetBulge 0, 0MyPline.SetBulge 0, 0MyPline.S

57、etBulge 1, Tan(AngEn-AngSt)/4)MyPline.SetBulge 1, Tan(AngEn-AngSt)/4)MyPline.SetBulge 2, 0MyPline.SetBulge 2, 0MyPline.SetBulge 3, 0MyPline.SetBulge 3, 0MyPline.SetBulge 4, Tan(-Pi/8)MyPline.SetBulge 4, Tan(-Pi/8)MyPline.SetBulge 5, 0MyPline.SetBulge 5, 0Arc0.DeleteArc0.DeleteArc1.DeleteArc1.DeleteE

58、nd SubEnd SubVBA多義線36Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇37思考題：思考題：l 還是上面的三角肘板，如果兩條邊以拾取的形式來決定起始還是上面的三角肘板，如果兩條邊以拾取的形式來決定起始角度，這個(gè)程序應(yīng)該如何編寫？角度，這個(gè)程序應(yīng)該如何編寫？1.1. 下面的下面的T T型材的程序應(yīng)該如何編寫？要求：需要手工輸入插型材的程序應(yīng)該如何編寫？要求：需要手工輸入插入點(diǎn)，腹板高度，腹板厚度，面板寬度，面板厚度，腹板高入點(diǎn)，腹板高度，腹板厚度，面板寬度，面板厚度，腹板高度方向，腹板厚度

59、方向。度方向，腹板厚度方向。VBA多義線37Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級(jí)篇高級(jí)篇38在在CADCAD中，中，Copy, Move, Array, Offset, Rotate, MirrorCopy, Move, Array, Offset, Rotate, Mirror都是在用戶都是在用戶的干預(yù)下，進(jìn)行的可視化的操作。而在程序中，是不可視的，所以必的干預(yù)下，進(jìn)行的可視化的操作。而在程序中，是不可視的，所以必須有一定的規(guī)則才可以進(jìn)行。下面就分別說一下它們的規(guī)則。須有一定的規(guī)則才可以進(jìn)行。下面就

60、分別說一下它們的規(guī)則。Object.Copy Object.Copy 與與Object.MoveObject.Move， 在在VBAVBA中，中，Object.CopyObject.Copy并不像并不像CADCAD中中一樣，選擇基準(zhǔn)點(diǎn)，在新的位置生成新的實(shí)體，而是在原一樣，選擇基準(zhǔn)點(diǎn)，在新的位置生成新的實(shí)體，而是在原objectobject的位的位置生成一個(gè)新實(shí)體，需要與置生成一個(gè)新實(shí)體，需要與MoveMove結(jié)合使用。例如：結(jié)合使用。例如：Set Circle1=Circle0.Copy()Set Circle1=Circle0.Copy()Circle1.Move Cen0, PntCir