;;;This routine will reverse the order of vertices in any polyline. It ;;;creates a new polyline at the end of the existing one that has just two ;;;vertices occupying the same point as the existing end. It then uses ;;;PEDIT JOIN to accomplish the reversal. If your polylines must not have ;;;more than one vertex occupying the origin point of the newly ordered ;;;polyline then don't use this routine or PEDIT the result to remove the ;;;extra vertices created by this routine. ;;; ;;; ;;; AUTHOR: HENRY C. FRANCIS ;;; 425 N. ASHE ST. ;;; SOUTHERN PINES, NC 28387 ;;; ;;; All rights reserved without prejudice. ;;; ;;; Copyright: 12-3-95 ;;; Edited: 8-28-2013 ;;; ;;; Incorporated AutoCAD's Reverse option in its curent PEDIT command ;;; (DEFUN c:plrev (/ plss count exent centh nxent centv cend first_vrtx) (SETVAR "cmdecho" 0) (IF (EQ (SUBSTR (GETVAR "acadver") 1 2) "19") (SETQ plss (SSGET '((-4 . "")))) (PROGN (PRINC "Select POLYLINES only (no LWPOLYLINES, use the CONVERTPOLY command if necessary)") (PRINC) (SETQ plss (SSGET '((0 . "POLYLINE")))) ) ;_ end of PROGN ) ;_ end of IF (IF (EQ (SUBSTR (GETVAR "acadver") 1 2) "19") (PROGN (COMMAND ".PEDIT" "M" plss "" "R" "")) (PROGN (SETQ count (1- (SSLENGTH plss))) (WHILE (>= count 0) (SETQ exent (SSNAME plss count)) (SETQ entdf (ENTGET exent)) (COND ((EQ (CDR (ASSOC 0 entdf)) "POLYLINE") (SETQ centh (CDR entdf)) (SETQ nxent (ENTNEXT exent)) (IF first_vrtx NIL (SETQ first_vrtx (ENTGET (ENTNEXT exent))) ) ;_ end of IF (WHILE (NOT (EQ "SEQEND" (CDR (ASSOC 0 (ENTGET nxent))))) (SETQ centv (CDR (ENTGET nxent))) (SETQ nxent (ENTNEXT nxent)) ) ;while (SETQ exent (CDR (ASSOC -2 (ENTGET nxent)))) (SETQ cend (LIST (CONS 0 "SEQEND"))) (IF (EQUAL (CDR (ASSOC 10 first_vrtx)) (CDR (ASSOC 10 centv)) 0.001) (ALERT "A polyline which has common endpoints cannot be reversed by this method!") (PROGN ;;; (PRINC "\nfirst_vrtx = ") ;;; (PRINC first_vrtx) ;;; (PRINC "\ncentv = ") ;;; (PRINC centv) ;;; (PRINC "\n") ;;; (PRINC) (ENTMAKE centh) (ENTMAKE centv) (ENTMAKE centv) (ENTMAKE cend) (COMMAND ".pedit" (ENTLAST) "j" exent "" "") (SETQ newpl_ent (ENTGET exent) first_vrtx NIL newpl_lst NIL ) ;_ end of setq (IF (EQ (CDR (ASSOC 0 newpl_ent)) "POLYLINE") (PROGN (ENTMAKE (LIST (ASSOC 0 newpl_ent) (ASSOC 8 newpl_ent) (ASSOC 10 newpl_ent))) (WHILE (/= (CDR (ASSOC 0 (SETQ nextpl_vrtx (ENTGET (ENTNEXT (CDR (ASSOC -1 (IF nextpl_vrtx nextpl_vrtx newpl_ent ) ;_ end of IF ) ;_ end of ASSOC ) ;_ end of CDR ) ;_ end of ENTNEXT ) ;_ end of ENTGET ) ;_ end of SETQ ) ;_ end of ASSOC ) ;_ end of CDR "SEQEND" ) ;_ end of /= (IF (AND (EQ (CDR (ASSOC 0 nextpl_vrtx)) "VERTEX") (NOT first_vrtx)) (SETQ first_vrtx T) (IF (ASSOC 42 nextpl_vrtx) ;;; (IF (ASSOC 42 (ENTGET (ENTNEXT (CDR (ASSOC -1 nextpl_vrtx))))) (IF (AND (ASSOC 40 nextpl_vrtx) (ASSOC 41 nextpl_vrtx)) (IF (ASSOC 48 nextpl_vrtx) (ENTMAKE (LIST (ASSOC 0 nextpl_vrtx) (ASSOC 8 nextpl_vrtx) (ASSOC 10 nextpl_vrtx) (ASSOC 40 nextpl_vrtx) (ASSOC 41 nextpl_vrtx) (ASSOC 42 nextpl_vrtx) (ASSOC 48 nextpl_vrtx) ) ;_ end of LIST ) ;_ end of ENTMAKE (ENTMAKE (LIST (ASSOC 0 nextpl_vrtx) (ASSOC 8 nextpl_vrtx) (ASSOC 10 nextpl_vrtx) (ASSOC 40 nextpl_vrtx) (ASSOC 41 nextpl_vrtx) (ASSOC 42 nextpl_vrtx) ) ;_ end of LIST ) ;_ end of ENTMAKE ) ;_ end of IF (IF (ASSOC 48 nextpl_vrtx) (ENTMAKE (LIST (ASSOC 0 nextpl_vrtx) (ASSOC 8 nextpl_vrtx) (ASSOC 10 nextpl_vrtx) (ASSOC 42 nextpl_vrtx) (ASSOC 48 nextpl_vrtx) ) ;_ end of LIST ) ;_ end of ENTMAKE (ENTMAKE (LIST (ASSOC 0 nextpl_vrtx) (ASSOC 8 nextpl_vrtx) (ASSOC 10 nextpl_vrtx) (ASSOC 42 nextpl_vrtx) ) ;_ end of LIST ) ;_ end of ENTMAKE ) ;_ end of IF ) ;_ end of IF (IF (AND (ASSOC 40 nextpl_vrtx) (ASSOC 41 nextpl_vrtx)) (IF (ASSOC 48 nextpl_vrtx) (ENTMAKE (LIST (ASSOC 0 nextpl_vrtx) (ASSOC 8 nextpl_vrtx) (ASSOC 10 nextpl_vrtx) (ASSOC 40 nextpl_vrtx) (ASSOC 41 nextpl_vrtx) (ASSOC 48 nextpl_vrtx) ) ;_ end of LIST ) ;_ end of ENTMAKE (ENTMAKE (LIST (ASSOC 0 nextpl_vrtx) (ASSOC 8 nextpl_vrtx) (ASSOC 10 nextpl_vrtx) (ASSOC 40 nextpl_vrtx) (ASSOC 41 nextpl_vrtx) ) ;_ end of LIST ) ;_ end of ENTMAKE ) ;_ end of IF (ENTMAKE (LIST (ASSOC 0 nextpl_vrtx) (ASSOC 8 nextpl_vrtx) (ASSOC 10 nextpl_vrtx))) ) ;_ end of IF ;;; (IF (EQ (CDR (ASSOC 42 nextpl_vrtx)) 0.0) ;;; (CONS 42 0.0) ;;; (CONS 42 (CDR (ASSOC 42 nextpl_vrtx))) ;;; ) ;;; ) ;;; ) ;;; (ENTMAKE (LIST (ASSOC 0 nextpl_vrtx) (ASSOC 8 nextpl_vrtx) (ASSOC 10 nextpl_vrtx))) ) ;_ end of IF ) ;_ end of IF ) ;_ end of WHILE (IF (ENTMAKE (LIST (CONS 0 "SEQEND"))) (ENTDEL (CDR (ASSOC -1 newpl_ent))) (ENTMAKE) ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of if ) ;_ end of PROGN ) ;_ end of IF (SETQ newpl_ent NIL nextpl_vrtx NIL ) ;_ end of SETQ ) ;;; ((EQ (CDR (ASSOC 0 entdf)) "LWPOLYLINE") ;;; (SETQ last10 (CDR (ASSOC 10 (REVERSE entdf)))) ;;; (COMMAND ".LINE" (POLAR last10 0 0.001) last10 "") ;;; (COMMAND ".pedit" (ENTLAST) "Y" "j" exent "" "") ;;; (COMMAND ".pedit" (ENTLAST) "E" "B" "N" "G" "X" "") ;;; ) ) ;_ end of COND (SETQ count (1- count)) ) ;while ) ;_ end of PROGN ) ;_ end of IF (IF (> (SSLENGTH plss) 1) (PROMPT (STRCAT "\n" (RTOS (SSLENGTH plss) 2 0) " polylines have been reversed. ")) (PROMPT "\nPolyline has been reversed. ") ) ;if (PRINC) ) ;defun ;|«Visual LISP© Format Options» (120 2 15 2 T "end of " 100 9 2 0 nil nil nil nil T) ;*** DO NOT add text below the comment! ***|;