发布时间 : 星期三 文章AutoCAD二次开发(VBA)更新完毕开始阅读de6e21086c85ec3a87c2c560
EllAxisScale = 0.6
Set ElliseObj = ThisDrawing.ModelSpace.AddEllipse(EllCenP, EllMajAxisP, _ EllAxisScale)
'定义阵列参数 RotateP(0) = 300 RotateP(1) = 40 RotateP(2) = 0 ArrayNumber = 10 ArrayAngle = 4.71
ArrayResult = ElliseObj.ArrayPolar(ArrayNumber, ArrayAngle, RotateP) 2.矩形阵列
要创建二维矩形阵列，需要使用对象提供的ArrayRectangular方法。这个方法需要提供4个参数：列数、行数、行距和列距。如果列间距为正值，则阵列时对象沿X轴正向排列绘制；为负值则阵列时对象沿X轴负向排列绘制。如果行间距为正值，则阵列时对象沿Y轴正向排列绘制；为负值则阵列时对象沿Y轴负向排列绘制。
矩形阵列的列和行总是与坐标轴成正交的，也即为90°夹角。可以通过SnapRotationangle属性来设置矩形阵列的倾斜角，该属性设置的角度同时也是捕捉点的旋转角度。当这个角度非0值，就可以创建倾斜的矩形阵列了。
下面的程序先创建一个五角星，然后再对五角星进行矩形阵列，创建5×4共20个五角星。
Dim PolyLineObj As AcadLWPolyline Dim PolyLineP(0 To 21) As Double Dim ArrayRows As Integer Dim ArrayCols As Integer Dim ArrayRowDis As Double Dim ArrayColDis As Double Dim arrayResult As Variant Dim LevelDis As Double Dim Levels As Integer '定义五角星
PolyLineP(0) = 0: PolyLineP(1) = 0
PolyLineP(2) = 41.678: PolyLineP(3) = 30.2808 PolyLineP(4) = 83.356: PolyLineP(5) = 0
PolyLineP(6) = 67.4364: PolyLineP(7) = 48.9954 PolyLineP(8) = 109.1144: PolyLineP(9) = 79.2763 PolyLineP(10) = 57.5976: PolyLineP(11) = 79.2763 PolyLineP(12) = 41.678: PolyLineP(13) = 128.2717 PolyLineP(14) = 25.7854: PolyLineP(15) = 79.2763 PolyLineP(16) = 25.7584: PolyLineP(17) = 79.2763 PolyLineP(18) = -25.7584: PolyLineP(19) = 79.2763 PolyLineP(20) = 15.9196: PolyLineP(21) = 48.995
Set PolyLineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(PolyLineP) PolyLineObj.Closed = True '定义阵列参数
ArrayRows = 5 ArrayCols = 4 Levels = 1
ArrayRowDis = 150 ArrayColDis = 250 LevelDis = 0 '创建阵列
arrayResult = PolyLineObj.ArrayRectangular(ArrayRows, ArrayCols, Levels, _ ArrayRowDis, ArrayColDis, LevelDis) 14.4.8.4旋转对象
VBA程序可以将所有的图形对象及其属性参考绕指定的基点旋转，改变对象的方位，但不改变其大小。要旋转对象需要使用该对象提供的Rotate方法。这个方法需要输入一个基点和一个旋转角度作为参数。其中基点是一个具有三个单精度的变体数据，旋转角度参数的单位为弧度，此角度指定对象绕基点旋转过的角度，也就是相对于当前位置旋转的距离。下面的程序先创建一个大圆及基中心线，再以该圆的第一象限点为圆心绘制一个小圆。然后复制出一水平中心线，最后将小圆和复制出的中心线绕大圆圆心旋转30°。
Dim CircleBig As AcadCircle Dim CircleLit As AcadCircle Dim CenBigP(0 To 2) As Double Dim CenLitP(0 To 2) As Double Dim RBig As Double Dim RLit As Double
Dim CenterLineH As AcadLine Dim CenterLineV As AcadLine
Dim CenLineHP1(0 To 2) As Double Dim CenLineHP2(0 To 2) As Double Dim CenLineVP1(0 To 2) As Double Dim CenLineVP2(0 To 2) As Double Dim CenterLineHCopy As AcadLine Dim RotateAngle As Double CenBigP(0) = 50 CenBigP(1) = 50 CenBigP(2) = 0 RBig = 15
CenLitP(0) = 65 CenLitP(1) = 50 CenLitP(2) = 0 RLit = 3
CenLineHP1(0) = 30 CenLineHP1(1) = 50 CenLineHP1(2) = 0 CenLineHP2(0) = 70 CenLineHP2(1) = 50 CenLineHP2(2) = 0
CenLineVP1(0) = 50 CenLineVP1(1) = 30 CenLineVP1(2) = 0 CenLineVP2(0) = 50 CenLineVP2(1) = 70 CenLineVP2(2) = 0
ThisDrawing.Linetypes.Load \
ThisDrawing.ActiveLinetype = ThisDrawing.Linetypes.Item(\Set CircleBig = ThisDrawing.ModelSpace.AddCircle(CenBigP, RBig) Set CircleLit = ThisDrawing.ModelSpace.AddCircle(CenLitP, RLit)
Set CenterLineH = ThisDrawing.ModelSpace.AddLine(CenLineHP1, CenLineHP2) Set centerlinv = ThisDrawing.ModelSpace.AddLine(CenLineVP1, CenLineVP2) CenterLineH.Linetype = \CenterLineV.Linetype = \CenterLineH.LinetypeScale = 3 CenterLineV.LinetypeScale = 3 RotateAngle = 0.5236
Set CenterLineHCopy = CenterLineH.Copy CenterLineHCopy.Rotate CenBigP, RotateAngle CircleLit.Rotate CenBigP, RotateAngle 14.4.8.5删除对象
下面的程序是先创建一个直线，然后将其删除。
Dim LinObj As AcadLine Dim SP(0 To 2) As Double Dim EP(0 To 2) As Double SP(0) = 0 SP(1) = 0 SP(2) = 0 EP(0) = 500 EP(1) = 0 EP(2) = 0
Set LinObj = ThisDrawing.ModelSpace.AddLine(SP, EP)
LinObj.Delete
从上面的程序代码中可以看到，删除对象需要用到对象的Delete方法。在ActiveX Automation中的Collection对象中，有些对象集合是不提供Delete方法的。例如，ModelSpace集合、Layers集合和Dictionaries集合不能被删除。如果试图删除这些对象，则会产生错误。
14.4.9组织图形元素
用户所创建的对象都包括图层、颜色和线型三个标准属性。图层就是透明的图纸，可以在不同的层上面绘制不同各类的图形对象；颜色可以帮助用户直观地区分图形中不同种类的元素；线型则可以帮助用户依标准区分不同的图形元素。 14.4.9.1图层
1.查找图层
在AutoCAD图形对象中，所有的图层和线型均保存在其上级对象（图形）中，其中图层保存在Layers集合内，查找图层要从Layers集合中索引。可以遍历Layers集合，用For Each语句查询出图形中的所有图层和线型。下面的程序代码遍历整个Layers集合，查询图形中所有图层名称，然后在信息对话框中显示各图层的名称。
Dim AllLayerNames As String Dim EntryObj As AcadLayer AllLayerNames = \
For Each EntryObj In ThisDrawing.Layers
AllLayerNames = AllLayerNames + EntryObj.Name + vbCrLf Next
MsgBox \本图形的图层有：\2.创建图层
AutoCAD图形中的每一个图层都是Layers集合中的一个对象，在VBA程序中创建新图层需要使用Add方法。该方法需要一个参数，该参数为新创建的图层名称。图层名称最长可以有31个字符，包含字母、数字和特殊字符，但不能包含空格。图层创建之后，可以修改图层的名称，这需要使用该图层的Name属性，将该属性值设置为需要的名称字符即可。图层创建以后，可以通过图层的Color属性和Linetype属性来设置图层上的颜色和线型。下面的程序先创建一个圆和一个图层，新图层使用红色和虚线线型。然后将圆指定到该图层上，圆的颜色和线型属性也跟着修改。
Dim CircleObj As AcadCircle Dim CenP(0 To 2) As Double CenP(0) = 0 CenP(1) = 0 CenP(2) = 0
Dim R As Double R = 50
Set CircleObj = ThisDrawing.ModelSpace.AddCircle(CenP, R) CircleObj.color = acByLayer
'圆颜色为“ByLayer”,使用图层颜色 Dim NewLayerObj As AcadLayer
Set NewLayerObj = ThisDrawing.Layers.Add(\新图层\NewLayerObj.color = acRed
NewLayerObj.Linetype = \CircleObj.Layer = \新图层\CircleObj.Update 3.切换图层
当需要在另一个图层上绘图时，需要先切换到该图层，也就是设置当前图层，才可以在该图层上创建新的对象。如果一个图层已经被冻结，则不能设置它成为当前图层。如果切换图层，需要使用图形对象的ActiveLayer属性，该属性用于设置当前图形。例如：
ThisDrawing.ActiveLayer = \图层1\是把“图层1”设置为当前图层。
4.打开和关闭图层
打开和关闭图层，需要使用图层对象的LayerOn属性。如果将此属性设置为True，该图层会被打开；如果设置为False，则图层被关闭。