请问高手,程序错在哪里?
'*****************************************************'功能:求得所有相同层的面积
'参数1:
'参数2:
'参数2:
'返回:面积
'*****************************************************
Public Function MulLayerArea() As Double
Dim PointObj As AcadPoint '用户获得的实体上任意一点
Dim Ps As Variant '用户获得的任意一点坐标
Dim LayerName As AcadLayer '用户获得的坐标点图层
Dim SpaceCount As Long
Dim n As Integer
Dim EntityObj As AcadEntity '遍历的实体
Dim RegionObj As Variant '创建所有具有相同层的面域
Dim AllLayerArea As Double '所有相同层的面积
AllLayerArea = 0
Ps = ThisDrawing.Utility.GetPoint(, "指定内部点")
Set PointObj = ThisDrawing.ModelSpace.AddPoint(Ps)
'LayerName = PointObj.Layer
For Each EntityObj In ThisDrawing.ModelSpace
'Set EntityObj = ThisDrawing.ModelSpace.Item(n)
If EntityObj.Layer = PointObj.Layer Then
RegionObj = ThisDrawing.ModelSpace.AddRegion(EntityObj)
AllLayerArea = AllLayerArea + RegionObj.Area
End If
Next EntityObj
MsgBox AllLayerArea
End Function望赐教! 1、EntityObj必须是能构成面域的对象,闭合是必要条件。
2、AddRegion返回的是对象数组,而不是单一实体。 谢谢斑竹的赐教!我还想请教几点:
1、如何判断EntityObj是闭合的?
2、由EntityObj如何得出数组?
可否帮我修改以上程序!
页:
[1]