AutoCAD VBA面域操作

AutoCAD VBA面域操作，和图案填充类似，代码如下。

Public Function AddRegion(ByRef objList() As AcadEntity) As Variant
On Error GoTo errHandle
AddRegion = ThisDrawing.ModelSpace.AddRegion(objList)
Exit Function
errHandle:
If Err.Number = -2145386493 Then
MsgBox "面域定义边界未闭合！", vbCritical
End If
Err.Clear
End Function
Public Function AddRegionPt(ByRef ptArr() As Double) As Variant
Dim objPline As AcadLWPolyline
If (UBound(ptArr) + 1) Mod 2 <> 0 Then
MsgBox "数组元素个数必须为偶数！"
Exit Function
End If
Set objPline = ThisDrawing.ModelSpace.AddLightWeightPolyline(ptArr)
objPline.Closed = True
Dim objList(0) As AcadEntity
Set objList(0) = objPline
AddRegionPt = AddRegion(objList)
End Function
Public Sub TestRegion()
Dim objList(3) As AcadEntity
Dim pt1(2) As Double
Dim pt2(2) As Double
Dim pt3(2) As Double
Dim pt4(2) As Double
pt1(0) = 100: pt1(1) = 100: pt1(2) = 0
pt2(0) = 140: pt2(1) = 100: pt2(2) = 0
pt3(0) = 140: pt3(1) = 125: pt3(2) = 0
pt4(0) = 100: pt4(1) = 125: pt4(2) = 0
Set objList(0) = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
Set objList(1) = ThisDrawing.ModelSpace.AddLine(objList(0).EndPoint, pt3)
Set objList(2) = ThisDrawing.ModelSpace.AddLine(objList(1).EndPoint, pt4)
Set objList(3) = ThisDrawing.ModelSpace.AddLine(objList(2).EndPoint, objList(0).StartPoint)
AddRegion objList
Dim ptArr(7) As Double
ptArr(0) = 160: ptArr(1) = 100: ptArr(2) = 200: ptArr(3) = 100
ptArr(4) = 200: ptArr(5) = 125: ptArr(6) = 160: ptArr(7) = 125
AddRegionPt ptArr
End Sub

代码完。