cad墙线打断lisp_[求助]很多相交线快速打断 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...

先提供一个交点处等距打断的vba程序，可根据需要来改进。

Sub 交点处等间距打断()

On Error Resume Next

Dim ssetObj As AcadSelectionSet

'创建选择集

Set ssetObj = ThisDrawing.SelectionSets("test")

If Err Then

Err.Clear

Set ssetObj = ThisDrawing.SelectionSets.Add("test")

End If

ssetObj.Clear '首先清空选择集

ssetObj.Select acSelectionSetAll

Dim jianju As Double

jianju = ThisDrawing.Utility.GetReal("指定打断间距：")

If Err Then Exit Sub

'  取得交点

Dim i As Long

Dim j As Long

Dim k As Long

Dim pt As Variant

Dim points() As Double

Dim N As Long

N = 0

For i = 0 To ssetObj.Count - 2

For j = i + 1 To ssetObj.Count - 1

pt = ssetObj(i).IntersectWith(ssetObj(j), acExtendNone)

If UBound(pt) >= 2 Then