Tipo166 发表于 2022-7-6 17:26:10

然后提示用户输入多段线

大家好,
我觉得有一个非常简单的解决方案。我想提示用户创建一条多段线(应该是闭合的,即区域,但这是另一个故事),然后对生成的区域(我要找的区域)做一些事情。此外,使用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

 
谢谢大家!

fixo 发表于 2022-7-6 18:22:13

这是我的旧的
随意换成你的西装
 
选项明确公共子动态多段线()作为变量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),“区域示例”'

Tipo166 发表于 2022-7-6 18:36:31

谢谢J!看起来效果会很好。
页: [1]
查看完整版本: 然后提示用户输入多段线