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

lamboy 发表于 2007-12-10 11:39:00

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

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

兰州人 发表于 2007-12-10 15:34:00

将图形用JPG文件发上来，说的更清楚点。
一般解决方案。
1、封闭多义线，用 pl.area获得面积。
   Dim Pl As AcadPolyline
   Pl.Area
2、用面域
   Dim aa As AcadRegion
   aa.Area

azjmjsj 发表于 2007-12-10 22:02:00

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

兰州人 发表于 2007-12-11 09:22:00

用面域法解。多义线解起来更麻烦。
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.AreaEnd Sub

lamboy 发表于 2007-12-11 14:26:00

感谢 版主 解答，感谢 azjmjsj 补充问题
上面情况可以解决
可是 我的数据中有好多类似的情况而且 要获得每个面 的面积 使用Text标注在图面上
该如何 批处理 获取？

查看完整版本: [求助]CAD vba 面内存在孤岛的面积计算？