[求助]CAD vba 面内存在孤岛的面积计算？

lamboy

如题，用程序做，就像Cass宗地的面积获取的功能一样？如何做？谢谢！

兰州人

将图形用JPG文件发上来，说的更清楚点。

一般解决方案。

1、封闭多义线，用 pl.area获得面积。

   Dim Pl As AcadPolyline
   Pl.Area

2、用面域

   Dim aa As AcadRegion
   aa.Area

azjmjsj

求出绿色阴影部分面域的面积

兰州人

azjmjsj发表于2007-12-10 22:02:00求出绿色阴影部分面域的面积38671

用面域法解。多义线解起来更麻烦。

Dim aa As AcadRegion
   aa.Area

∑面域=A面域-B面域-C面域

 在AutoCAD开发者帮助文件示例程序如下

    ' 创建两个圆，一个代表房间，

    ' 另一个代表房间中的柱子

    Dim RoomObjects(0 To 1) As AcadCircle

    Dim center(0 To 2) As Double

    Dim radius As Double

    center(0) = 4

    center(1) = 4

    center(2) = 0

    radius = 2#

    Set RoomObjects(0) = ThisDrawing.ModelSpace. _

                         AddCircle(center, radius)

    radius = 1#

    Set RoomObjects(1) = ThisDrawing.ModelSpace. _

                         AddCircle(center, radius)

    ' 从这两个圆创建一个面域

    Dim regions As Variant

    regions = ThisDrawing.ModelSpace.AddRegion(RoomObjects)

    ' 将面域复制到面域变量中以便使用

    Dim RoundRoomObj As AcadRegion

    Dim PillarObj As AcadRegion

    If regions(0).Area > regions(1).Area Then

        ' 第一个面域是房间

        Set RoundRoomObj = regions(0)

        Set PillarObj = regions(1)

    Else

        ' 第一个面域是柱子

        Set PillarObj = regions(0)

        Set RoundRoomObj = regions(1)

    End If

' 从地板空间减去柱子空间，

    ' 以获得表示地毯总面积的面域。

    RoundRoomObj.Boolean acSubtraction, PillarObj

    ' 使用 Area 特性确定出地毯的总面积

    MsgBox "The carpet area is: " & RoundRoomObj.Area

End Sub

lamboy

感谢 版主 解答，感谢 azjmjsj 补充问题

上面情况可以解决

可是 我的数据中  有好多类似的情况  而且 要获得每个面 的面积 使用Text标注在图面上

该如何 批处理 获取？