可以向图案填充边界附加或插入环。关联图案填充随其边界的改变而更新,非关联图案填充则不会更新。
本例创建一个关联的图案填充,然后创建一个圆并将该圆作为内部环附加到图案填充。
Sub Ch4_AppendInnerLoopToHatch()
Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
' 定义和创建图案填充
patternName = "ANSI31"
PatternType = 0
bAssociativity = True
Set hatchObj = ThisDrawing.ModelSpace. _
AddHatch(PatternType, patternName, bAssociativity)
' 创建图案填充的外部环
Dim outerLoop(0 To 1) As AcadEntity
Dim center(0 To 2) As Double
Dim radius As Double
Dim startAngle As Double
Dim endAngle As Double
center(0) = 5: center(1) = 3: center(2) = 0
radius = 3
startAngle = 0
endAngle = 3.141592
Set outerLoop(0) = ThisDrawing.ModelSpace. _
AddArc(center, radius, startAngle, endAngle)
Set outerLoop(1) = ThisDrawing.ModelSpace. _
AddLine(outerLoop(0).startPoint, outerLoop(0).endPoint)
' 将外部环附加到 Hatch 对象
hatchObj.AppendOuterLoop (outerLoop)
' 创建一个圆作为图案填充的内部环
Dim innerLoop(0) As AcadEntity
center(0) = 5: center(1) = 4.5: center(2) = 0
radius = 1
Set innerLoop(0) = ThisDrawing.ModelSpace. _
AddCircle(center, radius)
' 将圆作为内部环附加到图案填充
hatchObj.AppendInnerLoop (innerLoop)
' 计算并显示图案填充
hatchObj.Evaluate
ThisDrawing.Regen True
End Sub