VBA.docx

VBA.docx

《VBA.docx》由会员分享，可在线阅读，更多相关《VBA.docx（91页珍藏版）》请在冰豆网上搜索。

VBA

AutoCADActiveXVBA二次开发技术基础及应用实例-4

AutoCADActiveXVBA二次开发技术基础及应用实例-6

AutoCADActiveXVBA二次开发技术基础及应用实例-5

CAD开发2009-03-1715:

29:

34阅读444评论0  字号：

大中小 订阅

AutoCADActiveXVBA二次开发技术基础及应用实例-5

VB源码彩色显示注：

在[code]...[/code]内就以下面格式显示文字，双击源码拷贝到剪切板

5.1创建图形对象

创建图形对象的方法：

（1）Document对象的SendCommand方法。

（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之后，现有点的外观会在下次重生成图形时改变。

要设置PDMODE和PDSIZE，应使用SetVariable方法。

2．创建点

创建点要利用AddPoint方法。

例5-1：

在模型空间中创建坐标为（5,5,0）的点对象，然后更新PDMODE和PDSIZE系统变量。

SubCh5_CreatePoint（）

DimpointObjAsAcadPoint

Dimlocation（0To2）AsDouble

'定义点的位置

location（0）=5#:

location

（1）=5#:

location

（2）=0#

'创建点

SetpointObj=ThisDrawing.ModelSpace.AddPoint（location）

ThisDrawing.SetVariable"PDMODE",34

ThisDrawing.SetVariable"PDSIZE",1

ZoomAll

EndSub

5.1.2创建直线

直线是最基本的图形对象之一。

广义的直线系指单一直线、多段线和多线。

本节特指创建单一直线。

利用AddLine方法通过两点创建直线，该方法需要两个参数：

起始点和终了点。

例5-2：

在模型空间创建一条两点间的直线。

SubCh5_AddLine（）

DimstP（0to2）AsDouble

DimenP（0to2）AsDouble

DimLine1AsAcadLine

stP（0）=50:

stP

（1）=70:

stP

（2）=0

enP（0）=80:

enP

（1）=80:

enP

（2）=0

SetLine1=ThisDrawing.ModelSpace.AddLine（stP,enP）

EndSub

5.1.3创建圆、圆弧和椭圆

1．利用AddCircle方法创建圆

该方法需要两个参数：

圆心坐标阵列和半径。

例5-3：

在模型空间创建一个圆。

SubCh5_AddCircle（）

Dimcob1AsAcadCircle

Dimcp1（0To2）AsDouble

Dimr1AsDouble

cp1（0）=50:

cp1

（1）=90:

cp1

（2）=0

r1=20

Setcob1=ThisDrawing.ModelSpace.AddCircle（cp1,r1）

EndSub

2．利用AddArc方法创建圆弧

该方法需要四个参数：

（1）圆心坐标阵列。

（2）圆弧半径。

（3）圆弧起始角（弧度）。

（4）圆弧终止角（弧度）。

例5-4：

在模型空间创建一段圆弧。

SubCh5_AddArc（）

Dimcp（0To2）AsDouble

DimrrAsDouble

DimstartAngAsDouble

DimendAngAsDouble

DimarcObjAsAcadArc

cp（0）=30:

cp

（1）=80:

cp

（2）=0

rr=25

startAng=0:

endAng=150*3.14159/180

SetarcObj=ThisDrawing.ModelSpace.AddArc_

（cp,rr,startAng,endAng）

EndSub

3．利用AddEllipse方法创建椭圆

该方法需要三个参数：

（1）椭圆中心坐标矩阵。

（2）主轴上的一点。

（3）椭圆两轴的半径比例（小于1）。

例5-5：

创建一个椭圆。

SubCh5_AddEllipse（）

DimEllObjAsAcadEllipse

DimCenPoint（0To2）AsDouble

DimMajAxisPoint（0To2）AsDouble

DimRadtAsDouble

CenPoint（0）=100:

CenPoint

（1）=100:

CenPoint

（2）=0

MajAxisPoint（0）=130

MajAxisPoint

（1）=100

MajAxisPoint

（2）=0

Radt=0.6

SetEllObj=ThisDrawing.ModelSpace.AddEllipse（CenPoint,_MajAxisPoint,Radt）

ZoomExtents

EndSub

5.1.4创建多线

多（重）线是一种由多条平行线段组成的组合图象对象。

用AddMline方法创建，该方法只需要的一个参数：

多线的三维顶点坐标矩阵。

例5-6：

创建一条多线。

SubCh5_AddMLine（）

DimMLineObjAsAcadMLine

Dimpoint（0To11）AsDouble

point（0）=102:

point

（1）=9:

point

（2）=0

point（3）=122:

point（4）=15:

point（5）=0

point（6）=130:

point（7）=60:

point（8）=0

point（9）=115:

point（10）=75:

point（11）=0

SetMLineObj=ThisDrawing.ModelSpace.AddMLine（point）

EndSub

5.1.5创建及编辑多段线

多段线是由多条线段组成的对象，这些线段可以是直线段，也可是圆弧段。

1．创建多段线

创建多段线可用AddLightWeightPolyline方法和AddPolyline方法。

其中AddPolyline方法可以创建二维或三维多段线，其参数是一个多段线顶点的三维坐标矩阵。

而AddLightWeightPolyline方法能创建二维优化多段线（旧版为“轻便多段线”），它的参数是优化多段线顶点的二维坐标矩阵（创建时不能指定某段的宽度和凸度）。

注：

单一直线和多线都是在世界坐标系（WCS）中的XY平面上创建，而多段线则是在对象坐标系（OCS）上创建。

例5-7：

创建优化多段线。

SubCh5_AddLightWeightPolyline（）

DimMyPlineAsAcadLWPolyline

DimVpoints（0to7）AsDouble

Vpoints（0）=10:

Vpoints

（1）=65

Vpoints

（2）=10:

Vpoints（3）=80

Vpoints（4）=30:

Vpoints（5）=80

Vpoints（6）=45:

Vpoints（7）=80

SetMyPline=ThisDrawing.ModelSpace._

AddLightWeightPolyline（VPoints）

MyPline.SetWidth2,5,0′编辑线宽——画箭头

MyPline.Update

ThisDrawing.Application.ZoomAll

EndSub

2．编辑多段线

二维和三维多段线、矩形、多边形和三维多边形网格都是多段线的变化形式而且编辑方式也都相同。

要编辑多段线，应使用LightweightPolyline或Polyline对象的特性和方法。

编辑多段线的常用方法和属性如表5-1中所述。

表5-1编辑多段线的常用方法和属性

方法和属性描述

方法

AddVertex增加一个顶点（只适用于优化多段线）Explode炸开多段线GetBulge返回某给定序号段的凸度GetWidth返回某一段的线宽Offset对多段线执行偏移操作SetWidth设置给定序号段的开始线宽和结束线宽SetBulge设置给定序号段的凸度属性Closed封闭多段线凸度是表示弧线几何特征的一个指标。

SetBulge方法可在给定的索引位置设定多段线的凸度。

语法：

object.SetBulgeIndex,Value

其中：

Object——LightweightPolyline,Polyline

Index——以0开始的正整数；要设定的顶点的索引位置序号

Value——双精度浮点数；给定索引位置上的顶点凸度值

说明：

凸度是在多段线顶点显示中，选取顶点与下一个顶点形成的弧之间角度四分之一的正切值。

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，100）、p3（170，60）、p4（150，45），再按拱高h=18将p2-p3直线段改为圆弧。

SubCh5_EditPolyline（）

DimVert（0To7）AsDouble

DimLWPAsAcadLWPolyline

DimhAsDouble

DimdAsDouble

DimbAsDouble

Vert（0）=100:

Vert

（1）=100:

Vert

（2）=150:

Vert（3）=100

Vert（4）=170：

Vert（5）=60:

Vert（6）=150:

Vert（7）=45

SetLWP=ThisDrawing.ModelSpace._

AddLightWeightPolyline（Vert）

LWP.Update

'用SetBulge方法编辑优化多段线的第二段

MsgBox"编辑多段线的第二段",0,"应用SetBulge方法例"

h=18

d=Sqr（（170－150）^2+（60－100）^2）

b=－h/（d/2）

CallLWP.SetBulge（1,b）

LWP.Update

EndSub

5.1.6创建样条曲线

创建二次或三次NURBS（不均匀有理B-Spline）曲线需要使用AddSpline方法。

语法：

RetVal=object.AddSpline（PointsArray,StartTangent,EndTangent）

式中：

object——模型空间、图纸空间或块

PointsArray——顶点的坐标矩阵（3DWCS坐标值的表），至少需要二个点

StartTangent——样条曲线起点的切点坐标（只可输入3D向量）

EndTangent——样条曲线终点的切点坐标（只可输入3D向量）

RetVal——新建的Spline对象

预设创建的样条曲线是首尾开放的。

若需要为闭合的，在创建样条曲线后，再应用closed属性使其闭合。

例5-9：

使用三点在模型空间绘制样条曲线，其中样条曲线起始相切点为（2，8，0），终点的切点为（3，1，0）。

SubCh5_CreateSpline（）

DimanObjAsAcadSpline

DimVetPoints（0To8）AsDouble

DimStan（0To2）AsDouble

DimEtan（0To2）AsDouble

VetPoints（0）=16:

VetPoints

（1）=90:

VetPoints

（2）=0

VetPoints（3）=48:

VetPoints（4）=120:

VetPoints（5）=0

VetPoints（6）=100:

VetPoints（7）=70:

VetPoints（8）=0

Stan（0）=2:

Stan

（1）=8:

Stan

（2）=0

Etan（0）=3:

Etan

（1）=1:

Etan

（2）=0

SetanObj=ThisDrawing.ModelSpace.AddSpline_

（VetPoints,Stan,Etan）

EndSub

5.1.7创建实体填充

实体填充对象是一种可以有添充颜色的对象，它可以是三角形，也可以是四边形。

可以先设系统变量FILEMODE为0，关闭填充模式，创建填充对象的边界轮廓。

最后再设系统变量FILEMODE为1，打开填充模式。

可用两种方法创建实体填充对象：

1．使用AddSolid方法

该方法需要四个参数，这四个参数组成填充实体的四个点坐标矩阵。

第一点和第二点定义区域的一个边，第三点定义为第二点的对角点，创建四边形实体填充对象。

如果将第四点定义为第二点的对角点，则创建的是两个对顶的三角形实体填充对象。

如果第三点与第四点重合，则会创建一个三角形实体填充对象。

例5-10：

创建一个四边形实体填充对象。

SubCh5_CreateSolid（）

DimSolidObj1AsAcadSolid

DimSolidObj2AsAcadSolid

Dimpoint1（0To2）AsDouble

Dimpoint2（0To2）AsDouble

Dimpoint3（0To2）AsDouble

Dimpoint4（0To2）AsDouble

point1（0）=0:

point1

（1）=0:

point1

（2）=0

point2（0）=25:

point2

（1）=0:

point2

（2）=0

point3（0）=0:

point3

（1）=18:

point3

（2）=0

point4（0）=25:

point4

（1）=18:

point4

（2）=0

′设置系统变量FILLMODE为1（实心填充）

ThisDrawing.SetVariable"FILLMODE",1

SetSolidObj1=ThisDrawing.ModelSpace.AddSolid_

（point1,point2,point4,point3）

SolidObj1.Color=6'紫色

EndSub

2．使用AddTrace方法

该方法的作用与AddSolid方法完全一样，四个顶点确定四条边的原则也与AddSolid方法相同。

其不同点是该方法只需要一个参数——构成四个顶点的三维坐标数组。

例5-11：

使用AddTrace方法绘制一个三角形填充实体对象。

SubCh5_AddTrace（）

DimtraceObjAsAcadTrace

DimtracePts（0To11）AsDouble

tracePts（0）=100:

tracePts

（1）=0:

tracePts

（2）=0

tracePts（3）=100:

tracePts（4）=10:

tracePts（5）=0

tracePts（6）=110:

tracePts（7）=0:

tracePts（8）=0

tracePts（9）=110:

tracePts（10）=0:

tracePts（11）=0

'设置系统变量FILEMODE为1（实心填充）

ThisDrawing.SetVariable"FILLMODE",1

SettraceObj=ThisDrawing.ModelSpace.AddTrace（tracePts）

traceObj.Color=acGreen'绿色

EndSub

5.1.8面域

面域是用户从闭合形状（称为环）创建的二维闭合区域。

环可以是一条曲线或一系列相连的曲线，这些曲线用不自交的边界在平面上定义一个区域。

环可以是直线、优化多段线、圆、圆弧、椭圆、椭圆弧、样条曲线、三维面、宽线和实体的组合。

组成环的对象必须是闭合的，或者是通过与其他对象共享端点而形成闭合的区域。

所有这些对象还必须共面（在同一个平面上）。

组成面域的环必须定义为对象的数组。

1．创建面域

创建面域要用AddRegion方法，该方法只需要一个参数：

形成面域回路的图形对象数组。

在面域建立以后，用于建立面域的图形对象可保留或删除（依赖于系统变量DELOBJ的值，0为不保留；1为保留）。

例5-12:

创建面域。

SubCh5_CreateRegion（）

'定义保存面域边界的数组

Dimcurves（0To0）AsAcadCircle

'创建圆，用作面域的边界

Dimcenter（0To2）AsDouble

DimradiusAsDouble

center（0）=2

center

（1）=2

center

（2）=0

radius=5#

Setcurves（0）=ThisDrawing.ModelSpace.AddCircle（center,radius）

'创建面域

DimregionObjAsVariant

regionObj=ThisDrawing.ModelSpace.AddRegion（curves）

ZoomAll

EndSub

2．组合面域

对已经存在的面域进行差、并或交的布尔运算可创建新的组合面域。

（1）差运算——使用被减面域的Boolean方法，第一个参数为acSubtraction，第二个参数为减去的面域。

（2）并运算——可以使用任何一个参与运算面域对象的Boolean方法，第一个参数为acUnion，第二个参数为参与并运算的其它面域。

（3）交运算——可以使用任何一个参与交运算面域对象的Boolean方法，第一个参数为acIntersection方法，第二个参数为参与交运算的其它面域。

例5-13：

生成两个简单面域，并进行差运算创建组合面域。

SubCh5_CreateCompositeRegions（）

DimborderAsAcadCircle

Dimcp（0To2）AsDouble

DimrrAsDouble

cp（0）=30:

cp

（1）=15:

cp

（2）=0

rr=7

Setborder=ThisDrawing.ModelSpace.AddCircle（cp,rr）

DimRObjectAsVariant

DimPObjectAsVariant

Dimcurves1（0To0）AsObject

Setcurves1（0）=border

RObject=ThisDrawing.ModelSpace.AddRegion（curves1）

DimpolyobjectAsAcadLWPolyline

DimvetP（0To7）AsDouble

vetP（0）=5:

vetP

（1）=25:

vetP

（2）=45:

vetP（3）=25

vetP（4）=45:

vetP（5）=5:

vetP（6）=5:

vetP（7）=5

Setpolyobject=ThisDrawing.ModelSpace.AddLightWeightPolyline（vetP）

polyobject.Closed=True

Dimcurves2（0To0）AsAcadEntity

Setcurves2（0）=polyobject

PObject=ThisDrawing.Modelspace.ModelSpace.AddRegion（curves2）

PObject（0）.BooleanacSubtraction,RObject（0）

PObject（0）.Update

EndSub

5.1.9图案填充

图案填充可以使用某种图案来填充图形中的指定区域。

创建图案填充区域的过程通常是先用AddHatch方法创建Hatch对象，然后确定该区域的边界，最后执行Evaluate方法，先计算后才能显示。

1．创建Hatch对象

创建Hatch对象要使用AddHatch方法。

该方法有四个参数：

依次为图案类型、图案名称、关联性和图案填充对象类型。

语法：

RetVal=object.AddHatch（PatternType,PatternName,Associativity[,HatchObjectType]）

参数：

（1）PatternType——图案类型

该参数分为AcPatternType和AcGradientType两种类型。

如果HatchObjectType参数的值为AcHatchObject，则该参数为AcPatternType类型；如果HatchObjectType参数的值为AcGradientObject，则该参数为AcGradientPatternType类型。

图案类型的常数按以下三种选用：

●AcHatchPatternTypePredefined——从AutoCAD提供的acad.pat文件中选择图案名称。

●AcHatchPatternTypeUserDefined——用当前线型定义直线图案。

●AcHatchPatternTypeCustomDefined——从用户定义的PAT文件中选择图案名称（而不是从acad.pat文件中选择）。

（2）PatternName——图案名称

该名称在所选的图案类型中必须是有效的名称。

例如：

当选用AcHatchPatternTypePredefined图案类型时，可选用“ANSI31”。

（3）Associativity——关联性

要创建与其边界相关联的