分享一个反转轻量多段线的函数

hubeiwdlue

2. ;; 功能：反转轻量多段线
   
3. ;; 参数：ent - LWPOLYLINE图元名
   
4. ;; 返回：成功返回图元名，失败返回nil
   
5. (defun ReverseLWPolyline (ent / bulgelist coord elist lineweight1 lineweight2 newbulge newcoord newlineweight1 newlineweight2)
   
6.   (if (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
   
7.     (progn
   
8.       (setq elist (entget ent))
   
9.       (setq coord (vl-remove-if-not '(lambda (x) (= (car x) 10)) elist))
   
10.       (setq lineweight1 (vl-remove-if-not '(lambda (x) (= (car x) 40)) elist))
    
11.       (setq lineweight2 (vl-remove-if-not '(lambda (x) (= (car x) 41)) elist))
    
12.       (setq bulgeList (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) elist)))
    
13.       (setq newCoord (reverse coord))
    
14.       (setq newlineweight1 (mapcar '(lambda (x) (cons 41 (cdr x)))(cdr(reverse lineweight1))))
    
15.       (setq newlineweight2 (mapcar '(lambda (x) (cons 40 (cdr x)))(cdr(reverse lineweight2))))
    
16.       (setq newBulge (mapcar '- (cdr (reverse bulgeList))))
    
17.       (entmod
    
18.         (append
    
19.           (vl-remove-if '(lambda (x) (or (= (car x) 10)(= (car x) 40)(= (car x) 41)(= (car x) 42))) elist)
    
20.           (apply 'append
    
21.             (mapcar '(lambda (pt lw1 lw2 bulge)
    
22.                        (list pt lw2 lw1(cons 42 bulge)))
    
23.               newCoord
    
24.               (append newlineweight1 (list(cons 41 (cdr(car lineweight1)))))
    
25.               (append newlineweight2 (list(cons 40 (cdr(car lineweight1)))))
    
26.               (append newBulge '(0.0))
    
27.             )
    
28.           )
    
29.         )
    
30.       )
    
31.       ent
    
32.     )
    
33.   )
    
34. )

;; 功能：反转轻量多段线<br /> ;; 参数：ent - LWPOLYLINE图元名<br /> ;; 返回：成功返回图元名，失败返回nil<br /> (defun ReverseLWPolyline (ent / bulgelist coord elist lineweight1 lineweight2 newbulge newcoord newlineweight1 newlineweight2)<br />   (if (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")<br />     (progn <br />       (setq elist (entget ent))<br />       (setq coord (vl-remove-if-not '(lambda (x) (= (car x) 10)) elist))<br />       (setq lineweight1 (vl-remove-if-not '(lambda (x) (= (car x) 40)) elist))<br />       (setq lineweight2 (vl-remove-if-not '(lambda (x) (= (car x) 41)) elist))<br />       (setq bulgeList (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) elist)))<br />       (setq newCoord (reverse coord))<br />       (setq newlineweight1 (mapcar '(lambda (x) (cons 41 (cdr x)))(cdr(reverse lineweight1))))<br />       (setq newlineweight2 (mapcar '(lambda (x) (cons 40 (cdr x)))(cdr(reverse lineweight2))))<br />       (setq newBulge (mapcar '- (cdr (reverse bulgeList))))<br />       (entmod<br />         (append<br />           (vl-remove-if '(lambda (x) (or (= (car x) 10)(= (car x) 40)(= (car x) 41)(= (car x) 42))) elist)<br />           (apply 'append<br />             (mapcar '(lambda (pt lw1 lw2 bulge)<br />                        (list pt lw2 lw1(cons 42 bulge)))<br />               newCoord<br />               (append newlineweight1 (list(cons 41 (cdr(car lineweight1)))))<br />               (append newlineweight2 (list(cons 40 (cdr(car lineweight1)))))<br />               (append newBulge '(0.0))<br />             )<br />           )<br />         )<br />       )<br />       ent<br />     )<br />   )<br /> )

尘缘一生

用在什么时候？

liuhe

2. (DEFUN C:TT (/ E E1 NUM I BU)
   
3.   (SETQ E (CAR (ENTSEL)))
   
4.   (IF E
   
5.     (PROGN
   
6.       (VLA-COPY (vlax-ename->vla-object E))
   
7.       (SETQ E1        (ENTLAST)
   
8.             NUM        (CDR (ASSOC 90 (ENTGET E)))
   
9.             I        0
   
10.       )
    
11.       (REPEAT NUM
    
12.         (vla-PUt-Coordinate
    
13.           (vlax-ename->vla-object E)
    
14.           (- NUM I 1)
    
15.           (vla-get-Coordinate (vlax-ename->vla-object E1) I)
    
16.         )
    
17.         (setq BU (vla-GetBulge (vlax-ename->vla-object E1) I))
    
18.         (vl-catch-all-apply
    
19.           'vla-SetBulge
    
20.           (LIST
    
21.             (vlax-ename->vla-object E)
    
22.             (- NUM I 2)
    
23.             (* -1 (vla-GetBulge (vlax-ename->vla-object E1) I))
    
24.           )
    
25.         )
    
26.         (setq i (1+ i))
    
27.       )
    
28.       (ENTDEL E1)
    
29.     )
    
30.   )
    
31. )

(DEFUN C:TT (/ E E1 NUM I BU)<br />   (SETQ E (CAR (ENTSEL)))<br />   (IF E<br />     (PROGN<br />       (VLA-COPY (vlax-ename->vla-object E))<br />       (SETQ E1        (ENTLAST)<br />             NUM        (CDR (ASSOC 90 (ENTGET E)))<br />             I        0<br />       )<br />       (REPEAT NUM<br />         (vla-PUt-Coordinate<br />           (vlax-ename->vla-object E)<br />           (- NUM I 1)<br />           (vla-get-Coordinate (vlax-ename->vla-object E1) I)<br />         )<br />         (setq BU (vla-GetBulge (vlax-ename->vla-object E1) I))<br />         (vl-catch-all-apply<br />           'vla-SetBulge<br />           (LIST<br />             (vlax-ename->vla-object E)<br />             (- NUM I 2)<br />             (* -1 (vla-GetBulge (vlax-ename->vla-object E1) I))<br />           )<br />         )<br />         (setq i (1+ i))<br />       )<br />       (ENTDEL E1)<br />     )<br />   )<br /> )

hubeiwdlue

尘缘一生 发表于 2025-2-20 17:12
用在什么时候？

陈总，我是用在剖地形线的代码里面的。根据点选位置距离起点和终点的长度，判断是否需要反转。然后从起点开始剖断面。

hubeiwdlue

liuhe 发表于 2025-2-20 17:24

谢谢流河大神，用vlisp果然要方便一些。