dgp000 发表于 2005-7-4 16:38:00

请问高手,程序错在哪里?

'*****************************************************
'功能:求得所有相同层的面积
'参数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望赐教!

efan2000 发表于 2005-7-4 19:21:00

1、EntityObj必须是能构成面域的对象,闭合是必要条件。
2、AddRegion返回的是对象数组,而不是单一实体。

dgp000 发表于 2005-7-4 21:31:00

谢谢斑竹的赐教!我还想请教几点:
1、如何判断EntityObj是闭合的?
2、由EntityObj如何得出数组?
可否帮我修改以上程序!
页: [1]
查看完整版本: 请问高手,程序错在哪里?