如何把它转换成VBA代码，请各位指点

smpoy

<BR>(defun c:mj()                         ;标注面积<BR>(setq p (getpoint "请输入标注点位:"))<BR>(command "bpoly" p "")<BR>(command "area" "o" (entlast))<BR>(setq mj (getvar "area"))<BR>(command "erase" (entlast) "")<BR>(setq smj (rtos mj 2 3))<BR>(command "layer" "set" "面积" ""         (command "text" p "1" "0" smj))<BR>)

smpoy

作者：efan2000 2004-1-3 17:01:54)


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

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

  好程序，我在这里找到了。基本差不多，就差一个标注了，我在加上就OK了Set txtobj = ThisDrawing.ModelSpace.AddText(mj1, Pt, 1.5)
  

smpoy

这里高手好多啊。

yzgaozj

高，实在是高

zwd0077

二楼老大，为什么会出现类型不匹配的错误？

mycad

'给efan2000 2004-1-3 17:01:54)的程序稍微修改一下，效果更佳

Sub mj() '计算闭合实体面积的小程序
   
    ' 当前图纸的实体数目
    Dim n As Long
    Dim txtobj As AcadText
    Dim ss As String
   
    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)
      
        ss = "面积=" & lwpLineObj.Area & "（平方米）"
         MsgBox ss
         Set txtobj = ThisDrawing.ModelSpace.AddText(ss, Pt, 1.5)
        lwpLineObj.Delete
    Else
        MsgBox "未发现有效的边界。"
    End If
   
  

End Sub

rielzhou

兄弟，你可是救我于水火啊，今天正在想办法解决边界生成后获取面积的问题呢！小弟万分感谢啊！

天龙八部

有些错误，ThisDrawing.SendCommand "_-Boundary" & vbCr & Pt(0) & "," & Pt(1) & vbCr & vbCr
这一句，sendcommand方法在调用的时候不像VLISP的command可以直接调用点坐标，sendcommand需要事先转换为vlisp点坐标，