VB编程在AutoCAD绘图空间创建实心面和图案填充 - 精诚所至 金石为开

VB编程在AutoCAD绘图空间创建实心面和图案填充

利用AddSolid方法可以创建实心面，Solid为3或4条变组成的实心面，应用该方法需要4个三维顶点作为参数，当系统变量FILLMODE的值为0时，实心面不填充，为1时填充。语法getval=objcect.AddSolid(point1,point2,point3,point4)。getval新创建的实心面对象，object模型空间、图纸空间或块对象，point双精度型定点坐标。

利用AddHatch方法可以创建图案填充，语法格式如下。

getval=object.AddHatch(PatternType,PatternName,Associativity)

geval新创建的图案填充对象，object模型空间、图纸空间或块对象，PatternType表示图案填充类型的索引，它有三个可选值，acHatchPatternTypePreDefined用AutoCAD标注图案文件Acad.Pat定义的图案进行填充。acHatchPatternTypeDefined用当前线型定义的填充线填充，acHatchPatternTypeCustomDefined用用户自定义的图案文件进行填充。PatternName图案填充名称，Associativity表示图案填充是否与边界关联，如果为true则填充关联边界，边界改变则填充也改变，如果为false则填充不关联边界。

如下代码给两个同心圆组成的圆环进行填充，并将填充关联边界。

Private Sub Command1_Click()

Dim hatchobj As AcadHatch

Dim patternname As String

Dim patterntype As Long

Dim bassociativity As Boolean

patterntype = 0

patternname = "ANSI31"

bassociativity = True

Set hatchobj = acadapp.ActiveDocument.ModelSpace.AddHatch(patterntype, patternname, bassociativity)

Dim outerloop(0 To 0) As AcadEntity

Dim innerloop(0 To 0) As AcadEntity

Dim center(0 To 2) As Double

Dim radius As Double

center(0) = 3: center(1) = 3: center(2) = 0

radius = 20

Set outerloop(0) = acadapp.ActiveDocument.ModelSpace.AddCircle(center, radius)

Set innerloop(0) = acadapp.ActiveDocument.ModelSpace.AddCircle(center, radius / 2)

hatchobj.AppendInnerLoop (outerloop)

hatchobj.AppendInnerLoop (innerloop)

hatchobj.Evaluate

acadapp.ActiveDocument.Regen True

ZoomExtents

End Sub