怎么用lisp实现将不闭合的多段线的起始点和终止点互换，并且要维持多断线的形状不变

xufansw · 发表于 2016-5-10 23:48

各位大神，如题，怎么用lisp实现将不闭合的多段线的起始点和终止点互换，并且要维持多断线的形状不变呢？

如图，多段线的形状不变，只是起始点和终止点互换。

xiaolong1487 · 发表于 2016-5-11 01:44

自贡黄明儒黄长老的

;;164.32 [功能] 多段线反向(起点反成终点) byzml84
;;(HH:LWPOLYLINEFX (car (entsel)))
(defun HH:LWPOLYLINEFX (EN / A B C D ENT LST LST1 TMP)
(setq ENT (entget EN))
(setq tmp ent)
(while (setq tmp (member (assoc 10 tmp) tmp))
(setq a (assoc 10 tmp)
b (cons 40 (cdr (assoc 41 tmp)))
c (cons 41 (cdr (assoc 40 tmp)))
d (cons 42 (- (cdr (assoc 42 tmp))))
LST (append (list b c d a) LST)
)
(setq tmp (cddddr tmp))
)
(repeat 3 (setq LST (append (cdr lst) (list (car lst)))))
(setq lst1 (reverse (cdr (member (assoc 10 ent) (reverse ent)))))
(entmod (append lst1 lst '((210 0 0 1))))
)

LIULISHENG · 发表于 2016-5-11 08:10

支持一下支持

xufansw · 发表于 2016-5-11 08:35

xiaolong1487 发表于 2016-5-11 01:44
自贡黄明儒黄长老的

用了一下，好给力！

就是有一点点小问题，最好在while语句最好加一条(setq LST（list))语句，

ll_j · 发表于 2016-5-11 09:21

http://bbs.mjtd.com/thread-111281-1-1.html

xufansw · 发表于 2016-5-11 13:44

ll_j 发表于 2016-5-11 09:21
http://bbs.mjtd.com/thread-111281-1-1.html

受教了

437271963 · 发表于 2016-5-14 18:19

(defun c:tes ( / #g1 &h1 &k1 &kw1 &n1 &n2 &ob1 &p1 &ss1 &ss2 &ss3 &ss4 aw ew x z40 z41)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(if (null vlax-dump-object) (vl-load-com) )
(setq &ss1 '(0 100 67 62 8 90 70 43))
(princ "\n请选择多段线")
(if (setq &kw1 (ssget '((0 . "LWPOLYLINE"))))
(progn
(while (setq &k1 (ssname &kw1 0))
(setq &kw1 (ssdel &k1 &kw1) &ob1 (vlax-ename->vla-object &k1))
(setq #g1 (entget &k1) &ss2 (vl-remove-if-not '(lambda (X) (member (car x) &ss1)) #g1))
(setq &n1 (vlax-curve-getEndParam &ob1) &n2 0.0 &ss3 '())
(if (= (cdr (assoc 70 #g1)) 0);如果不封闭
(progn
(setq &h1 (cons 42 (* -1.0 (vla-getBulge &ob1 &n1))));弧值
(vla-getwidth &ob1 &n1 'aw 'ew)
(setq z41 (cons 41 aw) z40 (cons 40 ew))
(setq &p1 (cons 10 (vlax-curve-getPointAtParam &ob1 &n2)))
(setq &ss3 (list &p1 z40 z41 &h1))
)
)
(while (> &n1 &n2)
(setq &h1 (cons 42 (* -1.0 (vla-getBulge &ob1 &n2))));弧值
(vla-getwidth &ob1 &n2 'aw 'ew)
(setq z41 (cons 41 aw) z40 (cons 40 ew))
(setq &n2 (1+ &n2) &p1 (cons 10 (vlax-curve-getPointAtParam &ob1 &n2)))
(setq &ss4 (list &p1 z40 z41 &h1) &ss3 (append &ss4 &ss3))
);
(setq &ss3 (append &ss2 &ss3))
(vla-delete &ob1)
(entmake &ss3)
);while
)
)
(princ)
)

(defun c:tes ( / #g1 &h1 &k1 &kw1 &n1 &n2 &ob1 &p1 &ss1 &ss2 &ss3 &ss4 aw ew x z40 z41) 
 (setvar "cmdecho" 0) 
 (setvar "blipmode" 0) 
 (if (null vlax-dump-object) (vl-load-com) ) 
 (setq &ss1 '(0 100 67 62 8 90 70 43)) 
 (princ "\n请选择多段线") 
 (if (setq &kw1 (ssget '((0 . "LWPOLYLINE")))) 
  (progn 
   (while (setq &k1 (ssname &kw1 0)) 
    (setq &kw1 (ssdel &k1 &kw1) &ob1 (vlax-ename->vla-object &k1)) 
    (setq #g1 (entget &k1) &ss2 (vl-remove-if-not '(lambda (X) (member (car x) &ss1)) #g1)) 
    (setq &n1 (vlax-curve-getEndParam &ob1) &n2 0.0 &ss3 '()) 
    (if (= (cdr (assoc 70 #g1)) 0);如果不封闭 
     (progn 
      (setq &h1 (cons 42 (* -1.0 (vla-getBulge &ob1 &n1))));弧值 
      (vla-getwidth &ob1 &n1 'aw 'ew) 
      (setq z41 (cons 41 aw) z40 (cons 40 ew)) 
      (setq &p1 (cons 10 (vlax-curve-getPointAtParam &ob1 &n2))) 
      (setq &ss3 (list &p1 z40 z41 &h1)) 
     ) 
    ) 
    (while (> &n1 &n2) 
     (setq &h1 (cons 42 (* -1.0 (vla-getBulge &ob1 &n2))));弧值 
     (vla-getwidth &ob1 &n2 'aw 'ew) 
     (setq z41 (cons 41 aw) z40 (cons 40 ew)) 
     (setq &n2 (1+ &n2) &p1 (cons 10 (vlax-curve-getPointAtParam &ob1 &n2))) 
     (setq &ss4 (list &p1 z40 z41 &h1) &ss3 (append &ss4 &ss3)) 
    ); 
    (setq &ss3 (append &ss2 &ss3)) 
    (vla-delete &ob1) 
    (entmake &ss3) 
   );while 
  ) 
 ) 
 (princ) 
)

ivde · 发表于 2016-5-14 18:25

command reverse

账号		自动登录	找回密码
密码			注册

[已解答] 怎么用lisp实现将不闭合的多段线的起始点和终止点互换，并且要维持多断线的形状不变

本帖子中包含更多资源

点评