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