;;;Moves plan & profile labels (tags) generated by GPDGN (does not require GPDGN) ;;; ;;; AUTHOR: HENRY C. FRANCIS ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; ;;; All rights reserved without prejudice. ;;; ;;; Copyright: 3-3-2006 ;;; Edited: 3-26-2009 ;;; ;;; Requires: upoint.lsp ;;; ;;;**************************************************************************** (DEFUN c:adjtag ( / tagss) (COMMAND ".undo" "begin") (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ") ) ;_ end of IF (IF (AND (EQ (GETVAR "tilemode") 1) (NOT (SSGET "X" '((2 . "corp*bats")))) ) ;_ end of AND (SETQ adj_lbltype "PRofile") (SETQ adj_lbltype "PLan") ) ;_ end of IF (SETQ adj_lbltype (ukword 1 "PLan PRofile" "Label type to adjust [PLan/PRofile]" adj_lbltype ) ;_ end of ukword ) ;_ end of SETQ (IF (AND (WCMATCH adj_lbltype "PLan") (EQ (GETVAR "tilemode") 0) ) ;_ end of AND (VLA-PUT-MSPACE (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)) :VLAX-TRUE ) ;_ end of vla-put-MSpace ;;; (COMMAND ".mspace") ) ;_ end of IF (WHILE (SETQ tagss (SSGET '((-4 . "") (-4 . "OR>") ) ) ;_ end of SSGET ) ;_ end of SETQ (SETQ prev-ss (SSGET "P")) (IF gvpno NIL (LOAD "gvpno" "\nFile GVPNO.LSP not loaded! ") ) ;_ end of IF (gvpno) (SETQ tagcnt 0) (IF upoint NIL (LOAD "upoint" "\nFile UPOINT.LSP not loaded! ") ) ;_ end of IF (IF dimscl NIL (LOAD "dimscl" "\nFile DIMSCL.LSP not loaded! ")) (dimscl) (SETQ vert-justify NIL) (IF (WCMATCH adj_lbltype "PRofile") (PROGN (c:sgr) (WHILE (EQ (SETQ base_pt (upoint 1 "Align" "Pick base point for relocation [Align]" nil nil)) "Align") (SETQ vert-justify T valign_pt (upoint 1 "" "Pick alignment axis" nil nil) ) ) ) (SETQ base_pt (upoint 1 "" "Pick base point for relocation" nil nil)) ) (IF vert-justify (SETQ newbase_pt (upoint 1 "" "Pick new horizontal location" nil base_pt)) (SETQ newbase_pt (upoint 1 "" "Pick new location" nil base_pt)) ) (SETQ off_dist (DISTANCE newbase_pt base_pt) off_ang (ANGLE base_pt newbase_pt) ) ;_ end of SETQ (SETQ tagcnt 0) (WHILE (AND (< tagcnt (SSLENGTH tagss))(NOT (EQ (CDR (ASSOC 0 (ENTGET (SSNAME tagss tagcnt)))) "TEXT"))) (SETQ tagcnt (1+ tagcnt)) ) (SETQ tagent (ENTGET (SSNAME tagss tagcnt)) align_txthgt (CDR (ASSOC 40 tagent)) ) (SETQ tagcnt 0) (WHILE (< tagcnt (SSLENGTH tagss)) (SETQ tagent (ENTGET (SSNAME tagss tagcnt))) (COND ((EQ (CDR (ASSOC 0 tagent)) "TEXT") (SETQ tagent (SUBST (CONS 10 (POLAR (CDR (ASSOC 10 tagent)) off_ang off_dist) ) ;_ end of CONS (ASSOC 10 tagent) tagent ) ;_ end of SUBST ) ;_ end of SETQ (IF (EQ (ASSOC 11 tagent) (CONS 11 '(0.0 0.0 0.0))) NIL (PROGN (SETQ tagent (SUBST (CONS 11 (POLAR (CDR (ASSOC 11 tagent)) off_ang off_dist) ) ;_ end of CONS (ASSOC 11 tagent) tagent ) ;_ end of SUBST ) ;_ end of SETQ ) ) (IF (AND vert-justify valign_pt (WCMATCH (STRCASE adj_lbltype) "PROFILE")) (PROGN (SETQ align_11_len (DISTANCE (CDR (ASSOC 10 tagent))(CDR (ASSOC 11 tagent))) align_11_ang (ANGLE (CDR (ASSOC 10 tagent))(CDR (ASSOC 11 tagent))) align_txthgt (CDR (ASSOC 40 tagent)) ) (SETQ tagent (SUBST (CONS 10 (LIST (CADR (ASSOC 10 tagent))(CADR valign_pt)0.0) ) ;_ end of CONS (ASSOC 10 tagent) tagent ) ) (IF (EQ (ASSOC 11 tagent) (CONS 11 '(0.0 0.0 0.0))) NIL (PROGN (SETQ tagent (SUBST (CONS 11 (POLAR (CDR (ASSOC 10 tagent)) align_11_ang align_11_len) ) ;_ end of CONS (ASSOC 11 tagent) tagent ) ) ) ) ) ) (ENTMOD tagent) ) ((EQ (CDR (ASSOC 0 tagent)) "POLYLINE") (IF (AND vert-justify valign_pt) (PROGN (SETQ valign_adj (- (CADR newbase_pt)(CADR valign_pt))) ) ) (SETQ plhead_ent tagent) (SETQ vrtxcnt 1) (WHILE (AND (ENTNEXT (CDR (ASSOC -1 tagent))) (SETQ vrtxent (ENTGET (ENTNEXT (CDR (ASSOC -1 tagent))))) (NOT (EQ (CDR (ASSOC 0 vrtxent)) "SEQEND")) ) ;_ end of AND (IF ;;; (> vrtxcnt ;;; (IF (AND viewno (> viewno 1)) ;;; 1 ;;; 2 ;;; ) ;_ end of IF ;;; ) ;_ end of > (OR (AND (> vrtxcnt 1) (WCMATCH (STRCASE adj_lbltype) "PLAN") ) ;_ end of AND (AND (> vrtxcnt 2) (WCMATCH (STRCASE adj_lbltype) "PROFILE") ) ;_ end of AND ) ;_ end of OR (PROGN (SETQ vrtxent (SUBST (CONS 10 (POLAR (CDR (ASSOC 10 vrtxent)) off_ang off_dist ) ;_ end of POLAR ) ;_ end of CONS (ASSOC 10 vrtxent) vrtxent ) ;_ end of SUBST ) ;_ end of SETQ (COND ((AND vert-justify (EQ vrtxcnt 3) valign_pt (WCMATCH (STRCASE adj_lbltype) "PROFILE")) (PROGN (SETQ tagline_len (DISTANCE (CDR (ASSOC 10 vrtxent))(CDR (ASSOC 10 (ENTGET (ENTNEXT (CDR (ASSOC -1 vrtxent)))))))) (SETQ vrtxent (SUBST (CONS 10 (LIST (CADR (ASSOC 10 vrtxent)) (IF (> (CADR vrtx2pnt)(CADR vrtx1pnt)) (- (CADR valign_pt) align_txthgt) (+ (CADR valign_pt) align_txthgt) ) 0.0 ) ) (ASSOC 10 vrtxent) vrtxent ) ) ) ) ((AND vert-justify (EQ vrtxcnt 4) tagline_len align_txthgt valign_pt vrtx1pnt vrtx2pnt (WCMATCH (STRCASE adj_lbltype) "PROFILE")) (PROGN (SETQ vrtxent (SUBST (CONS 10 (LIST (CADR (ASSOC 10 vrtxent)) (IF (> (CADR vrtx2pnt)(CADR vrtx1pnt)) (+ (- (CADR valign_pt) align_txthgt) (DISTANCE vrtx3pnt vrtx4pnt)) (- (+ (CADR valign_pt) align_txthgt) (DISTANCE vrtx3pnt vrtx4pnt)) ) 0.0 ) ) (ASSOC 10 vrtxent) vrtxent ) ) ) ) ) (ENTMOD vrtxent) ) ;_ end of progn (IF (AND (EQ vrtxcnt 1) (WCMATCH (STRCASE adj_lbltype) "PROFILE")) (PROGN ;;; (PRINC "\nvrtx1pnt = ") ;;; (PRINC vrtx1pnt) ;;; (PRINC "\nvrtx2pnt = ") ;;; (PRINC vrtx2pnt) ;;; (PRINC "\nvrtx3pnt = ") ;;; (PRINC vrtx3pnt) ;;; (PRINC "\nvrtx4pnt = ") ;;; (PRINC vrtx4pnt) ;;; (PRINC) (SETQ vrtx1pnt (CDR (ASSOC 10 vrtxent)) vrtx2pnt (CDR (ASSOC 10 (ENTGET (ENTNEXT (CDR (ASSOC -1 vrtxent)))))) vrtx3pnt (CDR (ASSOC 10 (ENTGET (ENTNEXT (ENTNEXT (CDR (ASSOC -1 vrtxent))))))) vrtx4pnt (CDR (ASSOC 10 (ENTGET (ENTNEXT (ENTNEXT (ENTNEXT (CDR (ASSOC -1 vrtxent)))))))) ) ) ;;; (PROGN ;;; (PRINC "\nvrtxcnt = ") ;;; (PRINC vrtxcnt) ;;; (PRINC "\nadj_lbltype = ") ;;; (PRINC (STRCASE adj_lbltype)) ;;; (PRINC) ;;; ) ) ) ;_ end of if (SETQ vrtxcnt (1+ vrtxcnt)) (SETQ tagent vrtxent) ) ;_ end of while (ENTMOD plhead_ent) (SETQ from_adjtag T) (C:SWAPTAG) ) ((EQ (CDR (ASSOC 0 tagent)) "INSERT") (SETQ tagent (SUBST (CONS 10 (POLAR (CDR (ASSOC 10 tagent)) off_ang off_dist) ) ;_ end of CONS (ASSOC 10 tagent) tagent ) ;_ end of SUBST ) ;_ end of SETQ (IF (AND vert-justify valign_pt valign_adj (WCMATCH (STRCASE adj_lbltype) "PROFILE")) (PROGN (SETQ tagent (SUBST (CONS 10 (LIST (CADR (ASSOC 10 tagent)) (- (CADDR (ASSOC 10 tagent)) valign_adj) 0.0 ) ) (ASSOC 10 tagent) tagent ) ) ) ) (ENTMOD tagent) (ENTUPD (CDR (ASSOC -1 tagent))) (SETQ attrent tagent) (WHILE (AND (SETQ attrent (ENTGET (ENTNEXT (CDR (ASSOC -1 attrent))))) (/= (CDR (ASSOC 0 attrent)) "SEQEND") ) ;_ end of AND (IF (EQ (CDR (ASSOC 0 attrent)) "ATTRIB") (PROGN (SETQ attrent (SUBST (CONS 10 (POLAR (CDR (ASSOC 10 attrent)) off_ang off_dist ) ;_ end of POLAR ) ;_ end of CONS (ASSOC 10 attrent) attrent ) ;_ end of SUBST ) ;_ end of SETQ (SETQ attrent (SUBST (CONS 11 (POLAR (CDR (ASSOC 11 attrent)) off_ang off_dist ) ;_ end of POLAR ) ;_ end of CONS (ASSOC 11 attrent) attrent ) ;_ end of SUBST ) ;_ end of SETQ (IF (AND vert-justify valign_pt (WCMATCH (STRCASE adj_lbltype) "PROFILE")) (PROGN (SETQ align_11_len (DISTANCE (CDR (ASSOC 10 attrent))(CDR (ASSOC 11 attrent))) align_11_ang (ANGLE (CDR (ASSOC 10 attrent))(CDR (ASSOC 11 attrent))) ) (SETQ attrent (SUBST (CONS 10 (LIST (CADR (ASSOC 10 attrent))(CADR valign_pt)0.0) ) ;_ end of CONS (ASSOC 10 attrent) attrent ) ) (SETQ attrent (SUBST (CONS 11 (POLAR (CDR (ASSOC 10 attrent)) align_11_ang align_11_len) ) ;_ end of CONS (ASSOC 11 attrent) attrent ) ) ) ) (ENTMOD attrent) (ENTUPD (CDR (ASSOC -1 attrent))) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of WHILE ) ) ;_ end of COND (SETQ tagcnt (1+ tagcnt)) (vl-cmdf "Select" prev-ss "") (COMMAND) ) ;_ end of WHILE ) ;_ end of WHILE (COMMAND ".UNDO" "END") (PRINC) ) ;_ end of defun ;;;******************************************************************** (DEFUN C:SWAPTAG () ;;; (IF (AND (EQ (GETVAR "tilemode") 1) ;;; (NOT (SSGET "X" '((2 . "corp*bats")))) ;;; ) ;_ end of AND ;;; (SETQ adj_lbltype "PRofile") ;;; (SETQ adj_lbltype "PLan") ;;; ) ;_ end of IF (IF (WCMATCH adj_lbltype "PLan");This function only applies to plan labels created by GPDGN (PROGN (IF from_adjtag (SETQ tagldr plhead_ent) (SETQ tagldr (ENTGET (CAR (ENTSEL)))) ) ;_ end of IF (SETQ pl-ent-lst NIL) (SETQ this-twist (GETVAR "VIEWTWIST")) (IF (EQUAL this-twist 0.0) (SETQ vwhoriz 0.0) (SETQ vwhoriz (- (* 2.0 PI) this-twist)) ) ;_ end of IF (SETQ pl-ent-lst (LIST tagldr)) (WHILE (/= (CDR (ASSOC 0 (LAST pl-ent-lst))) "SEQEND") (SETQ pl-ent-lst (APPEND pl-ent-lst (LIST (ENTGET (ENTNEXT (CDR (ASSOC -1 (LAST pl-ent-lst)))) ) ;_ end of ENTGET ) ;_ end of LIST ) ;_ end of APPEND ) ;_ end of SETQ ) ;_ end of WHILE (SETQ nth-1-ent (NTH 1 pl-ent-lst)) (SETQ nth-2-ent (NTH 2 pl-ent-lst)) (SETQ nth-3-ent (NTH 3 pl-ent-lst)) (IF (OR (AND from_adjtag (> (DISTANCE (CDR (ASSOC 10 nth-1-ent)) (CDR (ASSOC 10 nth-2-ent)) ) ;_ end of DISTANCE (DISTANCE (CDR (ASSOC 10 nth-1-ent)) (CDR (ASSOC 10 nth-3-ent)) ) ;_ end of DISTANCE ) ;_ end of > ) ;_ end of AND (NOT from_adjtag) ) ;_ end of OR (PROGN (SETQ new-nth-2-ent (SUBST (CONS 10 (POLAR (CDR (ASSOC 10 nth-3-ent)) (ANGLE (CDR (ASSOC 10 nth-2-ent)) (CDR (ASSOC 10 nth-3-ent)) ) ;_ end of ANGLE (* 2.0 dimsc 0.11) ) ;_ end of POLAR ) ;_ end of CONS (ASSOC 10 nth-2-ent) nth-2-ent ) ;_ end of SUBST ) ;_ end of SETQ (SETQ new-nth-3-ent (SUBST (CONS 10 (POLAR (CDR (ASSOC 10 nth-2-ent)) (ANGLE (CDR (ASSOC 10 nth-2-ent)) (CDR (ASSOC 10 nth-3-ent)) ) ;_ end of ANGLE (* 2.0 dimsc 0.11) ) ;_ end of POLAR ) ;_ end of CONS (ASSOC 10 nth-3-ent) nth-3-ent ) ;_ end of SUBST ) ;_ end of SETQ (ENTMOD new-nth-2-ent) (ENTMOD new-nth-3-ent) (ENTUPD (CDR (ASSOC -1 (NTH 0 pl-ent-lst)))) (SETQ from_adjtag NIL) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN (IF from_adjtag (SETQ from_adjtag NIL) (ALERT "SWAPTAG only applies to plan labels created by GPDGN") ) ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;;;******************************************************************** ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 0 1 nil nil nil T) ;*** DO NOT add text below the comment! ***|;