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

hubeiwdlue

2. ;; 功能：反转轻量多段线
   
3. ;; 参数：ent - LWPOLYLINE图元名
   
4. ;; 返回：成功返回图元名，失败返回nil
   
5. (defun ReverseLWPolyline (ent / bulgelist coord elist lineweight1 lineweight2 newbulge newcoord newlineweight1 newlineweight2 newz91 z91)
   
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 z91 (vl-remove-if-not '(lambda (x) (= (car x) 91)) elist))
    
14.         (setq newCoord (reverse coord))
    
15.         (setq newlineweight1 (mapcar '(lambda (x) (cons 41 (cdr x)))(cdr(reverse lineweight1))))
    
16.         (setq newlineweight2 (mapcar '(lambda (x) (cons 40 (cdr x)))(cdr(reverse lineweight2))))
    
17.         (setq newBulge (mapcar '- (cdr (reverse bulgeList))))
    
18.         (setq newz91 (reverse z91))
    
19.         (entmod
    
20.           (vl-remove nil
    
21.             (append
    
22.               (vl-remove-if '(lambda (x) (or (= (car x) 10)(= (car x) 40)(= (car x) 41)(= (car x) 42)(= (car x) 91))) elist)
    
23.               (apply 'append
    
24.                 (mapcar '(lambda (pt lw1 lw2 bulge)
    
25.                            (list pt lw2 lw1(cons 42 bulge)))
    
26.                   newCoord
    
27.                   (append newlineweight1 (list(cons 41 (cdr(car lineweight1)))))
    
28.                   (append newlineweight2 (list(cons 40 (cdr(car lineweight1)))))
    
29.                   (append newBulge '(0.0))
    
30.                 )
    
31.               )
    
32.             )
    
33.           )
    
34.         )
    
35.         ent
    
36.       )
    
37.     )
    
38.   )
    

;; 功能：反转轻量多段线<br /> ;; 参数：ent - LWPOLYLINE图元名<br /> ;; 返回：成功返回图元名，失败返回nil<br /> (defun ReverseLWPolyline (ent / bulgelist coord elist lineweight1 lineweight2 newbulge newcoord newlineweight1 newlineweight2 newz91 z91)<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 z91 (vl-remove-if-not '(lambda (x) (= (car x) 91)) 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 />         (setq newz91 (reverse z91))<br />         (entmod<br />           (vl-remove nil<br />             (append<br />               (vl-remove-if '(lambda (x) (or (= (car x) 10)(= (car x) 40)(= (car x) 41)(= (car x) 42)(= (car x) 91))) 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 />         )<br />         ent<br />       )<br />     )<br />   )<br />

wzg356

hubeiwdlue 发表于 2025-2-23 21:02
谢谢，我只在acad2008和中望上测试过，acad高版本确实没有测试，不清楚新增了91组码。

;(reverseLwp (car(entsel "\n选择线...")))
(defun reverseLwp (en / a es lst lst1 lst2)
        (setq es (entget en) en(assoc 210 es))       
        (while(/= 10(car (setq a (car es))))(setq lst1(cons a lst1) es(cdr es)))       
        (while (setq es (member (assoc 10 es) es))
                (setq lst
            (cons(cons 40 (cdr (assoc 41 es)))
            (cons(cons 41 (cdr (assoc 40 es)))
            (cons(cons 42 (- (cdr (assoc 42 es))))
            (cons(assoc 91 es)
            (cons (assoc 10 es) lst)))))
            )
            (setq es (cdr es))
    )
    (setq lst(vl-remove NIL lst));低版本没有91码时   
        (while(/= 10(car(setq a (car lst))))(setq lst2(cons a lst2) lst(cdr lst)))
        (setq lst2(append lst (reverse(cons en lst2))))
        (entmod(foreach a lst1(setq lst2(cons a lst2))))               
)

尘缘一生

用在什么时候？

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果然要方便一些。

wzg356

高版本（至少12版之后）多线段组码增加了91码，即各点均有的(10 ...)( 40 ...)( 41 ...)( 42 ...) (91....)
代码中把各点跟随的91吗采集进去好一些，否则其他程序涉及组码操作的时候可能会出错

hubeiwdlue

wzg356 发表于 2025-2-23 20:56
高版本（至少12版之后）多线段组码增加了91码，即各点均有的(10 ...)( 40 ...)( 41 ...)( 42 ...) (91....) ...

谢谢，我只在acad2008和中望上测试过，acad高版本确实没有测试，不清楚新增了91组码。

hubeiwdlue

wzg356 发表于 2025-2-23 21:17
;(reverseLwp (car(entsel "\n选择线...")))
(defun reverseLwp (en / a es lst lst1 lst2)
        (setq es  ...

谢谢指导。

hubeiwdlue

wzg356 发表于 2025-2-23 21:17
;(reverseLwp (car(entsel "\n选择线...")))
(defun reverseLwp (en / a es lst lst1 lst2)
        (setq es  ...

请教一下您，91号组码的作用是什么？