多段线，圆，弧，直线，曲线相交点打断。大量的话速度比较慢，希望大神优化

陈进佳

2. (defun tt (ss0 ss1 / e1 e2 @pt2 pt1 ptn)
   
3.   (vl-load-com)
   
4.   (setq ptn '())
   
5.   (setq  e1 (vlax-ename->vla-object ss0)
   
6.   e2 (vlax-ename->vla-object ss1)
   
7.   )
   
8.   (setq @pt2 (vlax-invoke e1 'IntersectWith e2 0))
   
9.   (repeat (/ (length @pt2) 3)
   
10.     (setq pt1 (list (car @pt2) (cadr @pt2) (caddr @pt2)))
    
11.     (setq @pt2 (cdddr @pt2))
    
12.     (setq ptn (cons pt1 ptn))
    
13.   )
    
14.   (reverse ptn)
    
15. )
    
16. (defun enjddd (ent ptlst / e entlst id tement tempt pt l)
    
17.   (if (= (cdr (assoc 0 (entget ent))) "CIRCLE")
    
18.     (progn
    
19.       (setq
    
20.   l (+ (angle (cdr (assoc 10 (entget ent))) (car ptlst)) 0.00000001)
    
21.       )
    
22.       (setq pt (polar (cdr (assoc 10 (entget ent)))
    
23.           l
    
24.           (cdr (assoc 40 (entget ent)))
    
25.          )
    
26.       )
    
27.       (command "break" ent (car ptlst) pt)
    
28.       
    
29.       )
    
30.    
    
31.   )
    
32.   
    
33. 
    
34.   (setq  entlst (cons ent entlst)
    
35.   id     (entlast)
    
36.   )
    
37.   (while (setq tempt (car ptlst))
    
38.     (foreach e entlst
    
39.       (command "BREAK" e tempt tempt)
    
40.       (if (setq tement (entnext id))
    
41.   (setq entlst (cons tement entlst)
    
42.         id     tement
    
43.   )
    
44.       )
    
45.     )
    
46.     (setq ptlst (cdr ptlst))
    
47.   )
    
48. )
    
49. (defun c:tr (/ ss1 ssn ssm i j k ssc ptlst ptls)
    
50.   (vl-load-com)
    
51.   (setq  ptlst nil
    
52.   ptls  nil
    
53.   ol(getvar "osmode")
    
54.   
    
55.   ss1   (ssget)
    
56.   i     -1
    
57.   )
    
58.   (setvar "osmode" 0)
    
59.   (while (setq ssn (ssname ss1 (setq i (1+ i))))
    
60.     (setq j 0)
    
61.     (setq ptlst nil)
    
62.     (repeat (sslength ss1)
    
63.       (setq ssm    (ssname ss1 j)
    
64.       ptlst (append (tt ssn ssm) ptlst)
    
65.       j    (1+ j)
    
66.       )
    
67.     )
    
68.     (setq ptls (cons ptlst ptls))
    
69.   )
    
70.   (setq ptls (reverse ptls))
    
71.   (setq k 0)
    
72.   (while (setq ssc (ssname ss1 k))
    
73.     (enjddd ssc (nth k ptls))
    
74.     (setq k (1+ k))
    
75.   )
    
76.   (setvar "osmode" 0)
    
77. )

(defun tt (ss0 ss1 / e1 e2 @pt2 pt1 ptn)<br />   (vl-load-com)<br />   (setq ptn '())<br />   (setq  e1 (vlax-ename->vla-object ss0)<br />   e2 (vlax-ename->vla-object ss1)<br />   )<br />   (setq @pt2 (vlax-invoke e1 'IntersectWith e2 0))<br />   (repeat (/ (length @pt2) 3)<br />     (setq pt1 (list (car @pt2) (cadr @pt2) (caddr @pt2)))<br />     (setq @pt2 (cdddr @pt2))<br />     (setq ptn (cons pt1 ptn))<br />   )<br />   (reverse ptn)<br /> )<br /> (defun enjddd (ent ptlst / e entlst id tement tempt pt l)<br />   (if (= (cdr (assoc 0 (entget ent))) "CIRCLE")<br />     (progn<br />       (setq<br />   l (+ (angle (cdr (assoc 10 (entget ent))) (car ptlst)) 0.00000001)<br />       )<br />       (setq pt (polar (cdr (assoc 10 (entget ent)))<br />           l<br />           (cdr (assoc 40 (entget ent)))<br />          )<br />       )<br />       (command "break" ent (car ptlst) pt)<br />       <br />       )<br />     <br />   )<br />   <br /> <br />   (setq  entlst (cons ent entlst)<br />   id     (entlast)<br />   )<br />   (while (setq tempt (car ptlst))<br />     (foreach e entlst<br />       (command "BREAK" e tempt tempt)<br />       (if (setq tement (entnext id))<br />   (setq entlst (cons tement entlst)<br />         id     tement<br />   )<br />       )<br />     )<br />     (setq ptlst (cdr ptlst))<br />   )<br /> )<br /> (defun c:tr (/ ss1 ssn ssm i j k ssc ptlst ptls)<br />   (vl-load-com)<br />   (setq  ptlst nil<br />   ptls  nil<br />   ol(getvar "osmode")<br />   <br />   ss1   (ssget)<br />   i     -1<br />   )<br />   (setvar "osmode" 0)<br />   (while (setq ssn (ssname ss1 (setq i (1+ i))))<br />     (setq j 0)<br />     (setq ptlst nil)<br />     (repeat (sslength ss1)<br />       (setq ssm    (ssname ss1 j)<br />       ptlst (append (tt ssn ssm) ptlst)<br />       j    (1+ j)<br />       )<br />     )<br />     (setq ptls (cons ptlst ptls))<br />   )<br />   (setq ptls (reverse ptls))<br />   (setq k 0)<br />   (while (setq ssc (ssname ss1 k))<br />     (enjddd ssc (nth k ptls))<br />     (setq k (1+ k))<br />   )<br />   (setvar "osmode" 0)<br /> )

尘缘一生

速度问题，就是用的COMMAND 原因，抛弃command 程序会写很长，本坛有部分代码，我整合过，整理下，并没有解决速度问题。
http://bbs.mjtd.com/thread-185383-1-1.html

2. ;选择集交点断开  modify by 尘缘一生  QQ:15290049
   
3. 
   
4. ;;两实体（en1 en2） 为实体名 -------交点------(一级)----------------
   
5. ;;k:（0--不延伸,1--延伸基本对象,2--延伸参数传递的对象,3--延伸)
   
6. (defun sl-Curveinters (en1 en2 k / pl pts)
   
7.   (setq pl (vlax-invoke (vlax-ename->vla-object en1) 'IntersectWith (vlax-ename->vla-object en2) k))  
   
8.   (while pl
   
9.     (setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))
   
10.       pl (cdr (cdr (cdr pl)))
    
11.     )
    
12.   )
    
13.   pts
    
14. )
    
15. ;;实体与其交点打断--------(一级)------------
    
16. (defun break_obj (ent brkptlst / brkobjlst en tp maxparam closedobj minparam obj obj2break p1param p2 p2param)
    
17.   (setq obj2break ent brkobjlst (list ent) tp (cdr (assoc 0 (entget ent))))
    
18.   (foreach brkpt brkptlst
    
19.     (if brkobjlst
    
20.       (progn
    
21.         (if (not (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj2break brkpt))))
    
22.           (foreach obj brkobjlst
    
23.             (if (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj brkpt)))
    
24.               (setq obj2break obj)
    
25.             )
    
26.           )
    
27.         )
    
28.       )
    
29.     )
    
30.     ;;---------------------------------
    
31.     (cond
    
32.       ((and (= "SPLINE" tp)
    
33.          (vlax-curve-isclosed obj2break))
    
34.         (setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
    
35.           p2 (vlax-curve-getpointatparam obj2break (+ p1param 0.000001))
    
36.         )
    
37.         (command "._break" obj2break (trans brkpt 0 1) (trans p2 0 1))
    
38.       )
    
39.       ((= "CIRCLE" tp)
    
40.         (setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
    
41.           p2 (vlax-curve-getpointatparam obj2break (+ p1param 0.000001))
    
42.         )
    
43.         (command "._break" obj2break (trans brkpt 0 1) (trans p2 0 1))
    
44.         (setq tp "ARC")
    
45.       )
    
46.       ((and (= "ELLIPSE" tp) (vlax-curve-isclosed obj2break))
    
47.         (setq p1param  (vlax-curve-getparamatpoint obj2break brkpt)
    
48.           p2param  (+ p1param 0.000001)
    
49.           minparam (min p1param p2param)
    
50.           maxparam (max p1param p2param)
    
51.           obj (vlax-ename->vla-object obj2break)
    
52.         )
    
53.         (vlax-put obj 'startparameter maxparam)
    
54.         (vlax-put obj 'endparameter (+ minparam 2pi))
    
55.       )
    
56.       (t   
    
57.         (setq closedobj (vlax-curve-isclosed obj2break))
    
58.         (command "._break" obj2break (trans brkpt 0 1) (trans brkpt 0 1))
    
59.         (if (not closedobj)
    
60.           (setq brkobjlst (cons (entlast) brkobjlst))
    
61.         )
    
62.       )
    
63.     )
    
64.   )
    
65. )
    
66. ;;主程序------------------
    
67. ;支持 LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
    
68. (defun c:tr (/ ss1 ssn ssm i j k ssc ptlst ptls)
    
69.   (vl-load-com)
    
70.   (prompt "\n 支持 LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")
    
71.   (setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
    
72.   (setq ptlst nil ptls nil ol (getvar "osmode") i -1)
    
73.   (setvar "osmode" 0)
    
74.   (while (setq ssn (ssname ss1 (setq i (1+ i))))
    
75.     (setq j 0)
    
76.     (setq ptlst nil)
    
77.     (repeat (sslength ss1)
    
78.       (setq ssm (ssname ss1 j)
    
79.         ptlst (append (sl-Curveinters ssn ssm 0) ptlst)
    
80.         j (1+ j)
    
81.       )
    
82.     )
    
83.     (setq ptls (cons ptlst ptls))
    
84.   )
    
85.   (setq ptls (reverse ptls))
    
86.   (setq k 0)
    
87.   (while (setq ssc (ssname ss1 k))
    
88.     (break_obj ssc (nth k ptls))
    
89.     (setq k (1+ k))
    
90.   )
    
91.   (setvar "osmode" 0)
    
92. )

;选择集交点断开  modify by 尘缘一生  QQ:15290049<br /> <br /> ;;两实体（en1 en2） 为实体名 -------交点------(一级)----------------<br /> ;;k:（0--不延伸,1--延伸基本对象,2--延伸参数传递的对象,3--延伸)<br /> (defun sl-Curveinters (en1 en2 k / pl pts)<br />   (setq pl (vlax-invoke (vlax-ename->vla-object en1) 'IntersectWith (vlax-ename->vla-object en2) k))  <br />   (while pl<br />     (setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))<br />       pl (cdr (cdr (cdr pl)))<br />     )<br />   )<br />   pts<br /> )<br /> ;;实体与其交点打断--------(一级)------------<br /> (defun break_obj (ent brkptlst / brkobjlst en tp maxparam closedobj minparam obj obj2break p1param p2 p2param)<br />   (setq obj2break ent brkobjlst (list ent) tp (cdr (assoc 0 (entget ent))))<br />   (foreach brkpt brkptlst<br />     (if brkobjlst<br />       (progn<br />         (if (not (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj2break brkpt))))<br />           (foreach obj brkobjlst <br />             (if (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj brkpt)))<br />               (setq obj2break obj) <br />             )<br />           )<br />         )<br />       )<br />     )<br />     ;;---------------------------------<br />     (cond<br />       ((and (= "SPLINE" tp) <br />          (vlax-curve-isclosed obj2break))<br />         (setq p1param (vlax-curve-getparamatpoint obj2break brkpt)<br />           p2 (vlax-curve-getpointatparam obj2break (+ p1param 0.000001))<br />         )<br />         (command "._break" obj2break (trans brkpt 0 1) (trans p2 0 1))<br />       )<br />       ((= "CIRCLE" tp)<br />         (setq p1param (vlax-curve-getparamatpoint obj2break brkpt)<br />           p2 (vlax-curve-getpointatparam obj2break (+ p1param 0.000001))<br />         )<br />         (command "._break" obj2break (trans brkpt 0 1) (trans p2 0 1))<br />         (setq tp "ARC")<br />       )<br />       ((and (= "ELLIPSE" tp) (vlax-curve-isclosed obj2break))<br />         (setq p1param  (vlax-curve-getparamatpoint obj2break brkpt)<br />           p2param  (+ p1param 0.000001)<br />           minparam (min p1param p2param)<br />           maxparam (max p1param p2param)<br />           obj (vlax-ename->vla-object obj2break)<br />         )<br />         (vlax-put obj 'startparameter maxparam)<br />         (vlax-put obj 'endparameter (+ minparam 2pi))<br />       )<br />       (t    <br />         (setq closedobj (vlax-curve-isclosed obj2break))<br />         (command "._break" obj2break (trans brkpt 0 1) (trans brkpt 0 1))<br />         (if (not closedobj) <br />           (setq brkobjlst (cons (entlast) brkobjlst))<br />         )<br />       )<br />     )<br />   )<br /> )<br /> ;;主程序------------------<br /> ;支持 LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"<br /> (defun c:tr (/ ss1 ssn ssm i j k ssc ptlst ptls)<br />   (vl-load-com)<br />   (prompt "\n 支持 LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")<br />   (setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))<br />   (setq ptlst nil ptls nil ol (getvar "osmode") i -1)<br />   (setvar "osmode" 0)<br />   (while (setq ssn (ssname ss1 (setq i (1+ i))))<br />     (setq j 0)<br />     (setq ptlst nil)<br />     (repeat (sslength ss1)<br />       (setq ssm (ssname ss1 j)<br />         ptlst (append (sl-Curveinters ssn ssm 0) ptlst)<br />         j (1+ j)<br />       )<br />     )<br />     (setq ptls (cons ptlst ptls))<br />   )<br />   (setq ptls (reverse ptls))<br />   (setq k 0)<br />   (while (setq ssc (ssname ss1 k))<br />     (break_obj ssc (nth k ptls))<br />     (setq k (1+ k))<br />   )<br />   (setvar "osmode" 0)<br /> )

ZJKUSO

尘缘一生 发表于 2022-5-5 01:08
速度问题，就是用的COMMAND 原因，抛弃command 程序会写很长，本坛有部分代码，我整合过，整理下，并没有解 ...

能添加打断后删除吗？

类似下面这样

陈进佳

小小的人 发表于 2020-5-4 21:13
太厉害了    终于找到了      我之前找到的    只能打断直线  现在这个很全面    很好用

wu112031853

厉害！！！！

唯寻

真是太牛了

haotaer

高手出手那纯属娱乐。只是热心帮忙

凡海涛在石大

请问出现这个no function definition: XLR_JDLB_SS，该怎么解决

陈进佳

凡海涛在石大 发表于 2016-4-10 23:14
请问出现这个no function definition: XLR_JDLB_SS，该怎么解决

回复错地方了

香远益清

真是太牛了,高手出手那纯属娱乐。只是热心帮忙

小小的人

太厉害了    终于找到了      我之前找到的    只能打断直线  现在这个很全面    很好用

999999

顶起，上班时试一试