在点处打断LW多段线

SZLMCL · 发表于 2022-7-6 11:26:06

你好
我想在给定的点上打断一条多段线。操作所需的所有数据，我无法用VBA实现。
如果VBA无法执行该操作，则可以使用Sendcommand？（即使使用VBA中的LISP代码运行？）

例如：

我的多段线：

我隐藏
此图纸。使活动
此图纸。公用事业GetEntity objent、varPick、vbCr和“拾取多段线：”
我显示

制动点：

X=1000 Y=500 Z=0

尝试中断（不工作）：

Dim xkoord为双精度
Dim ykoord为双色

xkoord=1000
ykoord=500

设置vonalánc=objent。复制（）
此图纸。SendCommand“_BREAK”&vbCr

将kiv设置为AcadSelectionSet
出错时继续下一步
设置kiv=此图形。选择集（“SSET”）
千伏。删去

设置kiv=此图形。选择集。添加（“SSET”）
千伏。AddItems vonalánc'

千伏。选择Vonalánc'
此图纸。SendCommand“F”和vbCr“选择第一点中断”
此图纸。SendCommand替换（xkoord，“，”，“）&“，”&替换（ykoord，“，”）&vbCr
此图纸。SendCommand替换（xkoord，“，”，“）&“，”&替换（ykoord，“，”）&vbCr
千伏。选择acSelectionSetPrevious
“千伏。擦除

设置vlánc=kiv。项目（0）
MsgBox vlánc。长度

有人能帮忙修复这个代码吗？非常感谢。

SZLMCL · 发表于 2022-7-6 11:53:15

Hy公司

我解决了这个问题，但用for。。next不起作用（通过acSelectionSetPrevious）。此代码适用于一次性打断选定的多段线。

copy


Public Sub MegTör(ByVal objektum As AcadLWPolyline, ByVal Xkoordináta As Double, ByVal Ykoordináta As Double)
   Dim s As AcadSelectionSet
   Dim h As AcadEntity
   
   ThisDrawing.SendCommand Chr(28)
   ThisDrawing.SendCommand Chr(28)
   ThisDrawing.SendCommand "_BREAK" & vbCr
   
   On Error Resume Next
   ThisDrawing.SelectionSets("TempSSet").Delete
   Set s = ThisDrawing.SelectionSets.Add("TempSSet")
   
   Set h = objektum.Copy
   s.AddItems h
   h.Highlight True
   
   ThisDrawing.SelectionSets.Item("TempSSet").Select acSelectionSetPrevious
       
   ThisDrawing.SendCommand Replace(Xkoordináta, ",", ".") & "," & Replace(Ykoordináta, ",", ".") & ",0" & vbCr
   ThisDrawing.SendCommand Replace(Xkoordináta, ",", ".") & "," & Replace(Ykoordináta, ",", ".") & ",0" & vbCr
           
   h.Highlight False
   s.Erase
   s.Delete
   Application.Update
End Sub