然后提示用户输入多段线

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

这是我的旧的
随意换成你的西装

[code]选项明确公共子动态多段线（）作为变量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！看起来效果会很好。

[编程交流] 然后提示用户输入多段线

发表回复

精选推荐