;;;Places leader, line(s) of text and a vertical line w/ multiple lines of text. ;;; The leader may include a single line segment or multiple line segments ;;; at any angle. A vertical line will be placed at the end of the last ;;; leader line if there is more than one line of text. After the vertical ;;; line is placed the notes and line are repositioned so that the vertical ;;; line is centered on the end of the last leader line. ;;; ;;; AUTHOR: HENRY C. FRANCIS ;;; 425 N. ASHE ST. ;;; SOUTHERN PINES, NC 28387 ;;; ;;; All rights reserved without prejudice. ;;; ;;; Copyright: 1996 - 2006 ;;; Edited: 9-2-2006 ;;; ;;;**************************************************************************** (DEFUN remlt_error (msg) (PRINC (STRCAT "\nError: " msg ": " (IF debug_funs (STRCAT (IF oldfunname4 (STRCAT oldfunname4 "; ") "") (IF oldfunname3 (STRCAT oldfunname3 "; ") "") (IF oldfunname2 (STRCAT oldfunname2 "; ") "") (IF oldfunname1 (STRCAT oldfunname1 "; ") "") (IF oldfunname0 (STRCAT oldfunname0 "; ") "") (IF funname funname "") ) "" ) ) ) (SETQ mltss NIL) (SETVAR "NOMUTT" 0) (IF getstyle NIL (LOAD "getstyle" "\nFile GETSTYLE.LSP not loaded! ") ) ;_ end of IF (IF (AND old_remlt_layer (TBLSEARCH "LAYER" old_remlt_layer)) (SETVAR "clayer" old_remlt_layer) ) ;_ end of IF (SETQ from_lbld NIL ldlblss NIL ) ;_ end of SETQ (SETVAR "osmode" old_remlt_osmodes) (SETVAR "regenmode" old_remlt_regenmode) (SETVAR "ucsfollow" old_remlt_ucsfollow) (IF msg (PRINC (STRCAT "\n*** ERROR: " msg " *** ")) ) ;_ end of IF (SETQ *error* old_remlt_error) (getstyle "") (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN C:REMLT (/ mltss pt1 mp2 numb inss1 mpb mpn bldsc clayr txht ntxt nxtx nxxt ntx1 ntx2 ntx3 ntx4 ntx5 ntx6 ntx7 ntx8 ntx9 ntx10 subst-mleader ) (SETQ oldfunname4 oldfunname3 oldfunname3 oldfunname2 oldfunname2 oldfunname1 oldfunname1 oldfunname0 oldfunname0 funname funname "c:remlt" ) (IF (< (GETVAR "LUPREC") 2) (SETVAR "LUPREC" 4) ) ;_ end of IF (SETQ old_remlt_ucsfollow (GETVAR "ucsfollow")) (SETQ old_remlt_error *ERROR*) (SETQ *ERROR* remlt_error) (SETVAR "ucsfollow" 0) (SETQ pt1 "Options") (SETQ remltopts NIL) (SETQ old_remlt_regenmode (GETVAR "regenmode")) (SETVAR "regenmode" 0) (SETVAR "cmdecho" 0) (SETQ old_remlt_osmodes (GETVAR "osmode")) (SETVAR "osmode" 0) (IF do_exist (PROGN (SETQ exist_option "Yes") (VL-BB-SET 'bb-do_exist do_exist) ) (PROGN (SETQ exist_option "No") (VL-BB-SET 'bb-do_exist NIL) ) ) ;;; (COMMAND ".undo" "begin") (IF c:mklayr nil (LOAD "mklayr" "\nFile MKLAYR.LSP not loaded! ") ) ;_ end of if (c:svlayr) (vl-load-com) (IF m-leader (vl-bb-set 'bb-m-leader m-leader) (IF my-m-leader (PROGN (SETQ m-leader my-m-leader) (vl-bb-set 'bb-m-leader m-leader) ) (IF (SETQ m-leader (vl-bb-ref 'bb-m-leader)) NIL (PROGN (SETQ m-leader "0" my-m-leader "0") (vl-bb-set 'bb-m-leader m-leader) ) ) ) ) (IF do_right_just NIL (SETQ do_right_just "No" ) ;_ end of SETQ ) ;_ end of IF (IF t-leader (vl-bb-set 'bb-t-leader t-leader) (IF my-t-leader (PROGN (SETQ t-leader my-t-leader) (vl-bb-set 'bb-t-leader t-leader) ) (IF (SETQ t-leader (vl-bb-ref 'bb-t-leader)) NIL (PROGN (SETQ t-leader "1" my-t-leader "1") (vl-bb-set 'bb-t-leader t-leader) ) ) ) ) (SETQ this_cdate (getvar "cdate")) (IF txtsize NIL (LOAD "txtsize" "\nFile TXTSIZE.LSP not loaded! ") ) ;_ end of IF (IF debug_remlt (PROGN (princ "\nREMLT: Start (txtsize nil) ! ") (princ (STRCAT (rtos (* 1000000.0 (- (getvar "cdate") this_cdate))2 2) " seconds ")) (SETQ this_cdate (getvar "cdate")) (PRINC) ) ) (txtsize nil) (IF debug_remlt (PROGN (princ "\nREMLT: End (txtsize nil) ! ") (princ (STRCAT (rtos (* 1000000.0 (- (getvar "cdate") this_cdate))2 2) " seconds ")) (SETQ this_cdate (getvar "cdate")) (PRINC) ) ) (IF (AND (EQ (GETVAR "tilemode") 0) (EQ (GETVAR "dimscale") 1.0) ) ;_ end of AND (SETVAR "dimscale" 0) ) ;_ end of if (IF debug_remlt (PROGN (princ "\nREMLT: Begin multiple load functions ! ") (princ (STRCAT (rtos (* 1000000.0 (- (getvar "cdate") this_cdate))2 2) " seconds ")) (SETQ this_cdate (getvar "cdate")) (PRINC) ) ) (IF uangle NIL (LOAD "uangle" "\nFile UANGLE.LSP not loaded!") ) ;_ end of IF (IF udist NIL (LOAD "udist" "\nFile UDIST.LSP not loaded!") ) ;_ end of IF (IF upoint NIL (LOAD "upoint" "\nFile UPOINT.LSP not loaded!") ) ;_ end of IF (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded!") ) ;_ end of IF (IF uint NIL (LOAD "uint" "\nFile UINT.LSP not loaded!") ) ;_ end of IF (IF ureal NIL (LOAD "ureal" "\nFile UREAL.LSP not loaded!") ) ;_ end of IF (IF ustr NIL (LOAD "ustr" "\nFile USTR.LSP not loaded!") ) ;_ end of IF (SETQ old_remlt_layer (GETVAR "clayer")) (IF getstyle NIL (LOAD "getstyle" "\nFile GETSTYLE.LSP not loaded! ") ) ;_ end of IF (IF debug_remlt (PROGN (princ "\nREMLT: End multiple load functions ! ") (princ (STRCAT (rtos (* 1000000.0 (- (getvar "cdate") this_cdate))2 2) " seconds ")) (SETQ this_cdate (getvar "cdate")) (PRINC) ) ) (SETQ old_remlt_ucsname (GETVAR "ucsname")) (IF ignore_ucs NIL (PROGN (IF debug_remlt (PROGN (princ "\nREMLT: Begin UCS stuff ! ") (princ (STRCAT (rtos (* 1000000.0 (- (getvar "cdate") this_cdate))2 2) " seconds ")) (SETQ this_cdate (getvar "cdate")) (PRINC) ) ) (IF (TBLSEARCH "ucs" "pre-mlt") (PROGN (IF (> (GETVAR "expert") 3) (COMMAND "ucs" "s" "pre-mlt") (COMMAND "ucs" "s" "pre-mlt" "y") ) ;_ end of IF (COMMAND "ucs" "w") ) ;_ end of PROGN (PROGN (COMMAND "ucs" "s" "pre-mlt") (COMMAND "ucs" "w")) ) ;_ end of IF (IF debug_remlt (PROGN (princ "\nREMLT: End UCS stuff ! ") (princ (STRCAT (rtos (* 1000000.0 (- (getvar "cdate") this_cdate))2 2) " seconds ")) (SETQ this_cdate (getvar "cdate")) (PRINC) ) ) ) ) (IF (AND (EQ colr_over "1") tnote_txtc) (SETQ txcolr tnote_txtc lncolr tnote_ldrc ) (SETQ txcolr "6" lncolr "1" ) ) (SETQ llt "-" colr (IF lncolr lncolr "1" ) ;_ end of IF colra nil colri nil numb 0 modf "NOTE" ) ;_ end of SETQ (IF dimscl nil (LOAD "dimscl" "\nFile DIMSCL.LSP not loaded! ") ) ;_ end of if (dimscl) ;;; (IF txtsize ;;; NIL ;;; (LOAD "txtsize" "File TXTSIZE.LSP not found!") ;;; ) ;_ end of IF ;;; (txtsize thts) (IF (AND (EQ colr_over "1") tnote_txtc) (SETQ txcolr tnote_txtc lncolr tnote_ldrc ) (SETQ txcolr "6" lncolr "1" ) ) (IF txcolr (SETQ colr txcolr) (SETQ txcolr "6" colr txcolr ) ;_ end of SETQ ) ;_ end of IF (IF mjrg NIL (PROGN (IF set_mjrg NIL (LOAD "SET_MJRG" "\nFile SET_MJRG.LSP not loaded! ")) (set_mjrg) ) ) ;; (WHILE (AND (EQ (TYPE pt1) 'STR)(WCMATCH (STRCASE pt1) "OPTIONS")) (IF (OR do_remlt (NOT remltopts)) (PROGN (IF delot NIL (SETQ delot "Move") ) ;_ end of IF (IF remltopts (set-remlt-options) ;;; (txtsize nil) (PRINC (STRCAT "\nREMLT settings: " delot "; text height " (IF dimsc (STRCAT "(" (RTOS dimsc 2 0) "X) ") "" ) ;_ end of IF (IF (OR (EQ (TYPE (READ thts)) 'INT) (EQ (TYPE (READ thts)) 'REAL) ) ;_ end of OR (STRCAT (RTOS (/ (ATOF thts) 1000.0) 2 3) " ") "" ) ;_ end of IF "(Leroy " thts "); " (IF (WCMATCH (STRCASE do_right_just) "YES") "; Right Justify" "; Left Justify" ) ;_ end of IF "; with arrowhead=" (IF arohed (STRCASE arohed) (SETQ arohed "YES") ) ;_ end of IF (IF (EQ m-leader "1") (STRCAT "; M-Leader=YES; MLeaderStyle=" (GETVAR "cmleaderstyle")) (STRCAT "; M-Leader=NO; T-Leader=" (IF (EQ t-leader "0") "NO" "YES" ) ;_ end of IF ) ) (IF do_exist "; Existing. " "; New. " ) ) ;_ end of STRCAT ) ;_ end of PRINC ) ;_ end of IF (IF txcolr (SETQ colr txcolr) (SETQ txcolr "6" colr txcolr ) ;_ end of SETQ ) ;_ end of IF ) ;_ end of progn (set-remlt-options) ) ;_ end of if (IF do_cmud (COND ((OR (>= (ATOF thts) 140) from_lbld) (COMMAND "-style" "ROMAND" "romand" 0 (IF from_lbld 1 1.5 ) ;_ end of IF 15 "N" "N" "N" ) ;_ end of COMMAND ) ((>= (ATOF thts) 120) (COMMAND "-style" "ROMAND" "romand" 0 1 15 "N" "N" "N") ) (PROGN (COMMAND "-style" "SIMPLEX" "simplex" 0 1 0 "N" "N" "N") ) ) ;_ end of COND ) ;_ end of IF (SETQ dis1 txtht dis2 (* dis1 1.55) dis3 (* dis1 0.55) ) ;_ end of SETQ (getstyle "A") ;;; (IF do_cmud ;;; nil ;;; (progn ;;; (PRINC "\n3 ") ;;; (princ (tblsearch "LAYER" (GETVAR"CLAYER"))) ;;; (princ) ;;; (c:mklayr) ;;; (PRINC "\n4 ") ;;; (princ (tblsearch "LAYER" (GETVAR"CLAYER"))) ;;; (princ) ;;; ) ;;; ) ;_ end of IF (IF (AND do_remlt ldlblss) (PROGN (SETQ mltss ldlblss count 0 txt_count 0 sslen (SSLENGTH mltss) ) ;_ end of setq ) ;_ end of progn (PROGN (IF mltss (SETVAR "nomutt" 0) (PROGN (PRINC "\nSelect drawing objects or Enter to select objects in xrefs: ") (PRINC) (SETVAR "nomutt" 1) (IF (SETQ mltss (SSGET (LIST (CONS -4 "") (CONS -4 "") (CONS -4 "AND>") (CONS -4 "") (CONS -4 "OR>") ) ;_ end of LIST ) ;_ end of SSGET ) ;_ end of SETQ NIL (PROGN (PRINC "\nSelect objects in xrefs: ") (PRINC) (SETQ mltss (SSADD)) (WHILE (SETQ xref_sel (NENTSELP)) (PROGN (SETQ this_ent (ENTGET (CAR xref_sel))) (IF (OR (AND (EQ (CDR (ASSOC 0 this_ent)) "ATTRIB")(OR (WCMATCH (CDR (ASSOC 8 this_ent)) "*|*")(EQ (CDR (ASSOC 8 this_ent)) "0"))) (AND (EQ (CDR (ASSOC 0 this_ent)) "TEXT")(OR (WCMATCH (CDR (ASSOC 8 this_ent)) "*|*")(EQ (CDR (ASSOC 8 this_ent)) "0"))) (AND (EQ (CDR (ASSOC 0 this_ent)) "MTEXT")(OR (WCMATCH (CDR (ASSOC 8 this_ent)) "*|*")(EQ (CDR (ASSOC 8 this_ent)) "0"))) (AND (EQ (CDR (ASSOC 0 this_ent)) "MULTILEADER")(OR (WCMATCH (CDR (ASSOC 8 this_ent)) "*|*")(EQ (CDR (ASSOC 8 this_ent)) "0"))) ) (PROGN (IF (EQ (SSLENGTH mltss) 0) (PRINC " ") ) (SETQ mltss (SSADD (CAR xref_sel) mltss)) (COND ((AND (> (SSLENGTH mltss) 0)(< (SSLENGTH mltss) 10)) (PRINC "\010\010\010\010\010\010\010\010\010\010\010") (PRINC (SSLENGTH mltss)) (PRINC " selected!")) ((>= (SSLENGTH mltss) 10) (PRINC "\010\010\010\010\010\010\010\010\010\010\010\010") (PRINC (SSLENGTH mltss)) (PRINC " selected!")) ) ) ) ) ) ) ) (SETVAR "nomutt" 0) ) ) ;_ end of IF (SETQ count 0 txt_count 0 sslen (IF mltss (SSLENGTH mltss) 0 ) ;_ end of IF ) ;_ end of SETQ ) ;_ end of progn ) ;_ end of if (if mltss (progn (if calctxt NIL (LOAD "calctxt" "\nFile CALCTXT.LSP not loaded! ")) (if getfield NIL (LOAD "getfield" "\nFile GETFIELD.LSP not loaded! ")) (setq cnt 0) (while (< cnt (sslength mltss)) (COND ((eq (cdr (assoc 0 (setq this-ssent (entget (ssname mltss cnt))))) "TEXT") (setq new-txt (calctxt (cdr (assoc 1 this-ssent)))) (IF (AND new-txt (/= new-txt (cdr (assoc 1 this-ssent)))) (progn (setq this-ssent (subst (cons 1 new-txt)(assoc 1 this-ssent)this-ssent)) (entmod this-ssent) ) ) ) ((eq (cdr (assoc 0 (setq this-ssent (entget (ssname mltss cnt))))) "MTEXT") (IF (AND mltss cnt) (getfield (ssname mltss cnt)) ) (IF (AND this-fexp (/= this-fexp "")) (SETQ new-txt this-fexp) (PROGN (setq new-txt (calctxt (cdr (assoc 1 this-ssent)))) (IF (AND new-txt (/= new-txt (cdr (assoc 1 this-ssent)))) (progn (setq this-ssent (subst (cons 1 new-txt)(assoc 1 this-ssent)this-ssent)) (entmod this-ssent) ) ) ) )) ) (setq cnt (1+ cnt) new-txt NIL ) ) ) ) (set-remlt-prod) (IF debug_remlt (PROGN (PRINC "\n3 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (c:mklayr) (IF debug_remlt (PROGN (PRINC "\n4 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETVAR "osmode" old_remlt_osmodes) (COND (m-leader (SETQ my-m-leader m-leader subst-mleader m-leader )) (my-m-leader (SETQ m-leader my-m-leader subst-mleader m-leader )) ) (IF mltss (PROGN (SETQ mltss-cnt 0 mltss-txt 0 ) (WHILE (< mltss-cnt (SSLENGTH mltss)) (IF (WCMATCH (CDR (ASSOC 0 (ENTGET (SSNAME mltss mltss-cnt)))) "TEXT,MTEXT") (SETQ mltss-txt (1+ mltss-txt)) ) (SETQ mltss-cnt (1+ mltss-cnt)) ) ) ) (IF (EQ subst-mleader "1") (PROGN (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ")) (IF (AND mltss-txt (> mltss-txt 1)) (SETQ keep_breaks (ukword 1 "Yes No" "Do you want to maintain line breaks? [Yes/No] " (if keep_breaks keep_breaks "No"))) (SETQ keep_breaks "No") ) (PRINC "\nNote: If you are using REMLT on parcel data which has individual text of just numbers for Book and Page, seting the symbol bookpg = \"PAGE\" will prefix the numbers with \"BOOK \" and \"PAGE \"") (PRINC) (create-mleader) ) (create-text-leader) ) (SETVAR "osmode" old_remlt_osmodes) ;;; ) ;_ end of WHILE (c:rslayr) ;;; (COMMAND ".undo" "end") (SETQ *ERROR* old_remlt_error) (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN create-mleader () (SETQ oldfunname4 oldfunname3 oldfunname3 oldfunname2 oldfunname2 oldfunname1 oldfunname1 oldfunname0 oldfunname0 funname funname "create-mleader" ) (IF (OR (> sslen 0) (EQ delot "Add") ) ;_ end of OR (COND (T (IF C:MyMLdr NIL (LOAD "mymldr" "\nFile MyMLdr.lsp not loaded!") ) ;_ end of IF (SETQ cnt 0 mltss-len (SSLENGTH mltss) ;;; maxtxtwid NIL this-textbox NIL tnote-text-str NIL ) ;_ end of SETQ (WHILE (< cnt mltss-len) (IF (OR (AND (= (CDR (ASSOC 0 (ENTGET (SSNAME mltss cnt)))) "MTEXT") (OR (NOT this-fexp) (EQ this-fexp "")) ) (= (CDR (ASSOC 0 (ENTGET (SSNAME mltss cnt)))) "MULTILEADER") ) (PROGN (SETQ maxtxtwid (VLAX-GET-PROPERTY (VLAX-ENAME->VLA-OBJECT (SSNAME mltss cnt)) (IF (= (CDR (ASSOC 0 (ENTGET (SSNAME mltss cnt)))) "MULTILEADER") 'TextWidth 'Width ) ) ;_ end of vlax-get-property tnote-text-str (VLAX-GET-PROPERTY (VLAX-ENAME->VLA-OBJECT (SSNAME mltss cnt) ) ;_ end of vlax-ename->vla-object 'TextString ) ;_ end of vlax-get-property ) ;_ end of SETQ ) (IF (AND (= (CDR (ASSOC 0 (ENTGET (SSNAME mltss cnt)))) "MTEXT") this-fexp (/= this-fexp "") ) (PROGN (SETQ tnote-text-str this-fexp this-fexp NIL ) ) ) ) ;_ end of IF (IF (OR (= (CDR (ASSOC 0 (ENTGET (SSNAME mltss cnt)))) "ATTRIB") (= (CDR (ASSOC 0 (ENTGET (SSNAME mltss cnt)))) "TEXT") ) (PROGN (SETQ this-textbox (TEXTBOX (ENTGET (SSNAME mltss cnt))) maxtxtwid (MAX (IF maxtxtwid maxtxtwid 0 ) ;_ end of IF (/ (- (CAADR this-textbox) (CAAR this-textbox) ) ;_ end of - dimsc ) ;_ end of / ) ;_ end of MAX ) ;_ end of SETQ (IF (EQ keep_breaks "Yes") (PROGN (SETQ this-text-str (VLAX-GET-PROPERTY (VLAX-ENAME->VLA-OBJECT (SSNAME mltss cnt)) 'TextString ) ;_ end of vlax-get-property ) (IF (AND (OR (WCMATCH this-text-str "###")(WCMATCH this-text-str "####")) bookorpg ) (IF (EQ bookorpg "PAGE") (SETQ this-text-str (STRCAT "BOOK " this-text-str "\n") bookorpg "BOOK" ) (SETQ this-text-str (STRCAT "PAGE " this-text-str "\n") bookorpg "PAGE" ) ) (SETQ this-text-str (STRCAT this-text-str "\n")) ) ) (SETQ this-text-str NIL) ) ;;; (ALERT (IF this-text-str this-text-str "NO this-text-str")) (IF tnote-text-str (PROGN ;;; (ALERT tnote-text-str) (SETQ tnote-text-str (STRCAT tnote-text-str (IF (WCMATCH tnote-text-str "* ") "" " " ) ;_ end of IF (IF this-text-str this-text-str (VLAX-GET-PROPERTY (VLAX-ENAME->VLA-OBJECT (SSNAME mltss cnt)) 'TextString ) ;_ end of vlax-get-property ) ) ;_ end of STRCAT this-text-str NIL ) ;_ end of SETQ ) (PROGN (SETQ tnote-text-str (VLAX-GET-PROPERTY (VLAX-ENAME->VLA-OBJECT (SSNAME mltss cnt)) 'TextString ) ;_ end of vlax-get-property ) ;_ end of SETQ ;;; (ALERT tnote-text-str) ) ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (SETQ cnt (1+ cnt)) ) ;_ end of WHILE (SETQ cnt 0 sel-text-list NIL strwidlst NIL ) (WHILE (< cnt (SSLENGTH mltss)) (IF (AND (SSNAME mltss cnt)(SETQ seltxtent (ENTGET (SSNAME mltss cnt)))(EQ (CDR (ASSOC 0 seltxtent)) "TEXT")) (SETQ sel-text-list (APPEND sel-text-list (LIST (SSNAME mltss cnt)))) ) (SETQ cnt (1+ cnt)) ) (IF sel-text-list (PROGN (SETQ textboxlst (MAPCAR '(LAMBDA (x) (IF x (TEXTBOX (ENTGET x)))) sel-text-list)) (SETQ textwidlst (MAPCAR '(LAMBDA (x) (IF x (- (CAADR x)(CAAR x)))) textboxlst)) (FOREACH n textwidlst (IF n (SETQ strwidlst (APPEND strwidlst (LIST n))))) (SETQ maxtxtwid (IF strwidlst (EVAL (CONS 'MAX strwidlst)) 2.0 ) ) ) ) (IF c:mymldr NIL (LOAD "mymldr" "\nFile MYMLDR.LSP not loaded! ") ) ;_ end of IF (IF debug_remlt (PROGN (princ "\nREMLT: Start function (cons_text_str) ! ") (PRINC) ) ) (IF (wcmatch tnote-text-str "\\AcSm Data*") NIL (cons_text_str) ) (IF debug_remlt (PROGN (princ "\nREMLT: End function (cons_text_str) ! ") (PRINC) ) ) (SETQ from_remlt T) (c:mymldr) (C:Mltang) (SETQ from_remlt NIL) (IF (AND (EQ (CDR (ASSOC 0 (SETQ mltss-ent1 (ENTGET (SSNAME mltss 0))))) "TEXT") (WCMATCH (CDR (ASSOC 8 mltss-ent1)) "*|??????1*,??????1*") (EQUAL (CDR (ASSOC 51 mltss-ent1)) 0.261799 0.0001) ) (PROGN (SETQ from_exist_text T) (C:MTOGNEW) (SETQ from_exist_text NIL) ) ) (SETQ pt1 NIL) (SETQ nobj (VLAX-ENAME->VLA-OBJECT (ENTLAST))) (IF (= (VLAX-GET-PROPERTY nobj 'ObjectName) "AcDbMLeader") (PROGN (IF (AND the-cons-text (EQ (VLAX-GET-PROPERTY nobj 'TextString) "")) (VLAX-PUT-PROPERTY nobj 'TextString the-cons-text) ) (SETQ cnt 0 mltss-len (SSLENGTH mltss) ) ;_ end of setq (WHILE (< cnt mltss-len) (ENTDEL (SSNAME mltss cnt)) (SETQ cnt (1+ cnt)) ) ;_ end of WHILE ) ;_ end of PROGN ) ;_ end of if ) ) ;_ end of COND ) ;_ end of IF ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN create-text-leader () (SETQ oldfunname4 oldfunname3 oldfunname3 oldfunname2 oldfunname2 oldfunname1 oldfunname1 oldfunname0 oldfunname0 funname funname "create-text-leader" ) (vl-load-com) (IF (SETQ this-do_exist (vl-bb-ref 'bb-do_exist)) (SETQ do_exist this-do_exist exist-option "Yes") (SETQ do_exist NIL exist-option "No") ) (IF (AND (OR (> sslen 0) (EQ delot "Add") ) ;_ end of OR (SETQ upoint_msg (STRCAT "\nStart point of " (IF do_exist "Existing" "New" ) ;_ end of IF " leader, ptions " ) ;_ end of STRCAT ) (PRINC upoint_msg) (PRINC) (SETVAR "nomutt" 1) (OR (EQ (SETQ pt1 (upoint 1 "Options" upoint_msg nil nil ) ;_ end of GETPOINT ) ;_ end of SETQ "Options" ) ;_ end of EQ (EQ (TYPE pt1) 'LIST) ) ;_ end of OR (SETVAR "nomutt" 0) ) ;_ end of AND (COND ((EQ pt1 "Options") (SETVAR "nomutt" 0) (set-remlt-options) (SETQ remltopts "T") (IF (EQ subst-mleader "1") (create-mleader) (create-text-leader) )) (T (SETVAR "nomutt" 0) (SETQ pt1 (LIST (CAR pt1) (CADR pt1) 0.0)) (SETQ ldrpt_lst (LIST pt1)) (SETQ mp1 pt1) (SETQ leader_ss (SSADD)) (WHILE (SETQ mp2 (upoint 0 "Existing New" (STRCAT "Next " (IF do_exist "Existing" "New" ) ;_ end of IF " leader point or toggle xisting/ew" ) ;_ end of STRCAT nil mp1 ) ;_ end of upoint ) ;_ end of SETQ (gvpno) (COND ((> viewno 9) (SETQ prod (STRCAT "VI" (ITOA viewno))) ) ((> viewno 0) (SETQ prod (STRCAT "VI0" (ITOA viewno))) ) ) ;_ end of COND (IF (OR (EQ mp2 "Existing") (EQ mp2 "New")) (COND ((EQ mp2 "Existing") (SETQ do_exist T) (IF (AND (EQ colr_over "1") tnote_txtc) (SETQ txcolr tnote_txtc) (set_txt_colr thts) ;(SETQ colr "7") ) (SETQ colr txcolr) ;;; (princ "\n") ;;; (princ lncolr) ;;; (princ "\n") ;;; (princ txcolr) (IF debug_remlt (PROGN (PRINC "\n5 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (c:mklayr) (IF debug_remlt (PROGN (PRINC "\n6 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of progn ) ;_ end of IF ) ((EQ mp2 "New") (SETQ do_exist NIL) (IF (AND (EQ colr_over "1") tnote_txtc) (SETQ txcolr tnote_txtc) (set_txt_colr thts) ;(SETQ colr "2") ) (SETQ colr txcolr) ;;; (princ "\n") ;;; (princ lncolr) ;;; (princ "\n") ;;; (princ txcolr) (IF debug_remlt (PROGN (PRINC "\n7 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (c:mklayr) (IF debug_remlt (PROGN (PRINC "\n8 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ) ;_ end of COND (PROGN (SETVAR "osmode" 0) (SETQ mp2 (LIST (CAR mp2) (CADR mp2) 0.0)) (COMMAND ".line" mp1 mp2 "") (SETQ leader_ss (SSADD (ENTLAST) leader_ss)) (SETQ ldrpt_lst (APPEND ldrpt_lst (LIST mp2))) (SETQ mpn mp1 mp1 mp2 llan (ANGLE mpn mp1) ;This is the test for vtest0 (- (* PI 2) (GETVAR "VIEWTWIST")) ;lefthand or righthand ) ;_ end of SETQ (IF ;leaders and determines (< (COS (ABS (- llan vtest0))) 0) ;which side the text goes on (SETQ tjst "mr" tang (- PI (GETVAR "VIEWTWIST")) ) ;_ end of SETQ (SETQ tjst "ml" tang (- 0 (GETVAR "VIEWTWIST")) ) ;_ end of SETQ ) ;_ end of IF (SETQ mpsp (POLAR mp1 tang (* (GETVAR "dimexe") dimsc))) (SETQ tan2 (- (* PI 1.5) (GETVAR "VIEWTWIST")) mp3 (POLAR mpsp tang dis3) mp3 (LIST (CAR mp3) (CADR mp3) 0) mp4 (POLAR mp3 tan2 dis2) mp5 (POLAR mp4 tan2 dis2) mp6 (POLAR mp5 tan2 dis2) mp7 (POLAR mp6 tan2 dis2) mp8 (POLAR mp7 tan2 dis2) mp9 (POLAR mp8 tan2 dis2) mp10 (POLAR mp9 tan2 dis2) mp11 (POLAR mp10 tan2 dis2) mp12 (POLAR mp11 tan2 dis2) tang_d (* (/ (- 0 (GETVAR "viewtwist")) PI) 180) ) ;_ end of SETQ (IF (= numb 0) (PROGN (SETQ mpl mp2 numb 1 ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of WHILE (SETQ ang1 (+ (ANGLE pt1 mpl) (* 0.055555 PI)) ang2 (- (ANGLE pt1 mpl) (* 0.055555 PI)) spt2 (POLAR pt1 ang1 dis1) spt3 (POLAR pt1 ang2 dis1) inss1 (* (/ txtht (* dimsc 0.110)) dimsc) ) ;_ end of SETQ (IF mjrg nil (SETQ mjrg "G") ) ;_ end of if (IF prod nil (SETQ prod "DETL") ) ;_ end of if (cons_text_str) (SETQ cmud_color 256) (IF (AND (EQ colr_over "1") tnote_txtc) (SETQ txcolr tnote_txtc) (set_txt_colr thts) ) (SETQ colr txcolr) (IF debug_remlt (PROGN (PRINC "\n09 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (c:mklayr) (IF debug_remlt (PROGN (PRINC "\n10 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (IF ntxtstr NIL (LOAD "ntxtstr" "\nSupporting subroutine NTXTSTR.LSP not loaded! " ) ;_ end of LOAD ) ;_ end of IF (SETQ ss (SSADD)) (SETQ etins NIL) (IF ntx1 (PROGN (COMMAND ".text" "j" tjst mp3 dis1 tang_d ntx1) (SETQ ent1 (ENTLAST) ss (SSADD) etins (CDR (ASSOC 10 (ENTGET (ENTLAST)))) ) ;_ end of SETQ (SSADD ent1 ss) ) ;_ end of PROGN ) ;_ end of IF (PROGN ;;; (ntxtstr ntx1 prev_ntx1 mp3) (ntxtstr ntx2 prev_ntx2 mp4) (ntxtstr ntx3 prev_ntx3 mp5) (ntxtstr ntx4 prev_ntx4 mp6) (ntxtstr ntx5 prev_ntx5 mp7) (ntxtstr ntx6 prev_ntx6 mp8) (ntxtstr ntx7 prev_ntx7 mp9) (ntxtstr ntx8 prev_ntx8 mp10) (ntxtstr ntx9 prev_ntx9 mp11) (ntxtstr ntx10 prev_ntx10 mp12) ) ;_ end of PROGN (IF lncolr (SETQ colr lncolr) (SETQ lncolr "1" colr lncolr ) ;_ end of SETQ ) ;_ end of IF (IF do_cmud nil (PROGN (IF debug_remlt (PROGN (PRINC "\n11 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (c:mklayr) (IF debug_remlt (PROGN (PRINC "\n12 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (IF (EQ ntx2 "") ;What is this for? nil (PROGN ) ;_ end of PROGN ) ;_ end of IF (IF debug_remlt (SETQ tj71 0 tj72 2 tj73 0 tj10 etins tj11 etins cntr 0 tsln (SSLENGTH ss) ) ;_ end of SETQ (SETQ tj71 2 tj72 2 tj73 0 tj10 etins tj11 (LIST 0.0 0.0 (* dimsc 1002)) cntr 0 tsln (SSLENGTH ss) ) ;_ end of SETQ ) ;_ end of if (IF (EQ (CADDR (GETVAR "VIEWDIR")) -1) (SETQ tj71 2 tj72 2 ) ;_ end of SETQ (SETQ tj71 0 tj72 0 ) ;_ end of SETQ ) ;_ end of IF (IF (AND ss do_exist (NOT do_cmud)) (SETQ txtoa (* (/ 15 180.0000) PI)) (SETQ txtoa 0) ) ;_ end of IF (IF (AND do_right_just (WCMATCH (STRCASE do_right_just) "YES")) NIL (WHILE (IF (AND (< cntr tsln) ss) (SETQ tent (ENTGET (SSNAME ss cntr))) ) ;if (PROGN (SETQ edtw (ENTGET (CDAR tent))) (IF (EQ (CDR (ASSOC 0 edtw)) "TEXT") (PROGN (SETQ ent71 (CDR (ASSOC 71 edtw)) ent72 (CDR (ASSOC 72 edtw)) ent73 (CDR (ASSOC 73 edtw)) ent10 (CDR (ASSOC 10 edtw)) ent1z 0.0 ;(* dimsc 1002) ) ;_ end of SETQ (SETQ edtw (SUBST (CONS 71 tj71) (ASSOC 71 edtw) edtw) ) ;_ end of SETQ (SETQ edtw (SUBST (CONS 72 tj72) (ASSOC 72 edtw) edtw) ) ;_ end of SETQ (SETQ edtw (SUBST (CONS 73 tj73) (ASSOC 73 edtw) edtw) ) ;_ end of SETQ (IF (EQ (CADDR (GETVAR "VIEWDIR")) -1) (SETQ edtw (SUBST (CONS 11 ent10) (ASSOC 11 edtw) edtw) ) ;_ end of SETQ (SETQ edtw (SUBST (CONS 11 (LIST 0.0 0.0 ent1z)) (ASSOC 11 edtw) edtw ) ;_ end of SUBST ) ;_ end of SETQ ) ;_ end of IF (SETQ edtw (SUBST (CONS 51 txtoa) (ASSOC 51 edtw) edtw ) ;_ end of subst ) ;_ end of setq (SETQ tj10x (INTERS (LIST (CAR ent10) (CADR ent10)) (POLAR ent10 (+ tang PI) 10) etins (POLAR etins (+ tang (/ PI 2)) 10) nil ) ;_ end of INTERS edtw (SUBST (CONS 10 tj10x) (ASSOC 10 edtw) edtw) ) ;_ end of SETQ (ENTMOD edtw) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN (SETQ cntr (1+ cntr)) ) ;_ end of WHILE ) ;_ end of IF (IF (OR (EQ delot "Move") (EQ delot "Add")) (PROGN (IF mltss (SETQ mltss_len (SSLENGTH mltss)) (SETQ mltss_len 0) ) ;_ end of IF (SETQ count 0) (WHILE (< count mltss_len) (IF (EQ (CDR (ASSOC 0 (ENTGET (SSNAME mltss count)))) "INSERT" ) ;_ end of EQ (IF (>= (CDR (ASSOC 70 (TBLSEARCH "block" (CDR (ASSOC 2 (ENTGET (SSNAME mltss count))) ) ;_ end of CDR ) ;_ end of TBLSEARCH ) ;_ end of ASSOC ) ;_ end of CDR 4 ) ;_ end of >= (SSDEL (SSNAME mltss count) mltss) ) ;_ end of IF ) ;_ end of IF (SETQ count (1+ count)) ) ;_ end of WHILE (COMMAND ".erase" mltss "") ) ;_ end of PROGN ) ;if (SETQ numb 0) (SETQ ntx1 nil ntx2 nil ntx3 nil ntx4 nil ntx5 nil ntx6 nil ntx7 nil ntx8 nil ntx9 nil ntx10 nil ) ;_ end of SETQ ;;; (c:rslayr) (SETQ ss_cnt 0) (SETQ max_strlen nil max_oboffset 0 ) ;_ end of SETQ (WHILE (< ss_cnt (SSLENGTH ss)) (IF debug_remlt (PROGN (PRINC "\nText=") (PRINC (CDR (ASSOC 1 (ENTGET (SSNAME ss ss_cnt))))) (PRINC (STRCAT "\nmax_strlen (" (ITOA ss_cnt) ")=")) (PRINC max_strlen) (PRINC "\n(+(CAAR(TEXTBOX (ENTGET (SSNAME ss ss_cnt))))(CAADR (TEXTBOX (ENTGET (SSNAME ss ss_cnt)))))=" ) ;_ end of PRINC (PRINC (+ (CAAR (TEXTBOX (ENTGET (SSNAME ss ss_cnt)))) (CAADR (TEXTBOX (ENTGET (SSNAME ss ss_cnt)))) ) ;_ end of + ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETQ text_edef (ENTGET (SSNAME ss ss_cnt))) (SETQ max_strlen (IF (AND max_strlen (EQ (TYPE max_strlen) 'REAL)) (MAX max_strlen (+ (CAAR (TEXTBOX text_edef)) (CAADR (TEXTBOX text_edef)) max_oboffset ) ;_ end of + ) ;_ end of MAX (+ (CAAR (TEXTBOX text_edef)) (CAADR (TEXTBOX text_edef)) max_oboffset ) ;_ end of + ) ;_ end of IF max_oboffset (IF (AND max_oboffset (EQ (TYPE max_oboffset) 'REAL)) (MAX max_oboffset (CAAR (TEXTBOX text_edef)) ) ;_ end of MAX (CAAR (TEXTBOX text_edef)) ) ;_ end of IF ) ;_ end of SETQ (SETQ ss_cnt (1+ ss_cnt)) ) ;_ end of WHILE (IF (<= (SSLENGTH ss) 0) NIL (SETQ last_len (+ (CAAR (TEXTBOX (ENTGET (SSNAME ss (1- (SSLENGTH ss)))))) (CAADR (TEXTBOX (ENTGET (SSNAME ss (1- (SSLENGTH ss)))))) (CAAR (TEXTBOX (ENTGET (SSNAME ss (1- (SSLENGTH ss)))))) ) ;_ end of + ) ;_ end of SETQ ) (SETQ TEXTHEIGHT dis1) (IF (EQ tjst "mr") (PROGN (SETQ INT_OBJSNAP (GETVAR "OSMODE")) (SETVAR "OSMODE" 0) (IF debug_remlt (PROGN (PRINC "\nSSLENGTH=") (PRINC (SSLENGTH ss)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETQ move_pt1 (GETVAR "LASTPOINT") move_pt2 (IF (> (SSLENGTH ss) 1) (POLAR (POLAR (GETVAR "LASTPOINT") (+ (- 0 (GETVAR "VIEWTWIST")) (/ PI 2)) (IF (EQ t-leader "1") (* dis2 (- (/ (SSLENGTH ss) 2.0) 0.5)) (* dis2 (- (SSLENGTH ss) 1.00)) ) ;_ end of IF ) ;_ end of POLAR (- 0 (GETVAR "VIEWTWIST") PI) (IF (EQ t-leader "1") (+ (* 1.85 TEXTHEIGHT) (* (GETVAR "DIMEXE") dimsc) ) ;_ end of + max_oboffset ;(* 2.25 TEXTHEIGHT)) ) ;_ end of IF ) ;_ end of POLAR (GETVAR "LASTPOINT") ) ;_ end of IF ) ;_ end of SETQ (IF debug_remlt (PROGN (PRINC "\nt-leader=") (PRINC t-leader) (PRINC "\n(SSLENGTH ss)=") (PRINC (SSLENGTH ss)) (COMMAND "-color" 6) (COMMAND ".CIRCLE" mp1 (* (+ 0.225 (GETVAR "DIMEXE")) dimsc) ) ;_ end of COMMAND (COMMAND "-color" 7) (COMMAND ".CIRCLE" (GETVAR "LASTPOINT") (* (+ 0.225 (GETVAR "DIMEXE")) dimsc) ) ;_ end of COMMAND (COMMAND ".line" move_pt1 move_pt2 "") (COMMAND "-color" "BYLAYER") (PRINC) ) ;_ end of PROGN ) ;_ end of IF (COMMAND ".move" ss "" move_pt1 move_pt2 "") (SETVAR "OSMODE" INT_OBJSNAP) (IF (AND (EQ t-leader "1") (> (SSLENGTH ss) 1)) (SETQ last_ldrpt (POLAR (LAST ldrpt_lst) (+ (- 0 (GETVAR "VIEWTWIST")) PI) (+ (* 2.25 TEXTHEIGHT) (* (GETVAR "DIMEXE") dimsc)) ) ;_ end of POLAR ) ;_ end of SETQ (IF (> max_strlen last_len) (SETQ last_ldrpt (POLAR (LAST ldrpt_lst) (+ (- 0 (GETVAR "VIEWTWIST")) PI) (- max_strlen last_len) ) ;_ end of POLAR ) ;_ end of SETQ (SETQ last_ldrpt NIL) ) ;_ end of IF ) ;_ end of IF (IF last_ldrpt (PROGN (SETQ ldrpt_lst (APPEND ldrpt_lst (LIST last_ldrpt))) (IF debug_remlt (PROGN (PRINC "\nLast leader point added to leader point list. " ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN (IF debug_remlt (PROGN (PRINC "\nLast leader point NOT added to leader point list. " ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of IF ) ;_ end of progn (IF (AND (EQ t-leader "1") (> (SSLENGTH ss) 1)) (PROGN (SETQ INT_OBJSNAP (GETVAR "OSMODE")) (SETVAR "OSMODE" 0) (COMMAND ".move" ss "" (GETVAR "LASTPOINT") (POLAR (POLAR (GETVAR "LASTPOINT") (+ (- 0 (GETVAR "VIEWTWIST")) (/ PI 2)) (* dis2 (- (/ (SSLENGTH ss) 2.0) 0.5)) ) ;_ end of POLAR (- 0 (GETVAR "VIEWTWIST")) (* 2.25 TEXTHEIGHT) ; dimsc) ) ;_ end of POLAR ) ;_ end of COMMAND (SETVAR "OSMODE" INT_OBJSNAP) (SETQ last_ldrpt (POLAR (LAST ldrpt_lst) (- 0 (GETVAR "VIEWTWIST")) (+ (* 2.25 TEXTHEIGHT) (* (GETVAR "DIMEXE") dimsc)) ) ;_ end of POLAR ) ;_ end of SETQ (SETQ ldrpt_lst (APPEND ldrpt_lst (LIST last_ldrpt))) ) ;_ end of progn ) ;_ end of IF ) ;_ end of IF (SETQ assoc10_lst nil) (FOREACH n ldrpt_lst (IF assoc10_lst (SETQ assoc10_lst (APPEND assoc10_lst (LIST (CONS 10 (LIST (CAR n)(CADR n) 0.0))))) (SETQ assoc10_lst (LIST (CONS 10 (LIST (CAR n)(CADR n) 0.0)))) ) ;_ end of if ) ;_ end of foreach (IF (AND (<= (DISTANCE (CDR (LAST assoc10_lst)) (CDADR (REVERSE assoc10_lst)) ) ;_ end of DISTANCE (* dimsc 0.125) ) ;_ end of <= ) ;(WCMATCH(GETVAR"ACADVER")"14*") (SETQ assoc10_lst (REVERSE (CDR (REVERSE assoc10_lst)))) ) ;_ end of IF (IF (AND (EQ t-leader "1") (> (SSLENGTH ss) 1)) NIL (SETQ assoc10_lst (APPEND assoc10_lst (LIST (CONS 10 (POLAR (CDR (NTH (1- (LENGTH assoc10_lst)) assoc10_lst) ) ;_ end of cdr tang (* (GETVAR "dimexe") dimsc) ) ;_ end of polar ) ;_ end of cons ) ;_ end of list ) ;_ end of append ) ;_ end of setq ) ;_ end of IF (IF lncolr (SETQ colr lncolr) (SETQ lncolr "1" colr lncolr ) ;_ end of SETQ ) ;_ end of IF (SETQ llt "-" ltyp "continuous" ) ;_ end of SETQ (IF debug_remlt (PROGN (PRINC "\n13 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF ;;; (PRINC "\nCMDACTIVE") ;;; (PRINC (GETVAR "CMDACTIVE")) ;;; (PRINC "\nCMDNAMES") ;;; (PRINC (GETVAR "CMDNAMES")) (c:mklayr) (IF debug_remlt (PROGN (PRINC "\n14 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (IF dis1 (COND ((>= dis1 0.09) (SETQ dimstylename "ARCHLEADER") (IF (TBLSEARCH "DIMSTYLE" dimstylename) NIL (PROGN (IF c:archldrs NIL (LOAD "archldrs") ) ;_ end of IF (IF c:archldrs (C:ARCHLDRS) ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ((< dis1 0.09) (SETQ dimstylename "HARCHLEADER") (IF (TBLSEARCH "DIMSTYLE" dimstylename) NIL (PROGN (IF c:harchldrs NIL (LOAD "harchldrs") ) ;_ end of IF (IF c:harchldrs (C:HARCHLDRS) ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ) ;_ end of COND (SETQ dimstylename NIL) ) ;_ end of IF (c:mklayr) (IF (TBLSEARCH "DIMSTYLE" dimstylename) (SETQ ldrent_lst1 (LIST (CONS 0 "LEADER") (CONS 3 dimstylename) (CONS 100 "AcDbEntity") (IF (OR (EQ (GETVAR "tilemode") 1) (> (GETVAR "cvport") 1)) (CONS 67 0) (CONS 67 1) ) ;_ end of if (CONS 8 new_ln) (CONS 100 "AcDbLeader") (IF (EQ (STRCASE arohed) "NO") (CONS 71 0) (CONS 71 1) ) ;_ end of if (CONS 72 0) (CONS 73 3) (CONS 75 0) (CONS 76 (LENGTH ldrpt_lst)) ) ;_ end of list ) ;_ end of setq (SETQ ldrent_lst1 (LIST (CONS 0 "LEADER") (CONS 100 "AcDbEntity") (IF (OR (EQ (GETVAR "tilemode") 1) (> (GETVAR "cvport") 1)) (CONS 67 0) (CONS 67 1) ) ;_ end of if (CONS 8 new_ln) (CONS 100 "AcDbLeader") (CONS 3 "STANDARD") (IF (EQ (STRCASE arohed) "NO") (CONS 71 0) (CONS 71 1) ) ;_ end of if (CONS 72 0) (CONS 73 3) (CONS 75 0) (CONS 76 (LENGTH ldrpt_lst)) ) ;_ end of list ) ;_ end of setq ) ;_ end of IF (SETQ ldrent_lst2 (LIST (CONS 77 (ATOI lncolr)) (CONS 210 (LIST 0.0 0.0 1.0)) (IF (EQ tjst "mr") (CONS 211 (LIST (COS (+ tang PI)) (SIN (+ tang PI)) 0.0)) (CONS 211 (LIST (COS tang) (SIN tang) 0.0)) ) ;_ end of if (CONS 212 (LIST 0.0 0.0 0.0)) (CONS 213 (LIST 0.0 0.0 0.0)) ) ;_ end of list ) ;_ end of setq (IF ignore_ucs (PROGN (SETQ assoc10_lst (MAPCAR '(LAMBDA (x) (CONS 10 (TRANS (CDR x) 1 0))) assoc10_lst)) (SETQ ldrent_lst2 (SUBST (CONS 211 (LIST (CADR (ASSOC 211 ldrent_lst2))0.0 (CADDDR (ASSOC 211 ldrent_lst2))))(ASSOC 211 ldrent_lst2)ldrent_lst2)) ) ) (SETQ ldrent_lst (APPEND ldrent_lst1 assoc10_lst ldrent_lst2)) (IF (AND leader_ss (>= (SSLENGTH leader_ss) 1)) (COMMAND ".ERASE" leader_ss "") ) (IF (AND (EQ colr_over "1") tnote_txtc) (SETQ txcolr tnote_txtc) (set_txt_colr thts) ) (ENTMAKE ldrent_lst) (IF (AND (EQ t-leader "1") (> (SSLENGTH ss) 1)) (ENTMAKE (LIST (CONS 0 "LINE") (CONS 8 new_ln) (CONS 10 (POLAR last_ldrpt (+ (- 0 (GETVAR "VIEWTWIST")) (* PI 0.5)) (- (* dis2 (/ (SSLENGTH ss) 2.0)) (/ dis3 2.0)) ) ;_ end of POLAR ) ;_ end of CONS (CONS 11 (POLAR last_ldrpt (+ (- 0 (GETVAR "VIEWTWIST")) (* PI 1.5)) (- (* dis2 (/ (SSLENGTH ss) 2.0)) (/ dis3 2.0)) ) ;_ end of POLAR ) ;_ end of CONS ) ;_ end of LIST ) ;_ end of ENTMAKE ) ;_ end of IF ;;; (IF (AND ss do_exist (NOT do_cmud)) ;;; (PROGN ;;; (SETQ txtoa (* (/ 15 180.0000) PI)) ;;; (SETQ tsln (SSLENGTH ss)) ;;; (SETQ cntr 0) ;;; (WHILE ;;; (IF (AND (< cntr tsln) ss) ;;; (SETQ tent (ENTGET (SSNAME ss cntr))) ;;; ) ;if ;;; (PROGN ;;; (SETQ edtw (ENTGET (CDAR tent))) ;;; (IF (EQ (CDR (ASSOC 0 edtw)) "TEXT") ;;; (PROGN ;;; (SETQ edtw ;;; (SUBST (CONS 51 txtoa) ;;; (ASSOC 51 edtw) ;;; edtw ;;; ) ;_ end of subst ;;; ) ;_ end of setq ;;; (ENTMOD edtw) ;;; ) ;_ end of progn ;;; ) ;_ end of if ;;; (SETQ cntr (1+ cntr)) ;;; ) ;_ end of progn ;;; ) ;_ end of while ;;; ) ;_ end of progn ;;; ) ;_ end of if ) ;_ end of PROGN ) ;_ end of COND (SETQ pt1 nil) ) ;_ end of IF ) ;;;**************************************************************************** (DEFUN set-remlt-options ( / mltstyle-lst kwrd-str) (SETQ oldfunname4 oldfunname3 oldfunname3 oldfunname2 oldfunname2 oldfunname1 oldfunname1 oldfunname0 oldfunname0 funname funname "set-remlt-options" ) (SETQ pt1 NIL) (GVPNO) (COND ((> viewno 9) (SETQ prod (STRCAT "VI" (ITOA viewno))) ) ((> viewno 0) (SETQ prod (STRCAT "VI0" (ITOA viewno))) ) ) ;_ end of COND (SETQ delot (ukword 1 "Move Copy Add" "[Move/Copy, or/Add text below] existing Northing & Easting label? " (IF delot delot "Move" ) ;_ end of if ) ;_ end of ukword ) ;_ end of setq (IF (EQ delot "Add") (SETQ coord_prec (uint 1 "" "Decimal precision for coordinates:" (IF coord_prec coord_prec 2 ) ;_ end of IF ) ;_ end of uint ) ;_ end of SETQ ) ;_ end of IF (IF txtsize NIL (LOAD "txtsize" "\nFile TXTSIZE.LSP not loaded! ")) (txtsize nil) (IF (AND (EQ colr_over "1") tnote_txtc tnote_ldrc) (SETQ txtcolrint (uint 1 "" "Override text color" (ATOI tnote_txtc)) ldrcolrint (uint 1 "" "Override leader color" (ATOI tnote_ldrc)) txcolr (ITOA txtcolrint) lncolr (ITOA ldrcolrint) ) ;_ end of SETQ (SETQ txcolr "6" lncolr "1" ) ;_ end of SETQ ) ;_ end of IF (IF txcolr (SETQ colr txcolr) (SETQ txcolr "6" colr txcolr ) ;_ end of SETQ ) ;_ end of IF (IF debug_remlt (PROGN (PRINC "\n1 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (c:mklayr) (IF debug_remlt (PROGN (PRINC "\n2 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETQ do_right_just ;"No" (STRCASE (ukword 1 "Yes No" "Right Justify? [Yes/No] " (IF do_right_just do_right_just "No" ) ;_ end of if ) ;_ end of ukword ) ;_ end of STRCASE ) ;_ end of SETQ (SETQ arohed ;"Yes" (STRCASE (ukword 1 "Yes No" "With arrowhead? [Yes/No] " (IF arohed arohed "Yes" ) ;_ end of if ) ;_ end of ukword ) ;_ end of STRCASE ) ;_ end of SETQ (SETQ m-ldropt (STRCASE (ukword 1 "Yes No" "With M-Leader? [Yes/No] " (IF m-ldropt m-ldropt "Yes" ) ;_ end of if ) ;_ end of ukword ) ;_ end of STRCASE ) ;_ end of SETQ (IF (WCMATCH (STRCASE m-ldropt) "YES") (PROGN (SETQ t-ldropt "No") (IF (SETQ dict (DICTSEARCH (NAMEDOBJDICT) "ACAD_MLEADERSTYLE")) ;Checks to see if MLeaderStyle exists (PROGN (SETQ mltstyle-lst NIL) (FOREACH x dict (IF (= (CAR x) 3) (IF (MEMBER (CDR x) mltstyle-lst) NIL (SETQ mltstyle-lst (APPEND mltstyle-lst (LIST (CDR x)))) ) ;_ end of IF ) ;_ end of if ) ;_ end of foreach ) ;_ end of PROGN ) ;_ end of if (IF mltstyle-lst (PROGN (SETQ kwrd-str (EVAL (CONS 'STRCAT (MAPCAR '(LAMBDA (x) (COND ((EQ x (LAST mltstyle-lst)) x) (T (STRCAT x " ")) ) ;_ end of COND ) ;_ end of LAMBDA mltstyle-lst ) ;_ end of MAPCAR ) ;_ end of CONS ) ;_ end of EVAL ) ;_ end of SETQ ) ) (SETQ exist_option (ukword 1 "Yes No" "Existing? [Yes/No] " (IF do_exist "Yes" "No" ) ;_ end of if ) ;_ end of ukword ) ;_ end of SETQ (IF (AND (EQ exist_option "Yes") kwrd-str (WCMATCH kwrd-str "*RomanSOB*") ) (SETVAR "cmleaderstyle" "RomanSOB") (IF (AND kwrd-str (> (STRLEN kwrd-str) 1)) (PROGN (IF ukword nil (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ") ) ;_ end of if (SETQ kwrd-opts-str (STRCAT "[" (EVAL (CONS 'STRCAT (MAPCAR '(LAMBDA (x) (IF (/= x (LAST (DOS_STRTOKENS kwrd-str " "))) (STRCAT x "/") x)) (DOS_STRTOKENS kwrd-str " ")))) "]")) (SETVAR "cmleaderstyle" (ukword 1 kwrd-str (STRCAT "Specify Multileader Style [" kwrd-opts-str "]") "Standard" ) ;_ end of ukword ) ;_ end of SETVAR ) ;_ end of PROGN ) ;_ end of IF ) ) ;_ end of PROGN (SETQ t-ldropt ;"Yes" (STRCASE (ukword 1 "Yes No" "With T-Leader? [Yes/No]" (IF t-ldropt t-ldropt "Yes" ) ;_ end of if ) ;_ end of ukword ) ;_ end of STRCASE ) ;_ end of SETQ ) ;_ end of IF (VL-LOAD-COM) (COND ((EQ exist_option "Yes") (SETQ do_exist T) (VL-BB-SET 'bb-do_exist do_exist) ) ((EQ exist_option "No") (SETQ do_exist NIL) (VL-BB-SET 'bb-do_exist do_exist) ) (do_exist (SETQ exist_option "Yes") (VL-BB-SET 'bb-do_exist do_exist) ) (T (SETQ do_exist NIL exist_option "No" ) ;_ end of SETQ (VL-BB-SET 'bb-do_exist do_exist) ) ) ;_ end of COND (COND ((WCMATCH (STRCASE m-ldropt) "YES") (SETQ m-leader "1" subst-mleader "1" my-m-leader "1" ) ;_ end of SETQ ) ((WCMATCH (STRCASE m-ldropt) "NO") (SETQ m-leader "0" subst-mleader "0" my-m-leader "0" ) ;_ end of SETQ ) (T (SETQ m-leader NIL subst-mleader NIL my-m-leader NIL ) ;_ end of SETQ ) ) ;_ end of COND (COND ((WCMATCH (STRCASE t-ldropt) "NO") (SETQ t-leader "0" my-t-leader "0" ) ;_ end of SETQ ) ((WCMATCH (STRCASE t-ldropt) "YES") (SETQ t-leader "1" my-t-leader "1" ) ;_ end of SETQ ) (T (SETQ t-leader NIL my-t-leader NIL ) ;_ end of SETQ ) ) ;_ end of COND ) ;_ end of DEFUN ;;;**************************************************************************** (defun cons_text_str () ;;; (IF (AND mltss sslen count (NOT (EQ count sslen))) ;;; (SETQ maxtxtwid NIL) ;;; ) (SETQ oldfunname4 oldfunname3 oldfunname3 oldfunname2 oldfunname2 oldfunname1 oldfunname1 oldfunname0 oldfunname0 funname funname "cons_text_str" ) (SETQ the-cons-text "") (WHILE (AND mltss sslen count (NOT (EQ count sslen))) (COND ((EQ (CDR (ASSOC 0 (ENTGET (SSNAME mltss count)))) "TEXT") (PROGN (SETQ this_str (CDR (ASSOC 1 (ENTGET (SSNAME mltss count)))) the-cons-text (IF (AND the-cons-text (/= the-cons-text "")) (STRCAT the-cons-text " " this_str) this_str ) ) (SET (READ (STRCAT "ntx" (ITOA (1+ txt_count)))) this_str ) ;_ end of set (SETQ this-textbox (TEXTBOX (ENTGET (SSNAME mltss count))) maxtxtwid (MAX (IF maxtxtwid maxtxtwid 0 ) ;_ end of IF ;;; (/ (- (CAADR this-textbox) (CAAR this-textbox) ) ;_ end of - ;;; dimsc ;;; ) ;_ end of / ) ;_ end of MAX ) ;_ end of SETQ (SETQ txt_count (1+ txt_count)) ) ;_ end of PROGN ) ((OR (EQ (CDR (ASSOC 0 (ENTGET (SSNAME mltss count)))) "MTEXT") (EQ (CDR (ASSOC 0 (ENTGET (SSNAME mltss count)))) "MULTILEADER") ) (PROGN ;;; (IF (EQ (CDR (ASSOC 0 (ENTGET (SSNAME mltss count)))) "MTEXT") (SETQ maxtxtwid (VLAX-GET-PROPERTY (VLAX-ENAME->VLA-OBJECT (SSNAME mltss count)) (IF (= (CDR (ASSOC 0 (ENTGET (SSNAME mltss count)))) "MULTILEADER") 'TextWidth 'Width ) ) ;_ end of vlax-get-property mtext_str (VLAX-GET-PROPERTY (VLAX-ENAME->VLA-OBJECT (SSNAME mltss count) ) ;_ end of vlax-ename->vla-object 'TextString ) ;_ end of vlax-get-property ) (SETQ the-cons-text (IF (AND the-cons-text (/= the-cons-text "")) (STRCAT the-cons-text " " mtext_str) mtext_str ) ) ;;; (SETQ mtext_str ;;; (STRCAT ;;; (IF (ASSOC 3 (ENTGET (SSNAME mltss count))) ;;; (CDR (ASSOC 3 (ENTGET (SSNAME mltss count)))) ;;; "" ;;; ) ;_ end of IF ;;; (CDR (ASSOC 1 (ENTGET (SSNAME mltss count)))) ;;; ) ;_ end of STRCAT ;;; ) ;_ end of SETQ ;;; (SETQ mtext_str (CDR (ASSOC 304 (ENTGET (SSNAME mltss count))))) ;;; ) (IF (WCMATCH mtext_str "*\P*") (PROGN (SETQ mtext_cnt 1) (WHILE (AND (< mtext_cnt (STRLEN mtext_str)) (WCMATCH mtext_str "*\\P*") ) ;_ end of AND (IF (WCMATCH (SUBSTR mtext_str mtext_cnt 2) "\\P") (PROGN (SETQ mtext_lst (APPEND mtext_lst (LIST (SUBSTR mtext_str 1 (1- mtext_cnt) ) ;_ end of SUBSTR ) ;_ end of LIST ) ;_ end of APPEND ) ;_ end of SETQ (SETQ mtext_str (SUBSTR mtext_str (+ mtext_cnt 2) ) ;_ end of SUBSTR ) ;_ end of SETQ (SETQ mtext_cnt 1) ) ;_ end of PROGN ) ;_ end of IF (SETQ mtext_cnt (1+ mtext_cnt)) ) ;_ end of WHILE (SETQ mtext_lst (APPEND mtext_lst (LIST mtext_str)) ) ;_ end of SETQ (SETQ mtext_cnt 1) (FOREACH n mtext_lst (WHILE (AND (< mtext_cnt (STRLEN n)) (WCMATCH n "*\\[OLCHSTQWA]*;*") ) ;REMOVES SPECIAL FORMATTING (IF (WCMATCH (SUBSTR n mtext_cnt 2) "\\[OLCHSTQWA]" ) ;_ end of WCMATCH (PROGN (SETQ mtext_cnt2 mtext_cnt) (WHILE (NOT (WCMATCH (SUBSTR n mtext_cnt2 1) ";") ) ;_ end of NOT (SETQ mtext_cnt2 (1+ mtext_cnt2)) ) ;_ end of WHILE (SETQ n (STRCAT (SUBSTR n 1 (1- mtext_cnt)) (SUBSTR n (1+ mtext_cnt2)) ) ;_ end of STRCAT ) ;_ end of SETQ (SETQ mtext_cnt 1) ) ;_ end of PROGN ) ;_ end of IF (SETQ mtext_cnt (1+ mtext_cnt)) ) ;_ end of WHILE (SETQ mtext_cnt 1) (WHILE (AND (< mtext_cnt (STRLEN n)) (WCMATCH n "*{\\F*;*") ) ;REMOVES FONT FORMATTING (IF (WCMATCH (SUBSTR n mtext_cnt 3) "{\\F") (PROGN (SETQ mtext_cnt2 mtext_cnt) (WHILE (NOT (WCMATCH (SUBSTR n mtext_cnt2 1) ";") ) ;_ end of NOT (SETQ mtext_cnt2 (1+ mtext_cnt2)) ) ;_ end of WHILE (SETQ n (STRCAT (SUBSTR n 1 (1- mtext_cnt)) (SUBSTR n (1+ mtext_cnt2)) ) ;_ end of STRCAT ) ;_ end of SETQ (SETQ mtext_cnt2 1) ;;; (PRINC "\nn=") ;;; (PRINC n) (WHILE (AND (<= mtext_cnt2 (STRLEN n)) (WCMATCH n "*}*") ) ;REMOVES REMAINING RIGHT CURLY BRACKET OF FONT FORMATTING ;;; (PRINC "\n(SUBSTR n mtext_cnt2 1)=") ;;; (PRINC (SUBSTR n mtext_cnt2 1)) (IF (WCMATCH (SUBSTR n mtext_cnt2 1) "}") (PROGN (IF (WCMATCH (SUBSTR n mtext_cnt2) "}") (PROGN ;;; (PRINC "\nYEP! ") ;;; (PRINC) (SETQ n (SUBSTR n 1 (1- mtext_cnt2)) ) ;_ end of SETQ ) ;_ end of PROGN (PROGN ;;; (PRINC "\nNOPE! ") ;;; (PRINC) (SETQ n (STRCAT (SUBSTR n 1 (1- mtext_cnt2) ) ;_ end of SUBSTR (SUBSTR n (1+ mtext_cnt2)) ) ;_ end of STRCAT ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF (SETQ mtext_cnt2 1) ) ;_ end of PROGN ) ;_ end of IF (SETQ mtext_cnt2 (1+ mtext_cnt2)) ) ;_ end of WHILE (SETQ mtext_cnt 1) ) ;_ end of PROGN ) ;_ end of IF (SETQ mtext_cnt (1+ mtext_cnt)) ) ;_ end of WHILE (SETQ mtext_cnt 1) (WHILE (AND (<= mtext_cnt (STRLEN n)) (WCMATCH n "*}*") ) ;REMOVES REMAINING RIGHT CURLY BRACKET OF FONT FORMATTING ;;; (PRINC "\n(SUBSTR n mtext_cnt 1)=") ;;; (PRINC (SUBSTR n mtext_cnt 1)) (IF (WCMATCH (SUBSTR n mtext_cnt 1) "}") (PROGN (IF (WCMATCH (SUBSTR n mtext_cnt) "}") (PROGN ;;; (PRINC "\nYEP! ") ;;; (PRINC) (SETQ n (SUBSTR n 1 (1- mtext_cnt))) ) ;_ end of PROGN (PROGN ;;; (PRINC "\nNOPE! ") ;;; (PRINC) (SETQ n (STRCAT (SUBSTR n 1 (1- mtext_cnt)) (SUBSTR n (1+ mtext_cnt)) ) ;_ end of STRCAT ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (SETQ mtext_cnt (1+ mtext_cnt)) ) ;_ end of WHILE (SETQ mtext_cnt 1) (WHILE (AND (< mtext_cnt (STRLEN n)) (WCMATCH n "*\\[{}]*") ) ;REPLACES MTEXT BRACKETS WITH BRACKETS (IF (WCMATCH (SUBSTR n mtext_cnt 2) "\\[{}]") (PROGN (SETQ n (STRCAT (SUBSTR n 1 (1- mtext_cnt)) (SUBSTR n (1+ mtext_cnt)) ) ;_ end of STRCAT ) ;_ end of SETQ (SETQ mtext_cnt 1) ) ;_ end of PROGN ) ;_ end of IF (SETQ mtext_cnt (1+ mtext_cnt)) ) ;_ end of WHILE (SETQ mtext_cnt 1) (WHILE (AND (< mtext_cnt (STRLEN n)) (WCMATCH n "*\\~*") ) ;REPLACES NON-BREAKING SPACES WITH SPACES (IF (WCMATCH (SUBSTR n mtext_cnt 2) "\\~") (PROGN (SETQ n (STRCAT (SUBSTR n 1 (1- mtext_cnt)) " " (SUBSTR n (+ mtext_cnt 2)) ) ;_ end of STRCAT ) ;_ end of SETQ (SETQ mtext_cnt 1) ) ;_ end of PROGN ) ;_ end of IF (SETQ mtext_cnt (1+ mtext_cnt)) ) ;_ end of WHILE (SET (READ (STRCAT "ntx" (ITOA (1+ txt_count)))) n ) ;_ end of SET (SETQ txt_count (1+ txt_count)) ) ;_ end of FOREACH (SETQ mtext_lst NIL) ) ;_ end of PROGN (PROGN (SET (READ (STRCAT "ntx" (ITOA (1+ txt_count)))) mtext_str ) ;_ end of SET (SETQ txt_count (1+ txt_count)) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ) ;_ end of COND (SETQ count (1+ count)) ) ;_ end of WHILE (WHILE (AND ntx1 (WCMATCH ntx1 " *")) (SETQ ntx1 (SUBSTR ntx1 2)) ) ;_ end of WHILE (WHILE (AND ntx2 (WCMATCH ntx2 " *")) (SETQ ntx2 (SUBSTR ntx2 2)) ) ;_ end of WHILE (WHILE (AND ntx3 (WCMATCH ntx3 " *")) (SETQ ntx3 (SUBSTR ntx3 2)) ) ;_ end of WHILE (WHILE (AND ntx4 (WCMATCH ntx4 " *")) (SETQ ntx4 (SUBSTR ntx4 2)) ) ;_ end of WHILE (WHILE (AND ntx5 (WCMATCH ntx5 " *")) (SETQ ntx5 (SUBSTR ntx5 2)) ) ;_ end of WHILE (WHILE (AND ntx6 (WCMATCH ntx6 " *")) (SETQ ntx6 (SUBSTR ntx6 2)) ) ;_ end of WHILE (WHILE (AND ntx7 (WCMATCH ntx7 " *")) (SETQ ntx7 (SUBSTR ntx7 2)) ) ;_ end of WHILE (WHILE (AND ntx8 (WCMATCH ntx8 " *")) (SETQ ntx8 (SUBSTR ntx8 2)) ) ;_ end of WHILE (WHILE (AND ntx9 (WCMATCH ntx9 " *")) (SETQ ntx9 (SUBSTR ntx9 2)) ) ;_ end of WHILE (WHILE (AND ntx10 (WCMATCH ntx10 " *")) (SETQ ntx10 (SUBSTR ntx10 2)) ) ;_ end of WHILE (WHILE (AND ntx1 (WCMATCH ntx1 "* ")) (SETQ ntx1 (SUBSTR ntx1 1 (1- (STRLEN ntx1)))) ) ;_ end of WHILE (WHILE (AND ntx2 (WCMATCH ntx2 "* ")) (SETQ ntx2 (SUBSTR ntx2 1 (1- (STRLEN ntx2)))) ) ;_ end of WHILE (WHILE (AND ntx3 (WCMATCH ntx3 "* ")) (SETQ ntx3 (SUBSTR ntx3 1 (1- (STRLEN ntx3)))) ) ;_ end of WHILE (WHILE (AND ntx4 (WCMATCH ntx4 "* ")) (SETQ ntx4 (SUBSTR ntx4 1 (1- (STRLEN ntx4)))) ) ;_ end of WHILE (WHILE (AND ntx5 (WCMATCH ntx5 "* ")) (SETQ ntx5 (SUBSTR ntx5 1 (1- (STRLEN ntx5)))) ) ;_ end of WHILE (WHILE (AND ntx6 (WCMATCH ntx6 "* ")) (SETQ ntx6 (SUBSTR ntx6 1 (1- (STRLEN ntx6)))) ) ;_ end of WHILE (WHILE (AND ntx7 (WCMATCH ntx7 "* ")) (SETQ ntx7 (SUBSTR ntx7 1 (1- (STRLEN ntx7)))) ) ;_ end of WHILE (WHILE (AND ntx8 (WCMATCH ntx8 "* ")) (SETQ ntx8 (SUBSTR ntx8 1 (1- (STRLEN ntx8)))) ) ;_ end of WHILE (WHILE (AND ntx9 (WCMATCH ntx9 "* ")) (SETQ ntx9 (SUBSTR ntx9 1 (1- (STRLEN ntx9)))) ) ;_ end of WHILE (WHILE (AND ntx10 (WCMATCH ntx10 "* ")) (SETQ ntx10 (SUBSTR ntx10 1 (1- (STRLEN ntx10)))) ) ;_ end of WHILE (COND ((AND (NOT ntx1) (EQ delot "Add") ) ;_ end of AND (SETQ ntx1 (STRCAT "N " (RTOS (CADR pt1) 2 coord_prec)) ntx2 (STRCAT "E " (RTOS (CAR pt1) 2 coord_prec)) ) ;_ end of SETQ ) ((AND ntx1 (NOT ntx2) (NOT ntx3) (EQ delot "Add") ) ;_ end of AND (SETQ ntx2 (STRCAT "N " (RTOS (CADR pt1) 2 coord_prec)) ntx3 (STRCAT "E " (RTOS (CAR pt1) 2 coord_prec)) ) ;_ end of SETQ ) ((AND ntx1 ntx2 (NOT ntx3) (EQ delot "Add") ) ;_ end of AND (SETQ ntx3 (STRCAT "N " (RTOS (CADR pt1) 2 coord_prec)) ntx4 (STRCAT "E " (RTOS (CAR pt1) 2 coord_prec)) ) ;_ end of SETQ ) ((AND ntx1 ntx2 ntx3 (NOT ntx4) (EQ delot "Add") ) ;_ end of AND (SETQ ntx4 (STRCAT "N " (RTOS (CADR pt1) 2 coord_prec)) ntx5 (STRCAT "E " (RTOS (CAR pt1) 2 coord_prec)) ) ;_ end of SETQ ) ((AND ntx1 ntx2 ntx3 ntx4 (NOT ntx5) (EQ delot "Add") ) ;_ end of AND (SETQ ntx5 (STRCAT "N " (RTOS (CADR pt1) 2 coord_prec)) ntx6 (STRCAT "E " (RTOS (CAR pt1) 2 coord_prec)) ) ;_ end of SETQ ) ((AND ntx1 ntx2 ntx3 ntx4 ntx5 (NOT ntx6) (EQ delot "Add") ) ;_ end of AND (SETQ ntx6 (STRCAT "N " (RTOS (CADR pt1) 2 coord_prec)) ntx7 (STRCAT "E " (RTOS (CAR pt1) 2 coord_prec)) ) ;_ end of SETQ ) ((AND ntx1 ntx2 ntx3 ntx4 ntx5 ntx6 (NOT ntx7) (EQ delot "Add") ) ;_ end of AND (SETQ ntx7 (STRCAT "N " (RTOS (CADR pt1) 2 coord_prec)) ntx8 (STRCAT "E " (RTOS (CAR pt1) 2 coord_prec)) ) ;_ end of SETQ ) ((AND ntx1 ntx2 ntx3 ntx4 ntx5 ntx6 ntx7 (NOT ntx8) (EQ delot "Add") ) ;_ end of AND (SETQ ntx8 (STRCAT "N " (RTOS (CADR pt1) 2 coord_prec)) ntx9 (STRCAT "E " (RTOS (CAR pt1) 2 coord_prec)) ) ;_ end of SETQ ) ((AND ntx1 ntx2 ntx3 ntx4 ntx5 ntx6 ntx7 ntx8 (NOT ntx9) (EQ delot "Add") ) ;_ end of AND (SETQ ntx9 (STRCAT "N " (RTOS (CADR pt1) 2 coord_prec)) ntx10 (STRCAT "E " (RTOS (CAR pt1) 2 coord_prec)) ) ;_ end of SETQ ) ) ;_ end of COND ) ;;;**************************************************************************** (DEFUN c:reinitremlt () (SETQ do_remlt nil pt1 nil from_lbld nil ldlblss NIL ) ;_ end of setq ) ;_ end of defun ;;;**************************************************************************** (DEFUN C:TOGNEW ( / ) (SETQ oldfunname4 oldfunname3 oldfunname3 oldfunname2 oldfunname2 oldfunname1 oldfunname1 oldfunname0 oldfunname0 funname funname "C:TOGNEW" ) (c:svlayr) (IF errortrap NIL (LOAD "errortrap" "\file ERRORTRAP.LSP not loaded! ")) (IF (AND (OR (AND ss (errortrap '(sslength ss))) (SETQ ss (SSGET '((0 . "TEXT")))) ) (>= (SSLENGTH ss) 1) ) (PROGN (SETQ this_sslen (SSLENGTH ss) this_sscnt 0 ename_lst NIL ) ;_ end of SETQ (WHILE (< this_sscnt this_sslen) (SETQ ename_lst (APPEND ename_lst (LIST (SSNAME ss this_sscnt))) this_sscnt (1+ this_sscnt) ) ;_ end of SETQ ) ;_ end of WHILE (FOREACH n ename_lst (REDRAW n 3)) (SETQ use_prev_ss (ukword 1 "Yes No Quit" "Toggle the highlighted selection? [Yes/No/Quit] " "Yes" ) ;_ end of ukword ) ;_ end of SETQ (FOREACH n ename_lst (REDRAW n 4)) (COND ((EQ (STRCASE use_prev_ss) "YES") NIL) ((EQ (STRCASE use_prev_ss) "NO") (SETQ ss (SSGET '((0 . "TEXT")))) ) (T (SETQ ss NIL)) ) ;_ end of COND ) ;_ end of PROGN ) ;_ end of IF (IF (AND ss (>= (SSLENGTH ss) 1)) (COND ((> (CDR (ASSOC 51 (ENTGET (SSNAME ss 0)))) 0.0) (SETQ sscnt 0) (WHILE (< sscnt (SSLENGTH ss)) (SETQ ent (ENTGET (SSNAME ss sscnt))) (SETQ ent (SUBST (CONS 51 0.0) (ASSOC 51 ent) ent)) (SETQ colr "6") ;;; (SETQ do_exist NIL) (IF debug_remlt (PROGN (PRINC "\n15 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (c:mklayr) (IF debug_remlt (PROGN (PRINC "\n16 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETQ ent (SUBST (CONS 8 new_ln) (ASSOC 8 ent) ent)) (ENTMOD ent) (SETQ sscnt (1+ sscnt)) ) ;_ end of while ) ((EQUAL (CDR (ASSOC 51 (ENTGET (SSNAME ss 0)))) 0.0 0.01) (SETQ sscnt 0) (WHILE (< sscnt (SSLENGTH ss)) (SETQ ent (ENTGET (SSNAME ss sscnt))) (SETQ ent (SUBST (CONS 51 0.261799) (ASSOC 51 ent) ent)) (SETQ colr "1") ;;; (SETQ do_exist T) (IF debug_remlt (PROGN (PRINC "\n17 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (c:mklayr) (IF debug_remlt (PROGN (PRINC "\n18 ") (PRINC (STRCAT mjrg llt prod colr modf)) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETQ ent (SUBST (CONS 8 new_ln) (ASSOC 8 ent) ent)) (ENTMOD ent) (SETQ sscnt (1+ sscnt)) ) ;_ end of while ) ) ;_ end of COND ) ;_ end of IF (c:rslayr) (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN set-remlt-prod () (SETQ oldfunname4 oldfunname3 oldfunname3 oldfunname2 oldfunname2 oldfunname1 oldfunname1 oldfunname0 oldfunname0 funname funname "set-remlt-prod" ) (IF (EQ (GETVAR "TILEMODE") 1) (PROGN (IF ustr NIL (LOAD "ustr" "\nFile USTR.LSP not loaded! ")) (IF prod prod (WHILE (OR (NOT prod) (NOT (EQ (STRLEN prod) 4)) ) (SETQ prod (ustr 1 "Enter CLG Minor Group (4 characters)" "PROF")) ) ) ) (PROGN (IF gvpno NIL (LOAD "gvpno" "\nFile GVPNO.LSP not loaded! ")) (gvpno) ) ) (IF (AND gvpno-vwctr (EQUAL (GETVAR "viewctr") gvpno-vwctr 50.00) prod);check to eliminate viewport number question if still in the same general area of the last call (SETQ in-same-view T remlt-prod prod gvpno-vwctr (GETVAR "viewctr") ) (SETQ in-same-view NIL gvpno-vwctr (GETVAR "viewctr") ) ) (COND (in-same-view NIL) ((> viewno 9) (SETQ remlt-prod (STRCAT "VI" (ITOA viewno))) ) ((> viewno 0) (SETQ remlt-prod (STRCAT "VI0" (ITOA viewno))) ) ((EQ (GETVAR "TILEMODE") 1) ;;; (TBLNEXT "LAYER" T) ;;; (SETQ view-number-lst NIL) ;;; (WHILE (SETQ step-layer (TBLNEXT "LAYER")) ;;; (IF (WCMATCH (CDR (ASSOC 2 step-layer)) "??VI##*") ;;; (IF (MEMBER (SUBSTR (CDR (ASSOC 2 step-layer)) 5 2) ;;; view-number-lst ;;; ) ;_ end of MEMBER ;;; NIL ;;; (SETQ view-number-lst ;;; (APPEND ;;; view-number-lst ;;; (LIST ;;; (SUBSTR (CDR (ASSOC 2 step-layer)) 5 2) ;;; ) ;_ end of LIST ;;; ) ;_ end of APPEND ;;; ) ;_ end of SETQ ;;; ) ;_ end of IF ;;; ) ;_ end of IF ;;; ) ;_ end of WHILE ;;; (SETQ view-number-lst (ACAD_STRLSORT view-number-lst)) ;;; (SETQ view-number-str ;;; (SUBSTR ;;; (EVAL (CONS 'STRCAT ;;; (MAPCAR '(LAMBDA (x) (STRCAT " " x)) ;;; view-number-lst ;;; ) ;_ end of MAPCAR ;;; ) ;_ end of CONS ;;; ) ;_ end of EVAL ;;; 2 ;;; ) ;_ end of SUBSTR ;;; ) ;_ end of SETQ ;;; (IF uint ;;; NIL ;;; (LOAD "uint" "\nFile UINT.LSP not loaded! ") ;;; ) ;_ end of IF ;;; (SETQ use-view# ;;; (uint ;;; 1 ;;; view-number-str ;;; (STRCAT ;;; "View number for this note layer [" ;;; (SUBSTR ;;; (EVAL (CONS 'STRCAT ;;; (MAPCAR '(LAMBDA (x) (STRCAT "/" x)) ;;; view-number-lst ;;; ) ;_ end of MAPCAR ;;; ) ;_ end of CONS ;;; ) ;_ end of EVAL ;;; 2 ;;; ) ;_ end of SUBSTR ;;; " or other #]" ;;; ) ;_ end of STRCAT ;;; (IF use-view# ;;; use-view# ;;; NIL ;;; ) ;_ end of IF ;;; ) ;_ end of uint ;;; ) ;_ end of SETQ ;;; (COND ;;; ((> use-view# 9) (SETQ remlt-prod "PROF") ;;; ) ;;; ((< use-view# 10) ;;; (SETQ remlt-prod (STRCAT "VI0" (ITOA use-view#))) ;;; ) ;;; ) ;_ end of COND ) ) ;_ end of COND (SETQ prod remlt-prod) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN c:tees () (SETQ oldfunname4 oldfunname3 oldfunname3 oldfunname2 oldfunname2 oldfunname1 oldfunname1 oldfunname0 oldfunname0 funname funname "c:tees" ) (setq my-t-leader "1" t-leader "1" ) (c:remlt) (princ) ) ;;;**************************************************************************** (DEFUN c:teeless () (SETQ oldfunname4 oldfunname3 oldfunname3 oldfunname2 oldfunname2 oldfunname1 oldfunname1 oldfunname0 oldfunname0 funname funname "c:teeless" ) (setq my-t-leader "0" t-leader "0" ) (c:remlt) (princ) ) ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 0 0 nil T nil T) ;*** DO NOT add text below the comment! ***|;