一个简单的多段线打断，补充凸度

czb203

xyp1964 发表于 2023-6-14 12:17
(defun c:tt ()
  "单点打断"
  (while (setq ent (entsel "\n选择打断对象: "))

大佬的代码总是这么的简洁好用，感谢~

x_s_s_1

试了一下，写了个逻辑比较混乱的，好多bug欢迎扔砖

1. ;;;打断LWPLINE逻辑混乱版
   
2. (defun c:tt  (/         xty-L-cdrn   xty-L-carn
   
3.         xty-L-retainget-vtxl   xty-tan  make-pl  bu
   
4.         bue      bus  en   en1    en2     enl
   
5.         enn      ent  fuzz   ince    incs     mode
   
6.         ne       ns  ocs   pme    pms     pt
   
7.         pta      ptb  ptl   tmp    vtx1     vtx2
   
8.         vtxe     vtxl  vtxs   vtxt    we     wee
   
9.         wes      ws  wse   wss    x)
   
10.     (defun xty-L-cdrn  (n lst /)
    
11.   (if (= 0 n)
    
12.       lst
    
13.       (repeat n (setq lst (cdr lst)))
    
14.       )
    
15.   )
    
16.     (defun xty-L-carn  (n lst / lsta)
    
17.   (if (= 0 n)
    
18.       (setq lsta lst)
    
19.       (progn (setq lsta nil)
    
20.        (repeat n
    
21.            (setq lsta (append lsta (list (car lst)))
    
22.            lst  (cdr lst)
    
23.            )
    
24.            )
    
25.        )
    
26.       )
    
27.   lsta
    
28.   )
    
29.     (defun xty-L-retain   (m n lst /)
    
30.   (setq lst (xty-L-carn n lst))
    
31.   (setq lst (if (= 1 m)
    
32.           lst
    
33.           (xty-L-cdrn (1- m) lst)
    
34.           )
    
35.         )
    
36.   )
    
37.     (defun xty-tan  (ang)
    
38.   ((lambda (x)
    
39.        (if (equal 0. x 1e-14)
    
40.      nil
    
41.      (/ (sin ang) x)
    
42.      )
    
43.        )
    
44.       (cos ang)
    
45.       )
    
46.   )
    
47.     (defun xty-L-delsames  (lst fuzz / start new)
    
48.   (while (setq start (car lst))
    
49.       (if  (vl-some '(lambda (x) (equal start x fuzz)) new)
    
50.     nil
    
51.     (setq new (cons start new))
    
52.     )
    
53.       (setq lst (cdr lst))
    
54.       )
    
55.   (setq new (reverse new))
    
56.   new
    
57.   )
    
58.     (defun get-vtxl  (ent / vtxl)
    
59.   (while (setq ent (member (assoc 10 ent) ent))
    
60.       (setq vtxl (cons (list (assoc 10 ent)
    
61.            (assoc 40 ent)
    
62.            (assoc 41 ent)
    
63.            (assoc 42 ent))
    
64.            vtxl)
    
65.       ent  (cdr ent)))
    
66.   (reverse vtxl))
    
67.     (defun make-pl  (tmp ent ocs)
    
68.   (entmakex
    
69.       (append (subst (cons 90 (length tmp)) (assoc 90 ent) ent)
    
70.         (apply 'append tmp)
    
71.         (list (cons 210 ocs)))))
    
72.     (setq fuzz 1e-6
    
73.     en   (car (entsel))
    
74.     ent  (entget en)
    
75.     ocs  (cdr (assoc 210 ent))
    
76.     vtxl (get-vtxl ent)
    
77.     mode (if (= 1 (cdr (assoc 70 ent)))
    
78.        t
    
79.        nil)
    
80.     vtxl (if (equal (caar vtxl) (car (last vtxl)) fuzz)
    
81.        (reverse (cdr (reverse vtxl)))
    
82.        vtxl)
    
83.     ptl  nil)
    
84.     (while (setq pt (getpoint)) (setq ptl (cons pt ptl)))
    
85.     (setq ptl (mapcar '(lambda (x) (trans x 1 0)) ptl)
    
86.     pta (vlax-curve-getstartpoint en)
    
87.     ptb (vlax-curve-getendpoint en)
    
88.     ptl (cons pta ptl)
    
89.     ptl (cons ptb ptl)
    
90.     ptl (xty-l-delsames ptl fuzz)
    
91.     ptl (vl-sort
    
92.       ptl
    
93.       (function (lambda (x y)
    
94.         (< (vlax-curve-getparamatpoint en x)
    
95.            (vlax-curve-getparamatpoint en y)))))
    
96.     ptl (if (equal pta ptb fuzz)
    
97.       (append ptl (list ptb))
    
98.       ptl)
    
99.     )
    
100.     (setq ent (reverse (member (assoc 39 ent) (reverse ent))))
     
101.     (setq ent
     
102.        (vl-remove-if
     
103.      '(lambda (x)
     
104.           (member (car x) '(-1 5 6 8 39 43 48 62 102 330 370)))
     
105.      ent))
     
106.     (setq ent (subst (cons 70 0) (assoc 70 ent) ent))
     
107.     (setq enl (mapcar
     
108.       (function
     
109.           (lambda (pts pte)
     
110.         (setq  pms  (vlax-curve-getparamatpoint
     
111.            en
     
112.            pts)
     
113.         ns   (fix pms)
     
114.         incs (- pms ns)
     
115.         vtxs (nth ns vtxl)
     
116.         pme  (vlax-curve-getparamatpoint
     
117.            en
     
118.            pte)
     
119.         pme  (if (< pme pms)
     
120.            (vlax-curve-getendparam en)
     
121.            pme)
     
122.         pme  (if (> pme (length vtxl))
     
123.            (- pme 1)
     
124.            pme)
     
125.         pme  (if (= pme (length vtxl))
     
126.            (1- pme)
     
127.            pme)
     
128.         ne   (fix pme)
     
129.         ince (- pme ne)
     
130.         vtxe (nth ne vtxl)
     
131.         wss  (cdr (assoc 40 vtxs))
     
132.         wse  (cdr (assoc 41 vtxs))
     
133.         bus  (atan (cdr (assoc 42 vtxs)))
     
134.         wes  (cdr (assoc 40 vtxe))
     
135.         wee  (cdr (assoc 41 vtxe))
     
136.         bue  (atan (cdr (assoc 42 vtxe))))
     
137.         (if (= ns ne)
     
138.             (setq ws   (+ wss (* incs (- wse wss)))
     
139.             we   (+ wss (* ince (- wse wss)))
     
140.             bu   (xty-tan (* (- pme pms) bus))
     
141.             vtxs (list
     
142.                (cons 10
     
143.                (trans pts 0 ocs))
     
144.                (cons 40 ws)
     
145.                (cons 41 we)
     
146.                (cons 42 bu))
     
147.             vtxe (list
     
148.                (cons 10
     
149.                (trans pte 0 ocs))
     
150.                (cons 40 we)
     
151.                (cons 41 we)
     
152.                (cons 42 bu))
     
153.             enn   (make-pl (list vtxs vtxe)
     
154.               ent
     
155.               ocs))
     
156.             (setq ws   (+ wss (* incs (- wse wss)))
     
157.             bu   (- (xty-tan (* (1- incs) bus)))
     
158.             vtxs (list
     
159.                (cons 10
     
160.                (trans pts 0 ocs))
     
161.                (cons 40 ws)
     
162.                (cons 41 wse)
     
163.                (cons 42 bu))
     
164.             ws   (+ wes (* ince (- wee wes)))
     
165.             bu   (xty-tan (* (- pme ne) bue))
     
166.             tmp   (xty-L-retain (+ ns 2)
     
167.                    (1+ ne)
     
168.                    vtxl)
     
169.             vtxt (last tmp)
     
170.             tmp   (reverse (cdr (reverse tmp)))
     
171.             vtxt (subst  (cons 41 ws)
     
172.             (assoc 41 vtxt)
     
173.             vtxt)
     
174.             vtxt (subst  (cons 42 bu)
     
175.             (assoc 42 vtxt)
     
176.             vtxt)
     
177.             vtxe (list
     
178.                (cons 10
     
179.                (trans pte 0 ocs))
     
180.                (cons 40 wee)
     
181.                (cons 41 wee)
     
182.                (cons 42 bu))
     
183.             tmp   (cons vtxs tmp)
     
184.             enn   (make-pl
     
185.                (append tmp
     
186.                  (list vtxt vtxe))
     
187.                ent
     
188.                ocs)))))
     
189.       ptl
     
190.       (cdr ptl)))
     
191.     (if  mode
     
192.   (progn (setq en1  (car enl)
     
193.          vtx1 (get-vtxl (entget en1))
     
194.          en2  (last enl)
     
195.          vtx2 (get-vtxl (entget en2))
     
196.          enl  (vl-remove en1 enl)
     
197.          enl  (vl-remove en2 enl)
     
198.          enl  (cons  (make-pl (append vtx2 (cdr vtx1)) ent ocs)
     
199.         enl))
     
200.          (entdel en1)
     
201.          (entdel en2))))

;;;打断LWPLINE逻辑混乱版<br /> (defun c:tt  (/         xty-L-cdrn   xty-L-carn<br />         xty-L-retainget-vtxl   xty-tan  make-pl  bu<br />         bue      bus  en   en1    en2     enl<br />         enn      ent  fuzz   ince    incs     mode<br />         ne       ns  ocs   pme    pms     pt<br />         pta      ptb  ptl   tmp    vtx1     vtx2<br />         vtxe     vtxl  vtxs   vtxt    we     wee<br />         wes      ws  wse   wss    x)<br />     (defun xty-L-cdrn  (n lst /)<br />   (if (= 0 n)<br />       lst<br />       (repeat n (setq lst (cdr lst)))<br />       )<br />   )<br />     (defun xty-L-carn  (n lst / lsta)<br />   (if (= 0 n)<br />       (setq lsta lst)<br />       (progn (setq lsta nil)<br />        (repeat n<br />            (setq lsta (append lsta (list (car lst)))<br />            lst  (cdr lst)<br />            )<br />            )<br />        )<br />       )<br />   lsta<br />   )<br />     (defun xty-L-retain   (m n lst /)<br />   (setq lst (xty-L-carn n lst))<br />   (setq lst (if (= 1 m)<br />           lst<br />           (xty-L-cdrn (1- m) lst)<br />           )<br />         )<br />   )<br />     (defun xty-tan  (ang)<br />   ((lambda (x)<br />        (if (equal 0. x 1e-14)<br />      nil<br />      (/ (sin ang) x)<br />      )<br />        )<br />       (cos ang)<br />       )<br />   )<br />     (defun xty-L-delsames  (lst fuzz / start new)<br />   (while (setq start (car lst))<br />       (if  (vl-some '(lambda (x) (equal start x fuzz)) new)<br />     nil<br />     (setq new (cons start new))<br />     )<br />       (setq lst (cdr lst))<br />       )<br />   (setq new (reverse new))<br />   new<br />   )<br />     (defun get-vtxl  (ent / vtxl)<br />   (while (setq ent (member (assoc 10 ent) ent))<br />       (setq vtxl (cons (list (assoc 10 ent)<br />            (assoc 40 ent)<br />            (assoc 41 ent)<br />            (assoc 42 ent))<br />            vtxl)<br />       ent  (cdr ent)))<br />   (reverse vtxl))<br />     (defun make-pl  (tmp ent ocs)<br />   (entmakex<br />       (append (subst (cons 90 (length tmp)) (assoc 90 ent) ent)<br />         (apply 'append tmp)<br />         (list (cons 210 ocs)))))<br />     (setq fuzz 1e-6<br />     en   (car (entsel))<br />     ent  (entget en)<br />     ocs  (cdr (assoc 210 ent))<br />     vtxl (get-vtxl ent)<br />     mode (if (= 1 (cdr (assoc 70 ent)))<br />        t<br />        nil)<br />     vtxl (if (equal (caar vtxl) (car (last vtxl)) fuzz)<br />        (reverse (cdr (reverse vtxl)))<br />        vtxl)<br />     ptl  nil)<br />     (while (setq pt (getpoint)) (setq ptl (cons pt ptl)))<br />     (setq ptl (mapcar '(lambda (x) (trans x 1 0)) ptl)<br />     pta (vlax-curve-getstartpoint en)<br />     ptb (vlax-curve-getendpoint en)<br />     ptl (cons pta ptl)<br />     ptl (cons ptb ptl)<br />     ptl (xty-l-delsames ptl fuzz)<br />     ptl (vl-sort<br />       ptl<br />       (function (lambda (x y)<br />         (< (vlax-curve-getparamatpoint en x)<br />            (vlax-curve-getparamatpoint en y)))))<br />     ptl (if (equal pta ptb fuzz)<br />       (append ptl (list ptb))<br />       ptl)<br />     )<br />     (setq ent (reverse (member (assoc 39 ent) (reverse ent))))<br />     (setq ent<br />        (vl-remove-if<br />      '(lambda (x)<br />           (member (car x) '(-1 5 6 8 39 43 48 62 102 330 370)))<br />      ent))<br />     (setq ent (subst (cons 70 0) (assoc 70 ent) ent))<br />     (setq enl (mapcar<br />       (function<br />           (lambda (pts pte)<br />         (setq  pms  (vlax-curve-getparamatpoint<br />            en<br />            pts)<br />         ns   (fix pms)<br />         incs (- pms ns)<br />         vtxs (nth ns vtxl)<br />         pme  (vlax-curve-getparamatpoint<br />            en<br />            pte)<br />         pme  (if (< pme pms)<br />            (vlax-curve-getendparam en)<br />            pme)<br />         pme  (if (> pme (length vtxl))<br />            (- pme 1)<br />            pme)<br />         pme  (if (= pme (length vtxl))<br />            (1- pme)<br />            pme)<br />         ne   (fix pme)<br />         ince (- pme ne)<br />         vtxe (nth ne vtxl)<br />         wss  (cdr (assoc 40 vtxs))<br />         wse  (cdr (assoc 41 vtxs))<br />         bus  (atan (cdr (assoc 42 vtxs)))<br />         wes  (cdr (assoc 40 vtxe))<br />         wee  (cdr (assoc 41 vtxe))<br />         bue  (atan (cdr (assoc 42 vtxe))))<br />         (if (= ns ne)<br />             (setq ws   (+ wss (* incs (- wse wss)))<br />             we   (+ wss (* ince (- wse wss)))<br />             bu   (xty-tan (* (- pme pms) bus))<br />             vtxs (list<br />                (cons 10<br />                (trans pts 0 ocs))<br />                (cons 40 ws)<br />                (cons 41 we)<br />                (cons 42 bu))<br />             vtxe (list<br />                (cons 10<br />                (trans pte 0 ocs))<br />                (cons 40 we)<br />                (cons 41 we)<br />                (cons 42 bu))<br />             enn   (make-pl (list vtxs vtxe)<br />               ent<br />               ocs))<br />             (setq ws   (+ wss (* incs (- wse wss)))<br />             bu   (- (xty-tan (* (1- incs) bus)))<br />             vtxs (list<br />                (cons 10<br />                (trans pts 0 ocs))<br />                (cons 40 ws)<br />                (cons 41 wse)<br />                (cons 42 bu))<br />             ws   (+ wes (* ince (- wee wes)))<br />             bu   (xty-tan (* (- pme ne) bue))<br />             tmp   (xty-L-retain (+ ns 2)<br />                    (1+ ne)<br />                    vtxl)<br />             vtxt (last tmp)<br />             tmp   (reverse (cdr (reverse tmp)))<br />             vtxt (subst  (cons 41 ws)<br />             (assoc 41 vtxt)<br />             vtxt)<br />             vtxt (subst  (cons 42 bu)<br />             (assoc 42 vtxt)<br />             vtxt)<br />             vtxe (list<br />                (cons 10<br />                (trans pte 0 ocs))<br />                (cons 40 wee)<br />                (cons 41 wee)<br />                (cons 42 bu))<br />             tmp   (cons vtxs tmp)<br />             enn   (make-pl<br />                (append tmp<br />                  (list vtxt vtxe))<br />                ent<br />                ocs)))))<br />       ptl<br />       (cdr ptl)))<br />     (if  mode<br />   (progn (setq en1  (car enl)<br />          vtx1 (get-vtxl (entget en1))<br />          en2  (last enl)<br />          vtx2 (get-vtxl (entget en2))<br />          enl  (vl-remove en1 enl)<br />          enl  (vl-remove en2 enl)<br />          enl  (cons  (make-pl (append vtx2 (cdr vtx1)) ent ocs)<br />         enl))<br />          (entdel en1)<br />          (entdel en2))))

ashan

xyp1964 发表于 2023-6-14 12:17
(defun c:tt ()
  "单点打断"
  (while (setq ent (entsel "\n选择打断对象: "))

这个是方便，但是如果是闭合的多段线，使用这个程序打断的话会变成2条多段线。

xyp1964

ashan 发表于 2023-11-6 17:20
这个是方便，但是如果是闭合的多段线，使用这个程序打断的话会变成2条多段线。

闭合的非要打断本身就不正常……