如何用VBA求面积？

myfreemind

efan2000发表于2004-1-3 17:01:00呵呵，这个也可以求面积。在封闭区域内选择一点，然后生成它的边界，这个边界就是封闭的多段线，直接使用它的属性就行了。


Sub test()
     
     ' 当前图纸的实体数目
     Di

好程序！送花一朵！

chb801

好程序啊！我复制了！！

chb801

哦！刚才忘记了，送花一朵！

yicol

好好好，OK

yu-gn

大虾就是大虾

smpoy

  
呵呵，这个也可以求面积。在封闭区域内选择一点，然后生成它的边界，这个边界就是封闭的多段线，直接使用它的属性就行了。

3. Sub  test()
4.         
5.         '  当前图纸的实体数目
6.         Dim  n  As  Long
7.         n  =  ThisDrawing.ModelSpace.Count
8.         
9.         '  调用BOUNDARY命令获取某一点处的边界
10.         Dim  Pt  As  Variant
11.         Pt  =  ThisDrawing.Utility.GetPoint(,  "指定内部点:  ")
12.         ThisDrawing.SendCommand  "_-Boundary"  &  vbCr  &  Pt(0)  &  ","  &  Pt(1)  &  vbCr  &  vbCr
13.         
14.         '  如果存在边界，则会生成新的实体
15.         Dim  lwpLineObj  As  AcadLWPolyline
16.         If  ThisDrawing.ModelSpace.Count  >  n  Then
17.                 Set  lwpLineObj  =  ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count  -  1)
18.                 MsgBox  lwpLineObj.Area
19.                 lwpLineObj.Delete
20.         Else
21.                 MsgBox  "未发现有效的边界。"
22.         End  If
23. End  Sub

Sub  test()                  '  当前图纸的实体数目         Dim  n  As  Long         n  =  ThisDrawing.ModelSpace.Count                  '  调用BOUNDARY命令获取某一点处的边界         Dim  Pt  As  Variant         Pt  =  ThisDrawing.Utility.GetPoint(,  "指定内部点:  ")         ThisDrawing.SendCommand  "_-Boundary"  &  vbCr  &  Pt(0)  &  ","  &  Pt(1)  &  vbCr  &  vbCr                  '  如果存在边界，则会生成新的实体         Dim  lwpLineObj  As  AcadLWPolyline         If  ThisDrawing.ModelSpace.Count  >  n  Then                 Set  lwpLineObj  =  ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count  -  1)                 MsgBox  lwpLineObj.Area                 lwpLineObj.Delete         Else                 MsgBox  "未发现有效的边界。"         End  If End  Sub

顶一下，好程序

qqcat521

困扰好久的问题终于解决了，支持一下。耶

桃花岛岛主

这段代码能转成.NET???