多段线，圆，弧，直线，曲线相交点打断。大量的话速度比较慢，希望大神优化
(defun tt (ss0 ss1 / e1 e2 @pt2 pt1 ptn)(vl-load-com)
(setq ptn '())
(setqe1 (vlax-ename->vla-object ss0)
e2 (vlax-ename->vla-object ss1)
)
(setq @pt2 (vlax-invoke e1 'IntersectWith e2 0))
(repeat (/ (length @pt2) 3)
(setq pt1 (list (car @pt2) (cadr @pt2) (caddr @pt2)))
(setq @pt2 (cdddr @pt2))
(setq ptn (cons pt1 ptn))
)
(reverse ptn)
)
(defun enjddd (ent ptlst / e entlst id tement tempt pt l)
(if (= (cdr (assoc 0 (entget ent))) "CIRCLE")
(progn
(setq
l (+ (angle (cdr (assoc 10 (entget ent))) (car ptlst)) 0.00000001)
)
(setq pt (polar (cdr (assoc 10 (entget ent)))
l
(cdr (assoc 40 (entget ent)))
)
)
(command "break" ent (car ptlst) pt)
)
)
(setqentlst (cons ent entlst)
id (entlast)
)
(while (setq tempt (car ptlst))
(foreach e entlst
(command "BREAK" e tempt tempt)
(if (setq tement (entnext id))
(setq entlst (cons tement entlst)
id tement
)
)
)
(setq ptlst (cdr ptlst))
)
)
(defun c:tr (/ ss1 ssn ssm i j k ssc ptlst ptls)
(vl-load-com)
(setqptlst nil
ptlsnil
ol(getvar "osmode")
ss1 (ssget)
i -1
)
(setvar "osmode" 0)
(while (setq ssn (ssname ss1 (setq i (1+ i))))
(setq j 0)
(setq ptlst nil)
(repeat (sslength ss1)
(setq ssm (ssname ss1 j)
ptlst (append (tt ssn ssm) ptlst)
j (1+ j)
)
)
(setq ptls (cons ptlst ptls))
)
(setq ptls (reverse ptls))
(setq k 0)
(while (setq ssc (ssname ss1 k))
(enjddd ssc (nth k ptls))
(setq k (1+ k))
)
(setvar "osmode" 0)
) 本帖最后由 尘缘一生 于 2022-5-5 01:23 编辑
速度问题，就是用的COMMAND 原因，抛弃command 程序会写很长，本坛有部分代码，我整合过，整理下，并没有解决速度问题。
http://bbs.mjtd.com/thread-185383-1-1.html
;选择集交点断开modify by 尘缘一生QQ:15290049
;;两实体（en1 en2） 为实体名 -------交点------(一级)----------------
;;k:（0--不延伸,1--延伸基本对象,2--延伸参数传递的对象,3--延伸)
(defun sl-Curveinters (en1 en2 k / pl pts)
(setq pl (vlax-invoke (vlax-ename->vla-object en1) 'IntersectWith (vlax-ename->vla-object en2) k))
(while pl
(setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))
pl (cdr (cdr (cdr pl)))
)
)
pts
)
;;实体与其交点打断--------(一级)------------
(defun break_obj (ent brkptlst / brkobjlst en tp maxparam closedobj minparam obj obj2break p1param p2 p2param)
(setq obj2break ent brkobjlst (list ent) tp (cdr (assoc 0 (entget ent))))
(foreach brkpt brkptlst
(if brkobjlst
(progn
(if (not (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj2break brkpt))))
(foreach obj brkobjlst
(if (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj brkpt)))
(setq obj2break obj)
)
)
)
)
)
;;---------------------------------
(cond
((and (= "SPLINE" tp)
(vlax-curve-isclosed obj2break))
(setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
p2 (vlax-curve-getpointatparam obj2break (+ p1param 0.000001))
)
(command "._break" obj2break (trans brkpt 0 1) (trans p2 0 1))
)
((= "CIRCLE" tp)
(setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
p2 (vlax-curve-getpointatparam obj2break (+ p1param 0.000001))
)
(command "._break" obj2break (trans brkpt 0 1) (trans p2 0 1))
(setq tp "ARC")
)
((and (= "ELLIPSE" tp) (vlax-curve-isclosed obj2break))
(setq p1param(vlax-curve-getparamatpoint obj2break brkpt)
p2param(+ p1param 0.000001)
minparam (min p1param p2param)
maxparam (max p1param p2param)
obj (vlax-ename->vla-object obj2break)
)
(vlax-put obj 'startparameter maxparam)
(vlax-put obj 'endparameter (+ minparam 2pi))
)
(t
(setq closedobj (vlax-curve-isclosed obj2break))
(command "._break" obj2break (trans brkpt 0 1) (trans brkpt 0 1))
(if (not closedobj)
(setq brkobjlst (cons (entlast) brkobjlst))
)
)
)
)
)
;;主程序------------------
;支持 LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
(defun c:tr (/ ss1 ssn ssm i j k ssc ptlst ptls)
(vl-load-com)
(prompt "\n 支持 LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")
(setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
(setq ptlst nil ptls nil ol (getvar "osmode") i -1)
(setvar "osmode" 0)
(while (setq ssn (ssname ss1 (setq i (1+ i))))
(setq j 0)
(setq ptlst nil)
(repeat (sslength ss1)
(setq ssm (ssname ss1 j)
ptlst (append (sl-Curveinters ssn ssm 0) ptlst)
j (1+ j)
)
)
(setq ptls (cons ptlst ptls))
)
(setq ptls (reverse ptls))
(setq k 0)
(while (setq ssc (ssname ss1 k))
(break_obj ssc (nth k ptls))
(setq k (1+ k))
)
(setvar "osmode" 0)
)
尘缘一生 发表于 2022-5-5 01:08
速度问题，就是用的COMMAND 原因，抛弃command 程序会写很长，本坛有部分代码，我整合过，整理下，并没有解 ...
能添加打断后删除吗？
类似下面这样
厉害！！！！ 真是太牛了 高手出手那纯属娱乐。只是热心帮忙 请问出现这个no function definition: XLR_JDLB_SS，该怎么解决 凡海涛在石大 发表于 2016-4-10 23:14 static/image/common/back.gif
请问出现这个no function definition: XLR_JDLB_SS，该怎么解决
回复错地方了
真是太牛了,高手出手那纯属娱乐。只是热心帮忙 太厉害了 终于找到了 我之前找到的 只能打断直线现在这个很全面 很好用 小小的人 发表于 2020-5-4 21:13
太厉害了 终于找到了 我之前找到的 只能打断直线现在这个很全面 很好用
{:1_1:}{:1_1:}{:1_1:} 顶起，上班时试一试