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

freedom_ice

;;2023.10.30修改

1. ( defun bulge (startpt endpt targetpt initbulge / bulge1 bulge2 delth dis1 dis2 dis3 radius verticalline1 verticalline2 )
   
2.         ( setq dis1 ( distance startpt endpt ) )
   
3.         ( setq dis2 ( distance startpt targetpt ) )
   
4.         ( setq dis3 ( distance targetpt endpt ) )
   
5.         ( cond ( ( and ( /= initbulge 0 )
   
6.                                                      ( /= dis1 0 )
   
7.                                                                  ( /= dis2 0 )
   
8.                                                                  ( /= dis3 0 )                                 
   
9.                              )
   
10.                                          ( progn
    
11.                                                         ( setq sign ( / initbulge ( abs initbulge ) ) )                                 
    
12.                                                         ( setq deltH (  * ( abs initbulge ) 0.5 dis1 ) )
    
13.                                                         ( setq radius ( / ( + ( expt deltH 2 ) ( expt ( * 0.5 dis1 ) 2 ) ) ( * 2 deltH ) ) )                               
    
14.                                                         ( setq verticalline1 ( sqrt ( - ( expt radius 2 ) ( expt ( * 0.5 dis2 ) 2 ) ) ) )
    
15.                                                         ( setq bulge1 ( / ( * 2 ( - radius verticalline1 ) ) dis2 ) )
    
16.                                                         ( setq verticalline2 ( sqrt ( - ( expt radius 2 ) ( expt ( * 0.5 dis3 ) 2 ) ) ) )
    
17.                                                         ( setq bulge2 ( / ( * 2 ( - radius verticalline2 ) ) dis3 ) )
    
18.                                                         ( list ( * sign bulge1 ) ( * sign bulge2 ) )       
    
19.                                          )                                         
    
20.                                  )
    
21.                                  ( ( and ( /= initbulge 0 )
    
22.                                                                 ( /= dis1 0 )
    
23.                                                                 ( = dis2 0 )
    
24.                                                                 ( /= dis3 0 )                                 
    
25.                                         )
    
26.                                         ( list 0 initbulge )                                         
    
27.                                 )
    
28.                                 ( ( and ( /= initbulge 0 )
    
29.                                                                 ( /= dis1 0 )
    
30.                                                                 ( /= dis2 0 )
    
31.                                                                 ( = dis3 0 )                                 
    
32.                                         )
    
33.                                         ( list initbulge 0 )                                         
    
34.                                 )
    
35.                                 ( t
    
36.                                         ( list 0 0 )                                         
    
37.                                 )
    
38.         )
    
39. )
    
40. 
    
41. ( defun c:plb ( )
    
42.   ( princ "\n选择多段线:" )       
    
43.         ( setq entname ( ssname ( ssget ) 0 ) )
    
44.         ( princ "\n选择打断点:" )
    
45.         ( setq pt ( getpoint ) )
    
46.         ( setq targetpt ( vlax-curve-getClosestPointTo entname pt ) )
    
47.         ( if ( and ( equal ( car pt ) ( car targetpt ) 0.000001 )
    
48.                                                   ( equal ( cadr pt ) ( cadr targetpt ) 0.00001 )
    
49.                          )
    
50.                          ( lwplbreak ( vlax-ename->vla-object entname ) pt)       
    
51.                          ( princ "指定点不在多段线上！" )
    
52.         )
    
53. )
    
54. 
    
55. ( defun lwplbreak(plineobj pt / bulge_j bulge_k bulge_node bulges emppt i j node_i node_j noden nodes_obj2 obj2 pline1 pline2 plnode1 plnode2 ptlist1 ptlist2 targetn targetparam)
    
56.         ( setq targetparam ( vlax-curve-getParamAtPoint plineobj pt ) )
    
57.         ( setq targetN ( fix targetparam ) )
    
58.   ( setq nodeN ( fix ( vlax-curve-getEndParam plineobj ) ) )          
    
59.         ( setq ptlist1 nil )
    
60.         ( setq ptlist2 nil )
    
61.         ( if ( and ( > targetparam 0 )
    
62.                                            ( < targetparam nodeN )                                 
    
63.                          )
    
64.                    ( progn
    
65.                                         ( setq i 0 )
    
66.                                         ( while ( <= i targetN )
    
67.                                             ( setq emppt ( vlax-curve-getPointAtParam plineobj i ) )
    
68.                                                          ( setq ptlist1 ( cons ( reverse ( cdr ( reverse emppt ) ) ) ptlist1 ) )                                                    
    
69.                                             ( setq i ( 1+ i ) )
    
70.                                         )
    
71.                                   ( if ( equal ( distance pt ( vlax-curve-getPointAtParam plineobj targetN ) ) 0.000001 )
    
72.                                                    ( setq plnode1 ( + ( * 2 targetN ) 1 ) )
    
73.                                                    ( progn
    
74.                                                                  ( setq ptlist1 ( cons ( reverse ( cdr ( reverse pt ) ) ) ptlist1 ) )
    
75.                                                                  ( setq plnode1 ( + ( * 2 ( + 1 targetN ) ) 1 ) )
    
76.                                                          )
    
77.                                         )                                       
    
78.                                         ( setq ptlist1 ( reverse ptlist1 ) )
    
79.                                         ( setq ptlist1 ( apply 'append ptlist1 ) )
    
80.                                         ( setq pline1 (vlax-make-safearray vlax-vbDouble ( cons 0 plnode1 ) ) )
    
81.                                         ( vlax-safearray-fill pline1 ptlist1 )                       
    
82.                                                                                  
    
83.                                         ( setq j nodeN )
    
84.                                         ( while ( > j targetN )
    
85.                                                                  ( setq emppt ( vlax-curve-getPointAtParam plineobj j ) )
    
86.                                                                  ( setq ptlist2 ( cons ( reverse ( cdr ( reverse emppt ) ) ) ptlist2 ) )                                         
    
87.                                                                  ( setq j ( 1- j ) )
    
88.                                         )
    
89.                                   ( if ( equal ( distance pt ( vlax-curve-getPointAtParam plineobj ( + 1 targetN ) ) ) 0.000001 )
    
90.                                                    ( setq plnode2 ( + ( * 2 ( - nodeN targetN 1 ) ) 1 ) )
    
91.                                                    ( progn
    
92.                                                                  ( setq ptlist2 ( cons ( reverse ( cdr ( reverse pt ) ) ) ptlist2 ) )
    
93.                                                                  ( setq plnode2 ( + ( * 2 ( - nodeN targetN ) ) 1 ) )
    
94.                                                          )                                                  
    
95.                                         )                                       
    
96.                                         ( setq ptlist2 ( apply 'append ptlist2 ) )       
    
97.                                         ( setq pline2 (vlax-make-safearray vlax-vbDouble ( cons 0 plnode2 ) ) )
    
98.                                         ( vlax-safearray-fill pline2 ptlist2 )       
    
99.                                   
    
100.                                   ;凸度获取
     
101.                                   ( setq bulges nil )
     
102.                                   ( setq bulge_k nodeN )
     
103.                                   ( while ( >= bulge_k 0 )
     
104.                                                             ( setq bulges ( cons ( vla-getbulge plineobj bulge_k ) bulges ) )
     
105.                                                                         ( setq bulge_k ( 1- bulge_k ) )
     
106.                                         )
     
107.                                   ( setq bulge_node ( bulge ( vlax-curve-getPointAtParam plineobj targetN ) ( vlax-curve-getPointAtParam plineobj ( 1+ targetN ) ) pt ( nth targetN bulges ) ) )                          
     
108.                                   
     
109.                                   ( setq obj2 ( vla-Copy plineobj ) )
     
110.                                         ( setq pline1 ( vlax-make-variant pline1 ) )
     
111.                                         ( vla-put-Coordinates plineobj pline1 )                                       
     
112.                                         ( setq pline2 ( vlax-make-variant pline2 ) )
     
113.                                         ( vla-put-Coordinates obj2 pline2 )       
     
114.                
     
115.                                   ;凸度赋值       
     
116.                                         ( setq node_i 0 )
     
117.                                         ( repeat ( + ( fix ( vlax-curve-getEndParam plineobj ) ) 1 )
     
118.                                                                    ( vla-SetBulge plineobj node_i ( nth node_i bulges ) )
     
119.                                                                     ( setq node_i ( 1+ node_i ) )
     
120.                                         )
     
121.                                          ( vla-SetBulge plineobj ( - ( fix ( vlax-curve-getEndParam plineobj ) ) 1 ) ( car bulge_node ) )
     
122.                                   ( vla-SetBulge plineobj ( fix ( vlax-curve-getEndParam plineobj ) ) 0 )                         
     
123.                                                                    
     
124.                                   ( setq nodes_obj2 ( fix ( vlax-curve-getEndParam obj2 ) ) )
     
125.                                         ( setq bulge_j ( - ( length bulges ) 1 ) )                                  
     
126.                                         ( repeat ( + ( fix ( vlax-curve-getEndParam obj2 ) ) 1 )
     
127.                                                                    ( vla-SetBulge obj2 nodes_obj2 ( nth bulge_j bulges ) )
     
128.                                                                     ( setq nodes_obj2 ( 1- nodes_obj2 ) )
     
129.                                                        ( setq bulge_j ( 1- bulge_j ) )
     
130.                                         )                                 
     
131.                       ( vla-SetBulge obj2 0 ( cadr bulge_node ) )                                           
     
132.                                                                    
     
133.                                   ( vla-Update plineobj )
     
134.                                         ( vla-Update obj2 )                                 
     
135.                          )
     
136.                        
     
137.         )
     
138.         ( princ )
     
139. )

复制代码

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))))

freedom_ice

多段线打断，补充凸度，暂不考虑打断点处的全局宽度

1. ( defun c:tt()
   
2.   ( setq entname ( ssname ( ssget ) 0 ) )
   
3.   ( setq plineobj ( vlax-ename->vla-object entname ) )
   
4.   ( setq nodeN ( fix ( vlax-curve-getEndParam plineobj ) ) )
   
5.   ( setq i 0 )
   
6.   ( while ( <= i nodeN )
   
7.     ;( princ ( vla-getBulge plineobj i ) )
   
8.     ( vla-GetWidth plineobj i 'startwidth 'endwidth )
   
9.     ( princ "\n" )
   
10.     ( princ startwidth )
    
11.     ( princ "\n" )
    
12.     ( princ endwidth )
    
13.     ( setq i ( 1+ i ) )
    
14.   )
    
15.   ( princ )
    
16. )
    
17. 
    
18. ( defun bulge (startpt endpt targetpt initbulge / bulge1 bulge2 delth dis1 dis2 dis3 radius verticalline1 verticalline2 )
    
19.   ( setq dis1 ( distance startpt endpt ) )
    
20.   ( setq dis2 ( distance startpt targetpt ) )
    
21.   ( setq dis3 ( distance targetpt endpt ) )
    
22.   ( cond ( ( and ( /= initbulge 0 )
    
23.                  ( /= dis1 0 )
    
24.                  ( /= dis2 0 )
    
25.                  ( /= dis3 0 )         
    
26.            )
    
27.            ( progn         
    
28.               ( setq deltH (  * initbulge 0.5 dis1 ) )
    
29.               ( setq radius ( / ( + ( expt deltH 2 ) ( expt ( * 0.5 dis1 ) 2 ) ) ( * 2 deltH ) ) )        
    
30.               ( setq verticalline1 ( sqrt ( - ( expt radius 2 ) ( expt ( * 0.5 dis2 ) 2 ) ) ) )
    
31.               ( setq bulge1 ( / ( * 2 ( - radius verticalline1 ) ) dis2 ) )
    
32.               ( setq verticalline2 ( sqrt ( - ( expt radius 2 ) ( expt ( * 0.5 dis3 ) 2 ) ) ) )
    
33.               ( setq bulge2 ( / ( * 2 ( - radius verticalline2 ) ) dis3 ) )
    
34.               ( list bulge1 bulge2 )  
    
35.            )           
    
36.          )
    
37.         ( ( and ( /= initbulge 0 )
    
38.                 ( /= dis1 0 )
    
39.                 ( = dis2 0 )
    
40.                 ( /= dis3 0 )         
    
41.           )
    
42.           ( list 0 initbulge )           
    
43.         )
    
44.         ( ( and ( /= initbulge 0 )
    
45.                 ( /= dis1 0 )
    
46.                 ( /= dis2 0 )
    
47.                 ( = dis3 0 )         
    
48.           )
    
49.           ( list initbulge 0 )           
    
50.         )
    
51.         ( t
    
52.           ( list 0 0 )           
    
53.         )
    
54.   )
    
55. )
    
56. 
    
57. ( defun c:plb ( )
    
58.   ( princ "\n选择多段线:" )  
    
59.   ( setq entname ( ssname ( ssget ) 0 ) )
    
60.   ( princ "\n选择打断点:" )
    
61.   ( setq pt ( getpoint ) )
    
62.   ( setq targetpt ( vlax-curve-getClosestPointTo entname pt ) )
    
63.   ( if ( and ( equal ( car pt ) ( car targetpt ) 0.000001 )
    
64.               ( equal ( cadr pt ) ( cadr targetpt ) 0.00001 )
    
65.        )
    
66.        ( lwplbreak ( vlax-ename->vla-object entname ) pt)  
    
67.        ( princ "指定点不在多段线上！" )
    
68.   )
    
69. )
    
70. 
    
71. ( defun lwplbreak(plineobj pt / bulge_j bulge_k bulge_node bulges emppt i j node_i node_j noden nodes_obj2 obj2 pline1 pline2 plnode1 plnode2 ptlist1 ptlist2 targetn targetparam)
    
72.   ( setq targetparam ( vlax-curve-getParamAtPoint plineobj pt ) )
    
73.   ( setq targetN ( fix targetparam ) )
    
74.   ( setq nodeN ( fix ( vlax-curve-getEndParam plineobj ) ) )     
    
75.   ( setq ptlist1 nil )
    
76.   ( setq ptlist2 nil )
    
77.   ( if ( and ( > targetparam 0 )
    
78.              ( < targetparam nodeN )         
    
79.        )
    
80.        ( progn
    
81.           ( setq i 0 )
    
82.           ( while ( <= i targetN )
    
83.               ( setq emppt ( vlax-curve-getPointAtParam plineobj i ) )
    
84.                ( setq ptlist1 ( cons ( reverse ( cdr ( reverse emppt ) ) ) ptlist1 ) )               
    
85.               ( setq i ( 1+ i ) )
    
86.           )
    
87.           ( if ( equal ( distance pt ( vlax-curve-getPointAtParam plineobj targetN ) ) 0.000001 )
    
88.                ( setq plnode1 ( + ( * 2 targetN ) 1 ) )
    
89.                ( progn
    
90.                  ( setq ptlist1 ( cons ( reverse ( cdr ( reverse pt ) ) ) ptlist1 ) )
    
91.                  ( setq plnode1 ( + ( * 2 ( + 1 targetN ) ) 1 ) )
    
92.                )
    
93.           )         
    
94.           ( setq ptlist1 ( reverse ptlist1 ) )
    
95.           ( setq ptlist1 ( apply 'append ptlist1 ) )
    
96.           ( setq pline1 (vlax-make-safearray vlax-vbDouble ( cons 0 plnode1 ) ) )
    
97.           ( vlax-safearray-fill pline1 ptlist1 )      
    
98.                      
    
99.           ( setq j nodeN )
    
100.           ( while ( > j targetN )
     
101.                  ( setq emppt ( vlax-curve-getPointAtParam plineobj j ) )
     
102.                  ( setq ptlist2 ( cons ( reverse ( cdr ( reverse emppt ) ) ) ptlist2 ) )           
     
103.                  ( setq j ( 1- j ) )
     
104.           )
     
105.           ( if ( equal ( distance pt ( vlax-curve-getPointAtParam plineobj ( + 1 targetN ) ) ) 0.000001 )
     
106.                ( setq plnode2 ( + ( * 2 ( - nodeN targetN 1 ) ) 1 ) )
     
107.                ( progn
     
108.                  ( setq ptlist2 ( cons ( reverse ( cdr ( reverse pt ) ) ) ptlist2 ) )
     
109.                  ( setq plnode2 ( + ( * 2 ( - nodeN targetN ) ) 1 ) )
     
110.                )               
     
111.           )         
     
112.           ( setq ptlist2 ( apply 'append ptlist2 ) )  
     
113.           ( setq pline2 (vlax-make-safearray vlax-vbDouble ( cons 0 plnode2 ) ) )
     
114.           ( vlax-safearray-fill pline2 ptlist2 )  
     
115.          
     
116.           ;凸度获取
     
117.           ( setq bulges nil )
     
118.           ( setq bulge_k nodeN )
     
119.           ( while ( >= bulge_k 0 )
     
120.                   ( setq bulges ( cons ( vla-getbulge plineobj bulge_k ) bulges ) )
     
121.                   ( setq bulge_k ( 1- bulge_k ) )
     
122.           )
     
123.           ( setq bulge_node ( bulge ( vlax-curve-getPointAtParam plineobj targetN ) ( vlax-curve-getPointAtParam plineobj ( 1+ targetN ) ) pt ( nth targetN bulges ) ) )        
     
124.          
     
125.           ( setq obj2 ( vla-Copy plineobj ) )
     
126.           ( setq pline1 ( vlax-make-variant pline1 ) )
     
127.           ( vla-put-Coordinates plineobj pline1 )         
     
128.           ( setq pline2 ( vlax-make-variant pline2 ) )
     
129.           ( vla-put-Coordinates obj2 pline2 )  
     
130.    
     
131.           ;凸度赋值  
     
132.           ( setq node_i 0 )
     
133.           ( repeat ( + ( fix ( vlax-curve-getEndParam plineobj ) ) 1 )
     
134.                    ( vla-SetBulge plineobj node_i ( nth node_i bulges ) )
     
135.                     ( setq node_i ( 1+ node_i ) )
     
136.           )
     
137.            ( vla-SetBulge plineobj ( - ( fix ( vlax-curve-getEndParam plineobj ) ) 1 ) ( car bulge_node ) )
     
138.           ( vla-SetBulge plineobj ( fix ( vlax-curve-getEndParam plineobj ) ) 0 )      
     
139.                   
     
140.           ( setq nodes_obj2 ( fix ( vlax-curve-getEndParam obj2 ) ) )
     
141.           ( setq bulge_j ( - ( length bulges ) 1 ) )         
     
142.           ( repeat ( + ( fix ( vlax-curve-getEndParam obj2 ) ) 1 )
     
143.                    ( vla-SetBulge obj2 nodes_obj2 ( nth bulge_j bulges ) )
     
144.                     ( setq nodes_obj2 ( 1- nodes_obj2 ) )
     
145.                    ( setq bulge_j ( 1- bulge_j ) )
     
146.           )         
     
147.           ( vla-SetBulge obj2 0 ( cadr bulge_node ) )            
     
148.                   
     
149.           ( vla-Update plineobj )
     
150.           ( vla-Update obj2 )         
     
151.        )
     
152.       
     
153.   )
     
154.   ( princ )
     
155. )
     
156. 
     
157. 
     
158. 
     
159. ( princ )

复制代码

guohq

1. (defun c:BreakAtPoint(/ OK ENT PT)
   
2.   ;单点打断
   
3.   (setq OK T)
   
4.   (while OK
   
5.     (setq ENT (entsel "\n选择打断对象"))
   
6.     (if        ENT
   
7.       (progn
   
8.         (setq PT (getpoint "\n拾取打断点"))
   
9.         (if PT
   
10.           (command "break" ENT "F" PT PT)
    
11.           (setq OK nil)
    
12.         )
    
13.       )
    
14.       (setq OK nil)
    
15.     )
    
16.   )
    
17. )
    

(defun c:BreakAtPoint(/ OK ENT PT)<br />   ;单点打断<br />   (setq OK T)<br />   (while OK<br />     (setq ENT (entsel "\n选择打断对象"))<br />     (if        ENT<br />       (progn<br />         (setq PT (getpoint "\n拾取打断点"))<br />         (if PT<br />           (command "break" ENT "F" PT PT)<br />           (setq OK nil)<br />         )<br />       )<br />       (setq OK nil)<br />     )<br />   )<br /> )<br />

用系统的break命令更方便

lxl217114

谢谢分享，收藏

xyp1964

guohq 发表于 2023-6-14 09:54
用系统的break命令更方便

(defun c:tt ()
  "单点打断"
  (while (setq ent (entsel "\n选择打断对象<退出>: "))
    (if        (setq pt (getpoint "\n拾取打断点<退出>: "))
      (command "break" ent "f" pt pt)
    )
  )
  (princ)
)

MZ_li

谢谢分享，收藏

mokson

按 X 不是更快捷吗？

you_boss

思路很清晰，程序值得学习，关于程序不能单从实现的功能来评价值不值得，的确系统自带有打断命令，但是该命令有较多局限性，比如打断之后没办法直接返回打断后的图元，但是楼主这个稍微修改一下就可以，对于二次开发来说很有价值

guohq

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

xyp1964

走火入魔了……