;;; RPOLY ;;; (defun GETCODELIST (code lista / item lout) (while (setq item (assoc code lista)) (setq lista (cdr (member item lista)) lout (cons item lout) ;lista output ) ) lout ) (defun DXFN (code name) (cdr (assoc code (entget name))) ) (defun LISTROTATE (n lista) (repeat n (setq lista (cdr (append lista (list (car lista))))) ) ) (defun C:RPOLY (/ poly vt lvt lvt2 new old ed closed l_10 l_40 l_41 l_42 i n item) (setq poly (car (entsel "\nSelect a polyline..."))) (cond ((and poly (= (dxfn 0 poly) "POLYLINE")) (setq closed (= (dxfn 70 poly) 1) vt (entnext poly) ) (while (/= (dxfn 0 vt) "SEQEND") (if (/= 16 (dxfn 70 vt)) (setq lvt (cons (list (dxfn 10 vt) (dxfn 42 vt)) lvt)) ) (setq vt (entnext vt)) ) (if closed ;se è chiusa (setq lvt (cons (last lvt) lvt) ;aggiungi l'ultimo e togli il primo lvt (reverse (cdr (reverse lvt))) ) ) (setq lvt2 (cdr (append lvt (list (car lvt)))) ;lista parallela lvt (mapcar '(lambda (a b) (list (car a) (- (cadr b)))) lvt lvt2 ) ;lista invertita lvt2 nil ) (setq vt (entnext poly)) (while (/= (dxfn 0 vt) "SEQEND") (if (/= 16 (dxfn 70 vt)) (progn (setq ed (entget vt) old (assoc 10 ed) new (cons 10 (caar lvt)) ed (subst new old ed) old (assoc 42 ed) new (cons 42 (cadr (car lvt))) ed (subst new old ed) lvt (cdr lvt) ) (entmod ed) ) ;p ) ;i (setq vt (entnext vt)) ) ;w (entupd poly) ) ;c1 ((and poly (= (dxfn 0 poly) "LWPOLYLINE")) (setq ed (entget poly) lvt (member (assoc 10 ed) ed) lvt (reverse (cdr (reverse lvt))) l_10 (getcodelist 10 lvt) l_41 (getcodelist 41 lvt) l_41 (mapcar '(lambda (a) (cons 40 (cdr a))) l_41) l_41 (listrotate 1 l_41) l_40 (getcodelist 40 lvt) l_40 (mapcar '(lambda (a) (cons 41 (cdr a))) l_40) l_40 (listrotate 1 l_40) l_42 (getcodelist 42 lvt) l_42 (mapcar '(lambda (a) (cons 42 (- (cdr a)))) l_42) l_42 (listrotate 1 l_42) n (length l_10) i 0 ) (while (< i n) (setq lvt2 (append lvt2 (list (nth i l_10) (nth i l_41) (nth i l_40) (nth i l_42) ) ) i (1+ i) ) ) (setq lvt (reverse ed)) (while (setq item (assoc 10 lvt)) (setq lvt (cdr (member item lvt))) ) (setq lvt (reverse lvt) lvt2 (append lvt lvt2 (list (assoc 210 ed))) ) (entmod lvt2) (entupd poly) ) (T (princ "\nThat was not a polyline.")) ) ;c (princ) ) ;end