社区 › Auto Lisp › 在点处打断LW多段线

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

在点处打断LW多段线

你好
我想在给定的点上打断一条多段线。操作所需的所有数据，我无法用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）。此代码适用于一次性打断选定的多段线。
 

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

Lee Mac 发表于 2022-7-6 11:58:44

嘿，伙计们，有点离题了，但你们可能喜欢读这篇文章

SZLMCL 发表于 2022-7-6 12:21:00

 
对不起，我是新来的。

Lee Mac 发表于 2022-7-6 12:28:53

 
没问题，只是提醒一下

查看完整版本: 在点处打断LW多段线