VBA.docx

1、VBA AutoCAD ActiveX VBA二次开发技术基础及应用实例-4 AutoCAD ActiveX VBA二次开发技术基础及应用实例-6AutoCAD ActiveX VBA二次开发技术基础及应用实例-5CAD开发 2009-03-17 15:29:34 阅读444 评论0 字号：大中小订阅 AutoCAD ActiveX VBA二次开发技术基础及应用实例-5VB源码彩色显示 注：在code./code内就以下面格式显示文字，双击源码拷贝到剪切板5.1 创建图形对象创建图形对象的方法：(1) Document对象的SendCommand方法。(2) 添加图形对象集合或块对象的成员，应

2、用Add 类型的方法。5.1.1创建点1点样式和大小点的样式和大小是可以设置的。与“点样式”对话框相对应，共有20种样式。如图5-1所示。图5-1点样式PDMODE 和 PDSIZE 系统变量控制点对象的外观。PDMODE 的值为 0、2、3 和 4 时，指定通过点绘制的图形。值为 1 时表示不显示任何图形。PDSIZE 控制点图形的大小（PDMODE 的值为 0 和 1 时除外）。如果设置为 0，则点图形的高度是图形区高度的 5%。PDSIZE 正值指定点图形的绝对大小，负值将解释为视口大小的百分比。重生成图形时将重新计算所有点的大小。 用户修改 PDMODE 和 PDSIZE 之后，现有点

3、的外观会在下次重生成图形时改变。 要设置 PDMODE 和 PDSIZE，应使用 SetVariable 方法。2创建点创建点要利用AddPoint方法。例5-1：在模型空间中创建坐标为 (5,5,0) 的点对象，然后更新 PDMODE 和 PDSIZE 系统变量。 Sub Ch5_CreatePoint( )Dim pointObj As AcadPointDim location(0 To 2) As Double 定义点的位置location(0) = 5#: location(1) = 5#: location(2) = 0# 创建点Set pointObj = ThisDrawing

4、.ModelSpace.AddPoint(location)ThisDrawing.SetVariable PDMODE, 34ThisDrawing.SetVariable PDSIZE, 1ZoomAllEnd Sub5.1.2 创建直线直线是最基本的图形对象之一。广义的直线系指单一直线、多段线和多线。本节特指创建单一直线。利用AddLine方法通过两点创建直线，该方法需要两个参数：起始点和终了点。例5-2：在模型空间创建一条两点间的直线。Sub Ch5_AddLine( )Dim stP(0 to 2) As DoubleDim enP(0 to 2) As DoubleDim Line

5、1 As AcadLinestP(0)=50:stP(1)=70:stP(2)=0enP(0)=80:enP(1)=80:enP(2)=0Set Line1= ThisDrawing. ModelSpace.AddLine(stP,enP)End Sub5.1.3创建圆、圆弧和椭圆1利用AddCircle方法创建圆 该方法需要两个参数：圆心坐标阵列和半径。例5-3：在模型空间创建一个圆。Sub Ch5_AddCircle( )Dim cob1 As AcadCircleDim cp1(0 To 2) As DoubleDim r1 As Doublecp1(0) = 50: cp1(1) =

6、90: cp1(2) = 0r1 = 20Set cob1 = ThisDrawing.ModelSpace.AddCircle(cp1, r1)End Sub2 利用AddArc方法创建圆弧该方法需要四个参数：（1） 圆心坐标阵列。（2） 圆弧半径。（3） 圆弧起始角（弧度）。（4） 圆弧终止角（弧度）。例5-4：在模型空间创建一段圆弧。Sub Ch5_AddArc( )Dim cp(0 To 2) As DoubleDim rr As DoubleDim startAng As DoubleDim endAng As DoubleDim arcObj As AcadArccp(0) = 3

7、0: cp(1) = 80: cp(2) = 0r r= 25startAng = 0: endAng = 150 * 3.14159 / 180Set arcObj = ThisDrawing.ModelSpace.AddArc _(cp, rr, startAng, endAng)End Sub3 利用AddEllipse方法创建椭圆该方法需要三个参数：（1）椭圆中心坐标矩阵。（2）主轴上的一点。（3）椭圆两轴的半径比例（小于1）。例5-5：创建一个椭圆。Sub Ch5_AddEllipse( )Dim EllObj As AcadEllipseDim CenPoint(0 To 2) A

8、s DoubleDim MajAxisPoint(0 To 2) As DoubleDim Radt As DoubleCenPoint(0) = 100: CenPoint(1) = 100: CenPoint(2) = 0MajAxisPoint(0) = 130MajAxisPoint(1) = 100MajAxisPoint(2) = 0Radt = 0.6Set EllObj = ThisDrawing.ModelSpace.AddEllipse(CenPoint, _ MajAxisPoint, Radt)ZoomExtents End Sub5.1.4创建多线多（重）线是一种由多

9、条平行线段组成的组合图象对象。用AddMline方法创建，该方法只需要的一个参数：多线的三维顶点坐标矩阵。例5-6：创建一条多线。Sub Ch5_AddMLine( )Dim MLineObj As AcadMLineDim point(0 To 11) As Doublepoint(0) = 102: point(1) = 9: point(2) = 0point(3) = 122: point(4) = 15: point(5) = 0point(6) = 130: point(7) = 60: point(8) = 0point(9) = 115: point(10) = 75: poi

10、nt(11) = 0Set MLineObj = ThisDrawing.ModelSpace.AddMLine(point)End Sub5.1.5创建及编辑多段线多段线是由多条线段组成的对象，这些线段可以是直线段，也可是圆弧段。1 创建多段线创建多段线可用AddLightWeightPolyline方法和AddPolyline方法。其中AddPolyline方法可以创建二维或三维多段线，其参数是一个多段线顶点的三维坐标矩阵。而AddLightWeightPolyline方法能创建二维优化多段线（旧版为“轻便多段线”），它的参数是优化多段线顶点的二维坐标矩阵（创建时不能指定某段的宽度和凸度）

11、。注：单一直线和多线都是在世界坐标系（WCS）中的XY平面上创建，而多段线则是在对象坐标系（OCS）上创建。例5-7：创建优化多段线。Sub Ch5_AddLightWeightPolyline( )Dim MyPline As AcadLWPolylineDim Vpoints(0 to 7) As DoubleVpoints(0)=10: Vpoints(1)=65 Vpoints(2)=10: Vpoints(3)=80Vpoints(4)=30: Vpoints(5)=80Vpoints(6)=45: Vpoints(7)=80Set MyPline=ThisDrawing.Model

12、Space. _AddLightWeightPolyline(VPoints)MyPline.SetWidth 2,5,0 编辑线宽画箭头MyPline.UpdateThisDrawing.Application.ZoomAllEnd Sub2 编辑多段线二维和三维多段线、矩形、多边形和三维多边形网格都是多段线的变化形式而且编辑方式也都相同。 要编辑多段线，应使用 LightweightPolyline 或 Polyline 对象的特性和方法。 编辑多段线的常用方法和属性如表5-1中所述。表5-1编辑多段线的常用方法和属性方法和属性 描述 方法 AddVertex 增加一个顶点（只适用于优化多

13、段线） Explode 炸开多段线 GetBulge 返回某给定序号段的凸度 GetWidth 返回某一段的线宽 Offset 对多段线执行偏移操作 SetWidth 设置给定序号段的开始线宽和结束线宽 SetBulge 设置给定序号段的凸度 属性 Closed 封闭多段线 凸度是表示弧线几何特征的一个指标。SetBulge方法可在给定的索引位置设定多段线的凸度。语法：object.SetBulge Index,Value其中：ObjectLightweightPolyline, PolylineIndex以0开始的正整数；要设定的顶点的索引位置序号Value双精度浮点数；给定索引位置上的顶点

14、凸度值说明：凸度是在多段线顶点显示中，选取顶点与下一个顶点形成的弧之间角度四分之一的正切值。0表示直线，1表示半圆。凸度有正、负之分，当弧线是按反时针方向绘制的，凸度的值为“”；反之为“”。图5-2多段线的凸度图5-2为一条由p1-p2-p3-p4构成的多段线，其中第二段为弧线：弧线弦长为d、拱高为h、 顶点序号（从0开始计）为1（p2点）。则该段的凸度b= -h/(d/2)。本简图从P2到P3的弧线是按顺时针方向绘制的，因此凸度b的计算式应加上“”号。例5-8：如图5-2所示，先创建一条皆由直线段组成的优化多段线p1-p2-p3-p4，其各顶点坐标为p1（100，100）、p2（150，10

15、0）、p3（170，60）、p4（150，45），再按拱高h=18将p2-p3直线段改为圆弧。Sub Ch5_EditPolyline( )Dim Vert(0 To 7) As DoubleDim LWP As AcadLWPolylineDim h As DoubleDim d As DoubleDim b As DoubleVert(0) = 100: Vert(1) = 100: Vert(2) = 150: Vert(3) = 100Vert(4) = 170：Vert(5) = 60: Vert(6) = 150: Vert(7) = 45Set LWP = ThisDrawing

16、.ModelSpace. _AddLightWeightPolyline(Vert)LWP.Update用SetBulge方法编辑优化多段线的第二段MsgBox 编辑多段线的第二段, 0, 应用SetBulge方法例h = 18d = Sqr(170 150) 2 + (60 100) 2)b = h / (d / 2)Call LWP.SetBulge(1, b)LWP.UpdateEnd Sub5.1.6创建样条曲线创建二次或三次NURBS（不均匀有理B-Spline）曲线需要使用AddSpline方法。语法：RetVal = object.AddSpline(PointsArray, S

17、tartTangent, EndTangent)式中：object模型空间、图纸空间或块PointsArray顶点的坐标矩阵（3D WCS坐标值的表），至少需要二个点StartTangent样条曲线起点的切点坐标（只可输入3D向量）EndTangent样条曲线终点的切点坐标（只可输入3D向量）RetVal新建的Spline对象预设创建的样条曲线是首尾开放的。若需要为闭合的，在创建样条曲线后，再应用closed属性使其闭合。例5-9：使用三点在模型空间绘制样条曲线，其中样条曲线起始相切点为（2，8，0），终点的切点为（3，1，0）。Sub Ch5_CreateSpline( )Dim anObj

18、 As AcadSplineDim VetPoints(0 To 8) As DoubleDim Stan(0 To 2) As DoubleDim Etan(0 To 2) As DoubleVetPoints(0) = 16: VetPoints(1) = 90:VetPoints(2)=0VetPoints(3)=48:VetPoints(4)= 120:VetPoints(5) = 0 VetPoints(6) = 100: VetPoints(7) = 70: VetPoints(8) = 0Stan(0) = 2: Stan(1) = 8: Stan(2) = 0Etan(0) =

19、 3: Etan(1) = 1: Etan(2) = 0Set anObj =ThisDrawing.ModelSpace.AddSpline _(VetPoints, Stan, Etan)End Sub5.1.7创建实体填充实体填充对象是一种可以有添充颜色的对象，它可以是三角形，也可以是四边形。可以先设系统变量FILEMODE为0，关闭填充模式，创建填充对象的边界轮廓。最后再设系统变量FILEMODE为1，打开填充模式。可用两种方法创建实体填充对象：1 使用AddSolid方法该方法需要四个参数，这四个参数组成填充实体的四个点坐标矩阵。第一点和第二点定义区域的一个边，第三点定义为第二点的对

20、角点，创建四边形实体填充对象。如果将第四点定义为第二点的对角点，则创建的是两个对顶的三角形实体填充对象。如果第三点与第四点重合，则会创建一个三角形实体填充对象。例5-10：创建一个四边形实体填充对象。Sub Ch5_CreateSolid( )Dim SolidObj1 As AcadSolidDim SolidObj2 As AcadSolidDim point1(0 To 2) As DoubleDim point2(0 To 2) As DoubleDim point3(0 T o 2) As DoubleDim point4(0 To 2) As Doublepoint1(0) = 0

21、: point1(1) = 0: point1(2) = 0point2(0) = 25: point2(1) = 0: point2(2) = 0point3(0) = 0: point3(1) = 18: point3(2) = 0point4(0) = 25: point4(1) = 18: point4(2) = 0设置系统变量FILLMODE为1(实心填充)ThisDrawing.SetVariable FILLMODE, 1Set SolidObj1 = ThisDrawing .ModelSpace.AddSolid _(point1, point2, point4, point

22、3)SolidObj1.Color = 6 紫色End Sub2 使用AddTrace方法该方法的作用与AddSolid方法完全一样，四个顶点确定四条边的原则也与AddSolid方法相同。其不同点是该方法只需要一个参数构成四个顶点的三维坐标数组。例5-11：使用AddTrace方法绘制一个三角形填充实体对象。Sub Ch5_AddTrace( )Dim traceObj As AcadTraceDim tracePts(0 To 11) As DoubletracePts(0) = 100: tracePts(1) = 0: tracePts(2) = 0tracePts(3) = 100:

23、tracePts(4) = 10: tracePts(5) = 0tracePts(6) = 110: tracePts(7) = 0: tracePts(8) = 0tracePts(9) = 110: tracePts(10) = 0: tracePts(11) = 0设置系统变量FILEMODE为1(实心填充)ThisDrawing.SetVariable FILLMODE, 1Set traceObj = ThisDrawing.ModelSpace.AddTrace(tracePts)traceObj.Color = acGreen 绿色End Sub5.1.8面域面域是用户从闭合形

24、状（称为环）创建的二维闭合区域。环可以是一条曲线或一系列相连的曲线，这些曲线用不自交的边界在平面上定义一个区域。环可以是直线、优化多段线、圆、圆弧、椭圆、椭圆弧、样条曲线、三维面、宽线和实体的组合。组成环的对象必须是闭合的，或者是通过与其他对象共享端点而形成闭合的区域。所有这些对象还必须共面（在同一个平面上）。组成面域的环必须定义为对象的数组。1创建面域创建面域要用AddRegion方法，该方法只需要一个参数：形成面域回路的图形对象数组。在面域建立以后，用于建立面域的图形对象可保留或删除（依赖于系统变量DELOBJ的值，0为不保留；1为保留）。例5-12: 创建面域。Sub Ch5_Creat

25、eRegion( ) 定义保存面域边界的数组Dim curves(0 To 0) As AcadCircle 创建圆，用作面域的边界Dim center(0 To 2) As DoubleDim radius As Doublecenter(0) = 2center(1) = 2center(2) = 0radius = 5#Set curves(0) = ThisDrawing.ModelSpace.AddCircle (center, radius) 创建面域Dim regionObj As VariantregionObj = ThisDrawing.ModelSpace.AddRegi

26、on(curves)ZoomAllEnd Sub2组合面域对已经存在的面域进行差、并或交的布尔运算可创建新的组合面域。（1） 差运算使用被减面域的Boolean方法，第一个参数为acSubtraction，第二个参数为减去的面域。（2） 并运算可以使用任何一个参与运算面域对象的Boolean方法，第一个参数为acUnion，第二个参数为参与并运算的其它面域。（3） 交运算可以使用任何一个参与交运算面域对象的Boolean方法，第一个参数为acIntersection方法，第二个参数为参与交运算的其它面域。例5-13：生成两个简单面域，并进行差运算创建组合面域。Sub Ch5_CreateCom

27、positeRegions( )Dim border As AcadCircleDim cp(0 To 2) As DoubleDim rr As Doublecp(0) = 30: cp(1) = 15: cp(2) = 0rr = 7Set border = ThisDrawing.ModelSpace.AddCircle(cp,rr)Dim RObject As VariantDim PObject As VariantDim curves1(0 To 0) As ObjectSet curves1(0) = borderRObject = ThisDrawing.ModelSpace.

28、AddRegion(curves1)Dim polyobject As AcadLWPolylineDim vetP(0 To 7) As DoublevetP(0) = 5: vetP(1) = 25: vetP(2) = 45: vetP(3) = 25vetP(4) = 45: vetP(5) = 5:vetP(6) = 5: vetP(7) = 5Set polyobject = ThisDrawing.ModelSpace .AddLightWeightPolyline(vetP)polyobject.Closed = TrueDim curves2(0 To 0) As AcadE

29、ntitySet curves2(0) = polyobjectPObject = ThisDrawing.Modelspace.ModelSpace. AddRegion(curves2)PObject(0).Boolean acSubtraction, RObject(0)PObject(0).UpdateEnd Sub5.1.9图案填充图案填充可以使用某种图案来填充图形中的指定区域。创建图案填充区域的过程通常是先用AddHatch方法创建Hatch对象，然后确定该区域的边界，最后执行Evaluate方法，先计算后才能显示。1 创建Hatch对象创建Hatch对象要使用AddHatch方法

30、。该方法有四个参数：依次为图案类型、图案名称、关联性和图案填充对象类型。语法：RetVal=object.AddHatch(PatternType, PatternName, Associativity , HatchObjectType)参数：（1） PatternType图案类型该参数分为AcPatternType和AcGradientType两种类型。如果HatchObjectType参数的值为AcHatchObject，则该参数为AcPatternType类型；如果HatchObjectType参数的值为AcGradientObject，则该参数为AcGradientPatternTy

31、pe类型。图案类型的常数按以下三种选用：AcHatchPatternTypePredefined从AutoCAD提供的acad.pat文件中选择图案名称。AcHatchPatternTypeUserDefined用当前线型定义直线图案。AcHatchPatternTypeCustomDefined从用户定义的PAT文件中选择图案名称（而不是从acad.pat文件中选择）。（2） PatternName图案名称该名称在所选的图案类型中必须是有效的名称。例如：当选用AcHatchPatternTypePredefined图案类型时，可选用“ANSI31”。（3） Associativity关联性要创建与其边界相关联的