然后提示用户输入多段线
大家好,我觉得有一个非常简单的解决方案。我想提示用户创建一条多段线(应该是闭合的,即区域,但这是另一个故事),然后对生成的区域(我要找的区域)做一些事情。此外,使用acSelectionSetLast集合获取多段线(?)。
Sub buildingSQFT()
Dim Ent As AcadEntity
Dim Sset As AcadSelectionSet
ThisDrawing.ActiveSpace = acModelSpace
MsgBox ("Draw Polyline to define the area.")
WHAT COULD GO HERE TO "WAIT" FOR THE USER TO DRAW THE POLYLINE?
On Error Resume Next
ThisDrawing.SelectionSets.Item("buildingSQFT").Delete
Set Sset = ThisDrawing.SelectionSets.Add("buildingSQFT")
Sset.Select acSelectionSetLast
Sset.Delete
End Sub
谢谢大家! 这是我的旧的
随意换成你的西装
选项明确公共子动态多段线()作为变量Dim DBLCORS()作为双Dim i作为长Dim oPoly作为AcadLWPolyline Dim oEnt(0)作为身份Dim regVar作为变量Dim oText作为变量Dim lngResp作为长Dim regObj作为变量Dim txtPt(2)作为双On错误恢复下一个pickPt=此绘图。公用事业GetPoint(,vbCr和“第一点:”)如果Err=0,则ReDim dblCoors(1)dblCoors(i)=pickPt(0):dblCoors(i+1)=pickPt(1)Do直到Err。数字0 i=i+2 pickPt=ThisDrawing。公用事业GetPoint(pickPt,vbCr&“拾取下一个点[或按Enter键停止]:”)ReDim Preserve DBLCORS(UBound(DBLCORS)+2)DBLCORS(i)=pickPt(0):DBLCORS(i+1)=pickPt(1)如果oPoly为空,则设置oPoly=ThisDrawing。模型空间。添加LightweightPolyline(dblCoors)或oPoly。坐标=DBLCORS End If Loop End If oPoly。闭合=真实oPoly。更新集合oEnt(0)=oPoly regVar=ThisDrawing。模型空间。AddRegion(oEnt)Set regObj=regVar(0)cenPt=regObj。质心调试。打印“轮廓的质心为”&顶点(0)&“,”&顶点(1),“区域示例”' 谢谢J!看起来效果会很好。
页:
[1]