VBA-FOR-AutoCAD

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

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

3、高級篇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)-高級篇高級篇3第1部分：AutoCAD自帶的批量處理命令3內(nèi)容Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級篇高

4、級篇4第2部分：VBA直線、圓與圓弧4課后練習(xí)具體內(nèi)容，1，2，3Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級篇高級篇5第3部分：VBA多義線5課后練習(xí)具體內(nèi)容，1，2，3Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級篇高級篇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)-高級篇高級篇7第5部分：VBA文字標(biāo)注7課后練習(xí)具體內(nèi)容，1，2，3Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級篇高級篇8第5部分：VBA其它輔助功能-Debug.Print, MsgBox8課后練習(xí)具體內(nèi)容，1，2，3Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級篇高級篇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)-高級篇高級篇10大家感覺怎么樣呢？這些內(nèi)容是不是可以做一些略復(fù)雜的圖形了呢？下面我們來做一個綜合的練習(xí)吧。10大家如果有興趣進(jìn)一步學(xué)習(xí)，大家可以一起學(xué)習(xí)。最后，給大家留個課后作業(yè)，看一下這個圖形如何用程序來實現(xiàn)。Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級篇高級篇11我的聯(lián)系方式11電話內(nèi)線：79166手機(jī)mail: Guangyin.Xiacimc-Yard of

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

8、，在CADCAD中，畫直線需要確實中，畫直線需要確實2 2個點，起點和終點，個點，起點和終點，同樣，在同樣，在VBAVBA中，也是確定兩個點。中，也是確定兩個點。第一種方式，以坐標(biāo)的形式給定兩個點。第一種方式，以坐標(biāo)的形式給定兩個點。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)-高級篇高級篇15第二種方式，以拾取的形式給定兩個點。第二種方式，以拾取的形式給定兩個點。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)-高級篇高級篇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)-高級篇高級篇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)-高級篇高級篇18用用VBA

16、VBA畫圓畫圓我們知道，在我們知道，在CADCAD中有多種畫圓的方式，包括圓心、半徑；中有多種畫圓的方式，包括圓心、半徑；圓心、直徑；三點；切點、切點和半徑。而程序中只給出了一圓心、直徑；三點；切點、切點和半徑。而程序中只給出了一種方式畫圓，也就是圓心、半徑，其余的要通過程序計算來得種方式畫圓，也就是圓心、半徑，其余的要通過程序計算來得到。到。圓心與半徑畫圓，圓心可以是圓心與半徑畫圓，圓心可以是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)-高級篇高級篇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)-高級篇高級篇20用用VBAVBA畫圓弧畫圓弧VBAVBA中只有一種畫圓弧的方式，包括圓心、半徑、起始角、中只有一種畫圓弧的方式，包括圓心、半徑、起始角、終止角。其余的要通過程序計算來得到。終止角。其余的要通過程序計算來得到。圓心與圓一樣可以是圓心與圓一樣可以是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)-高級篇高級篇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思考題：如何用三點來畫一個圓思考題：如何用三點來畫一個圓Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級篇高級篇22在在VBAVBA中用三點畫一個圓中用三點畫一個圓我們先來回顧一下用尺規(guī)作圖時如何用三點來作圓的。我們是我們先來回顧一下用尺規(guī)作圖時如何用三點來作圓的。我們是先來做其中兩條張的垂直平分線。在先來做其中兩條張的垂直平分線。在VBAVBA中我們也可以用這個思中我們也可以用這個思路來

25、做這個圓。下面的圖中給出了作圖的順序。路來做這個圓。下面的圖中給出了作圖的順序。VBA直線、圓與圓弧22Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級篇高級篇23下面我們來看在下面我們來看在VBAVBA中用三點畫一個圓的程序代碼中用三點畫一個圓的程序代碼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)-高級篇高級篇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)-高級篇高級篇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)-高級篇高級篇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是求兩點之間的矩離，而是求兩點之間的矩離，而VBAVBA本身并沒有提供這個函數(shù)，本身并沒有提供這個函數(shù)，需要自己定義一個這樣的函數(shù)。這樣的函數(shù)就是先用兩點畫一條直線，需要自己定義一個這樣的函數(shù)。這樣的函數(shù)就是先用兩點畫一條直線，VBAVBA中提供了直線的長度這個函數(shù)，所以可以用直線的長度得到。

35、之后中提供了直線的長度這個函數(shù)，所以可以用直線的長度得到。之后我們把這條直線再刪除就可以了。我們把這條直線再刪除就可以了。VBA直線、圓與圓弧26Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級篇高級篇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思考題：思考題：如何用起點、終點和半徑畫圓??？如何用起點、終點和半徑畫圓??？Yard of ChoiceCIMC RAFFLES 2013 ALL RI

37、GHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級篇高級篇28在在VBAVBA中有多義線和二維多義線，其中的二維多義線一個頂點有中有多義線和二維多義線，其中的二維多義線一個頂點有2 2個坐個坐標(biāo)值，而多義線的一個頂點有標(biāo)值，而多義線的一個頂點有3 3個坐標(biāo)值。我們只講二維多義線，定義個坐標(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)-高級篇高級篇29MyPline.Closed=TrueMyPline.Closed=TrueMyPline.Color=acGreenMyPline.Color=acGreenEnd subEnd subVBA多義線29二維多義線的凸度問題。我們知道，在二維多義線的凸度問題。我們知道，在CADCAD的二維多義線中有圓弧的問的二維多義線中有圓弧的問題，在題，在VBAVBA中同樣也有這個問題。它所實現(xiàn)圓弧的作法就是設(shè)置它的凸中同樣也有這個問題。它所實現(xiàn)圓弧的作法就是設(shè)置它的凸度。凸度的值為圓心角的

41、度。凸度的值為圓心角的1/41/4的正切值。下面以實例來說明這個問題。的正切值。下面以實例來說明這個問題。我們先來畫個人孔。下面的我們先來畫個人孔。下面的0 0，與，與2 2是圓弧的起始點，圓心角為是圓弧的起始點，圓心角為，所，所以它的以它的1/41/4為為/4,/4,正切值為正切值為1 1。其余點的凸度都設(shè)為。其余點的凸度都設(shè)為0.0.Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級篇高級篇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)-高級篇高級篇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)-高級篇高級篇32下面再以一個常用的三角肘板的程序說明一下凸度的問題。下面再以一個常用的三角肘板的程序說明一下凸度的問題。VBA多義線32Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級篇高級篇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)-高級篇高級篇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)-高級篇高級篇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)-高級篇高級篇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)-高級篇高級篇37思考題：思考題：l 還是上面的三角肘板，如果兩條邊以拾取的形式來決定起始還是上面的三角肘板，如果兩條邊以拾取的形式來決定起始角度，這個程序應(yīng)該如何編寫？角度，這個程序應(yīng)該如何編寫？1.1. 下面的下面的T T型材的程序應(yīng)該如何編寫？要求：需要手工輸入插型材的程序應(yīng)該如何編寫？要求：需要手工輸入插入點，腹板高度，腹板厚度，面板寬度，面板厚度，腹板高入點，腹板高度，腹板厚度，面板寬度，面板厚度，腹板高度方向，腹板厚度

59、方向。度方向，腹板厚度方向。VBA多義線37Yard of ChoiceCIMC RAFFLES 2013 ALL RIGHTS RESERVEDAutoCAD培訓(xùn)培訓(xùn)-高級篇高級篇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)點，在新的位置生成新的實體，而是在原一樣，選擇基準(zhǔn)點，在新的位置生成新的實體，而是在原objectobject的位的位置生成一個新實體，需要與置生成一個新實體，需要與MoveMove結(jié)合使用。例如：結(jié)合使用。例如：Set Circle1=Circle0.Copy()Set Circle1=Circle0.Copy()Circle1.Move Cen0, PntCir