AutoCAD VBA面域操作
2011-03-21 15:51 精诚所至 金石为开 阅读(1095) 评论(0) 编辑 收藏 举报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
代码完。
![](https://img2024.cnblogs.com/blog/35695/202408/35695-20240817093720789-1485312622.jpg)
![](https://img2024.cnblogs.com/blog/35695/202408/35695-20240817093720789-1485312622.jpg)