社区 › 编程申请 › 如何把它转换成VBA代码，请各位指点

smpoy 发表于 2005-7-1 16:51:00

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

<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 发表于 2005-7-3 09:40:00

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

http://www.mjtd.com/bbs/skins/default/topicface/face1.gif

呵呵，这个也可以求面积。在封闭区域内选择一点，然后生成它的边界，这个边界就是封闭的多段线，直接使用它的属性就行了。
Subtest()
      
      '当前图纸的实体数目
      DimnAsLong
      n=ThisDrawing.ModelSpace.Count
      
      '调用BOUNDARY命令获取某一点处的边界
      DimPtAsVariant
      Pt=ThisDrawing.Utility.GetPoint(,"指定内部点:")
      ThisDrawing.SendCommand"_-Boundary"&vbCr&Pt(0)&","&Pt(1)&vbCr&vbCr
      
      '如果存在边界，则会生成新的实体
      DimlwpLineObjAsAcadLWPolyline
      IfThisDrawing.ModelSpace.Count>nThen
                SetlwpLineObj=ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count-1)
                MsgBoxlwpLineObj.Area
                lwpLineObj.Delete
      Else
                MsgBox"未发现有效的边界。"
      EndIf
EndSub

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

smpoy 发表于 2005-7-3 09:41:00

这里高手好多啊。

yzgaozj 发表于 2005-8-26 16:01:00

高，实在是高

zwd0077 发表于 2005-12-17 16:33:00

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

mycad 发表于 2006-1-13 20:22:00

<P>'给efan2000 2004-1-3 17:01:54)的程序稍微修改一下，效果更佳</P>
<P>Sub mj() '计算闭合实体面积的小程序<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; ' 当前图纸的实体数目<BR>&nbsp;&nbsp;&nbsp; Dim n As Long<BR>&nbsp;&nbsp;&nbsp; Dim txtobj As AcadText<BR>&nbsp;&nbsp;&nbsp; Dim ss As String<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; n = ThisDrawing.ModelSpace.Count<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; ' 调用BOUNDARY命令获取某一点处的边界<BR>&nbsp;&nbsp;&nbsp; Dim Pt As Variant<BR>&nbsp;&nbsp;&nbsp; Pt = ThisDrawing.Utility.GetPoint(, "指定内部点: ")<BR>&nbsp;&nbsp;&nbsp; ThisDrawing.SendCommand "_-Boundary" &amp; vbCr &amp; Pt(0) &amp; "," &amp; Pt(1) &amp; vbCr &amp; vbCr<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; ' 如果存在边界，则会生成新的实体<BR>&nbsp;&nbsp;&nbsp; Dim lwpLineObj As AcadLWPolyline<BR>&nbsp;&nbsp;&nbsp; If ThisDrawing.ModelSpace.Count &gt; n Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set lwpLineObj = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ss = "面积=" &amp; lwpLineObj.Area &amp; "（平方米）"<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox ss<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set txtobj = ThisDrawing.ModelSpace.AddText(ss, Pt, 1.5)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; lwpLineObj.Delete<BR>&nbsp;&nbsp;&nbsp; Else<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "未发现有效的边界。"<BR>&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp; </P>
<P>End Sub<BR></P>

rielzhou 发表于 2007-9-6 16:39:00

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

天龙八部 发表于 2007-9-6 16:51:00

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

查看完整版本: 如何把它转换成VBA代码，请各位指点