;;;Save, Restore and Make layer utilities. (uses modified CLG format) ;;; ;;; This function is to save layer settings before running a utility ;;; that sets its own layer so that the previous condition can be ;;; restored. ;;; ;;; Contains many layer related command and function definitions: ;;; ;;; C:ALLON C:CLGCOLOR C:CLGLTYPE C:CLGMAJOR c:clgminor ;;; c:clgmodif c:clguser c:clgvport C:CLTHID c:mklayr ;;; c:rslayr C:SRLAYER c:svlayr c:updlay clcoxst ;;; clltxst clmgxst clnmstd force_layoff force_layoffreeze ;;; force_layonthaw force_layunlock get_lt ;;; hycolr layentmake layentupdate nonstd-nomod-msg ;;; set_color_# set_layer_ltype_name tlnmstd ;;; ;;;**************************************************************************** ;;; ;;; Author: Henry C. Francis ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; http://www.paracadd.com ;;; All rights reserved. ;;; ;;; COPYRIGHT: 5-18-95 ;;; EDITED: 7-22-2016 ;;; ;;; Changed layer name modification routines to work properly while REFEDIT is active (accounts for $0$* layer names) ;;; ;;; Added CLGLTYPE help to put a linetype name with the available symbols ;;; ;;; Requires: set_mjrg.lsp, ustr.lsp, ukword.lsp, unit.lsp, make_layer_ent.lsp ;;; (DEFUN MKLAYR_ERROR (msg /) (DONE_DIALOG) (TERM_DIALOG) (SETQ *ERROR* OLD_MKLAYRERROR) (PRINC "\nERROR: ") (PRINC msg) (PRINC) ) ;_ end of defun ;;;**************************************************************************** (DEFUN c:svlayr () (IF tracefuns (PROGN (PRINC "\nEntering SVLAYR ") (PRINC)) ) ;_ end of IF (SETQ OLD_MKLAYRERROR *ERROR*) (SETQ *error* mklayr_error) (SETQ savedlayer (GETVAR "clayer")) (SETQ ntwang (- 0 (* (/ (GETVAR "viewtwist") PI) 180))) (SETQ svmjrg mjrg svcolr colr svcolra colra svcolri colri svprod prod svllt llt svltyp ltyp svmodf modf svusrd usrd ) ;_ end of setq (IF tracefuns (PROGN (PRINC "\nExiting SVLAYR ") (PRINC)) ) ;_ end of IF (SETQ *ERROR* OLD_MKLAYRERROR) ) ;_ end of defun ;;; ;;; ;;; This function is to restore layer settings after running a utility ;;; that sets its own layer so that the previous condition is restored. ;;; ;;; ;;; ;;; ;;;**************************************************************************** (DEFUN c:rslayr () (IF tracefuns (PROGN (PRINC "\nEntering RSLAYR ") (PRINC)) ) ;_ end of IF (SETQ OLD_ERROR *ERROR*) (SETQ *error* mklayr_error) (IF (AND savedlayer (TBLSEARCH "LAYER" savedlayer) (EQ (CDR (ASSOC 70 (TBLSEARCH "LAYER" savedlayer))) 0) ) ;_ end of AND (PROGN (SETVAR "clayer" savedlayer) (SETQ mjrg svmjrg colr svcolr colra svcolra colri svcolri prod svprod llt svllt ltyp svltyp modf svmodf usrd svusrd ) ;_ end of setq ) ;_ end of PROGN (IF (AND savedlayer (EQ (TYPE savedlayer) 'STR) ) ;_ end of AND (PRINC (STRCAT "\nUnable to set current layer to " savedlayer ) ;_ end of STRCAT ) ;_ end of PRINC ) ;_ end of IF ) ;_ end of IF (IF tracefuns (PROGN (PRINC "\nExiting RSLAYR ") (PRINC)) ) ;_ end of IF (SETQ *ERROR* OLD_ERROR) (PRINC) ) ;_ end of defun ;;;**************************************************************************** ;;; ;;; This function is to make layers that conform (*) to the CAD Layer ;;; Guidelines published by the AIA. ;;; * The CLG as used herin have been modified to accomodate both color ;;; and linetype specifications. Since only one character is used for ;;; each they are necessarily restricted in number to as many unique ;;; characters that are valid in layer names. ;;; ;;; (DEFUN c:mklayr (/ al_msg vp_msg lo_msg of_msg) (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ") ) ;_ end of IF (IF tracefuns (PROGN (PRINC "\nEntering MKLAYR ") (PRINC)) ) ;_ end of IF (SETQ OLD_ERROR *ERROR*) (SETQ *error* mklayr_error) (SETQ cmde (GETVAR "cmdecho")) (SETVAR "cmdecho" 0) ;;; (SETQ vwtwst (GETVAR "viewtwist") ;;; ntwang (- 0 (* (/ vwtwst PI) 180)) ;;; ) ;_ end of setq (IF colra (PROGN (IF debug_mklayr (PROGN (PRINC "\ncolra = ") (PRINC colra) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (COND ((= (STRCASE colra) "A") (SETQ colri "10")) ((= (STRCASE colra) "B") (SETQ colri "11")) ((= (STRCASE colra) "C") (SETQ colri "12")) ((= (STRCASE colra) "D") (SETQ colri "13")) ((= (STRCASE colra) "E") (SETQ colri "14")) ((= (STRCASE colra) "F") (SETQ colri "15")) ((= (STRCASE colra) "G") (SETQ colri "16")) ((= (STRCASE colra) "H") (SETQ colri "17")) ((= (STRCASE colra) "I") (SETQ colri "18")) ((= (STRCASE colra) "J") (SETQ colri "19")) ((= (STRCASE colra) "K") (SETQ colri "20")) ((= (STRCASE colra) "L") (SETQ colri "21")) ((= (STRCASE colra) "M") (SETQ colri "22")) ((= (STRCASE colra) "N") (SETQ colri "23")) ((= (STRCASE colra) "O") (SETQ colri "24")) ((= (STRCASE colra) "P") (SETQ colri "25")) ((= (STRCASE colra) "Q") (SETQ colri "26")) ((= (STRCASE colra) "R") (SETQ colri "27")) ((= (STRCASE colra) "S") (SETQ colri "28")) ((= (STRCASE colra) "T") (SETQ colri "29")) ((= (STRCASE colra) "U") (SETQ colri "250")) ((= (STRCASE colra) "V") (SETQ colri "251")) ((= (STRCASE colra) "W") (SETQ colri "252")) ((= (STRCASE colra) "X") (SETQ colri "253")) ((= (STRCASE colra) "Y") (SETQ colri "254")) ((= (STRCASE colra) "Z") (SETQ colri "255")) ) ;_ end of cond (IF debug_mklayr (PROGN (PRINC "\ncolri should have been set to = ") (PRINC colri) (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of if ;;; (IF clayr ;;; nil (SETQ clayr (STRCASE (GETVAR "clayer"))) ;;; ) ;_ end of if (IF (OR (clnmstd) (AND mjrg llt prod (OR colr colra)) (EQ (SETQ set_clg_groups (UKWORD 1 "Yes No" "Shall we set the CLG Layer Name Groups? [Yes/No] " (IF set_clg_groups set_clg_groups "No" ) ;_ end of IF ) ;_ end of UKWORD ) ;_ end of SETQ "Yes" ) ;_ end of EQ ) ;_ end of OR (PROGN (IF debug_mklayr (PROGN (PRINC "\n WE ARE DOING THE \"A\" PART OF THE FIRST IF!!! " ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF (IF mjrg NIL (PROGN (IF set_mjrg NIL (LOAD "SET_MJRG" "\nFile SET_MJRG.LSP not loaded! ")) (set_mjrg) ) ) (IF ustr NIL (LOAD "ustr" "\nFile USTR.LSP not loaded! ") ) ;_ end of IF (IF prod (SETQ prod (STRCASE prod)) (SETQ prod "DETL") ;;; (WHILE ;;; (NOT ;;; (AND ;;; (SETQ prod ;;; (USTR ;;; 1 ;;; "" ;;; "Could not determine CLG Minor Group. Enter 4 character Minor Group" ;;; nil ;;; ) ;_ end of USTR ;;; ) ;_ end of SETQ ;;; (IF prod ;;; (EQ (STRLEN prod) 4) ;;; ) ;_ end of IF ;;; ) ;_ end of AND ;;; ) ;_ end of NOT ;;; (IF (AND prod (EQ (STRLEN prod) 4)) ;;; (SETQ prod (STRCASE prod)) ;;; (SETQ prod NIL) ;;; ) ;_ end of IF ;;; ) ;_ end of WHILE ) ;_ end of if (COND (colr nil) ((= (STRCASE (SUBSTR clayr 7 1)) "-") (IF modf (SETQ colr "1") ;default color (SETQ colr nil) ) ;_ end of if ) ((= (SUBSTR clayr 7 1) "1") (SETQ colr "1")) ((= (SUBSTR clayr 7 1) "2") (SETQ colr "2")) ((= (SUBSTR clayr 7 1) "3") (SETQ colr "3")) ((= (SUBSTR clayr 7 1) "4") (SETQ colr "4")) ((= (SUBSTR clayr 7 1) "5") (SETQ colr "5")) ((= (SUBSTR clayr 7 1) "6") (SETQ colr "6")) ((= (SUBSTR clayr 7 1) "7") (SETQ colr "7")) ((= (SUBSTR clayr 7 1) "8") (SETQ colr "8")) ((= (SUBSTR clayr 7 1) "9") (SETQ colr "9")) ((AND colra (> (STRLEN clayr) 6)) (COND ((= (STRCASE colra) "A") (SETQ colri "10")) ((= (STRCASE colra) "B") (SETQ colri "11")) ((= (STRCASE colra) "C") (SETQ colri "12")) ((= (STRCASE colra) "D") (SETQ colri "13")) ((= (STRCASE colra) "E") (SETQ colri "14")) ((= (STRCASE colra) "F") (SETQ colri "15")) ((= (STRCASE colra) "G") (SETQ colri "16")) ((= (STRCASE colra) "H") (SETQ colri "17")) ((= (STRCASE colra) "I") (SETQ colri "18")) ((= (STRCASE colra) "J") (SETQ colri "19")) ((= (STRCASE colra) "K") (SETQ colri "20")) ((= (STRCASE colra) "L") (SETQ colri "21")) ((= (STRCASE colra) "M") (SETQ colri "22")) ((= (STRCASE colra) "N") (SETQ colri "23")) ((= (STRCASE colra) "O") (SETQ colri "24")) ((= (STRCASE colra) "P") (SETQ colri "25")) ((= (STRCASE colra) "Q") (SETQ colri "26")) ((= (STRCASE colra) "R") (SETQ colri "27")) ((= (STRCASE colra) "S") (SETQ colri "28")) ((= (STRCASE colra) "T") (SETQ colri "29")) ((= (STRCASE colra) "U") (SETQ colri "250")) ((= (STRCASE colra) "V") (SETQ colri "251")) ((= (STRCASE colra) "W") (SETQ colri "252")) ((= (STRCASE colra) "X") (SETQ colri "253")) ((= (STRCASE colra) "Y") (SETQ colri "254")) ((= (STRCASE colra) "Z") (SETQ colri "255")) ) ;_ end of COND ) ((= (SUBSTR clayr 7 1) "A") (SETQ colra "A" colri "10" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "B") (SETQ colra "B" colri "11" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "C") (SETQ colra "C" colri "12" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "D") (SETQ colra "D" colri "13" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "E") (SETQ colra "E" colri "14" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "F") (SETQ colra "F" colri "15" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "G") (SETQ colra "G" colri "16" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "H") (SETQ colra "H" colri "17" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "I") (SETQ colra "I" colri "18" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "J") (SETQ colra "J" colri "19" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "K") (SETQ colra "K" colri "20" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "L") (SETQ colra "L" colri "21" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "M") (SETQ colra "M" colri "22" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "N") (SETQ colra "N" colri "23" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "O") (SETQ colra "O" colri "24" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "P") (SETQ colra "P" colri "25" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "Q") (SETQ colra "Q" colri "26" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "R") (SETQ colra "R" colri "27" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "S") (SETQ colra "S" colri "28" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "T") (SETQ colra "T" colri "29" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "U") (SETQ colra "U" colri "252" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "V") (SETQ colra "V" colri "252" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "W") (SETQ colra "W" colri "252" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "X") (SETQ colra "X" colri "253" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "Y") (SETQ colra "Y" colri "254" ) ;_ end of setq ) ((= (SUBSTR clayr 7 1) "Z") (SETQ colra "Z" colri "255" ) ;_ end of setq ) ) ;_ end of cond ;;; A B C D H I M N O P Q V (COND (llt (COND ((= llt "-") (SETQ ltyp "continuous")) ((= (STRCASE llt) "A") (SETQ ltyp "dashdot")) ((= (STRCASE llt) "B") (SETQ ltyp "border")) ((= (STRCASE llt) "C") (SETQ ltyp "center")) ((= (STRCASE llt) "D") (SETQ ltyp "dashed")) ;;; "E" indicates "Existing" and can be any linetype ;;; "F" indicates "Future" and can be any linetype ((= (STRCASE llt) "G") (SETQ ltyp "dashed2")) ((= (STRCASE llt) "H") (SETQ ltyp "hidden")) ((= (STRCASE llt) "I") (SETQ ltyp "hidden2")) ((= (STRCASE llt) "L") (SETQ ltyp "border2")) ((= (STRCASE llt) "M") (SETQ ltyp "match")) ((= (STRCASE llt) "N") (SETQ ltyp "center2")) ((= (STRCASE llt) "O") (SETQ ltyp "dot")) ((= (STRCASE llt) "P") (SETQ ltyp "phantom")) ((= (STRCASE llt) "Q") (SETQ ltyp "phantom2")) ((= (STRCASE llt) "R") (SETQ ltyp "streamd2")) ((= (STRCASE llt) "S") (SETQ ltyp "streamd")) ((= (STRCASE llt) "T") (SETQ ltyp "continuous")) ((= (STRCASE llt) "V") (SETQ ltyp "divide")) ((= (STRCASE llt) "1") (SETQ ltyp "dot1d")) ((= (STRCASE llt) "3") (SETQ ltyp "dot3d")) ((AND (= (STRCASE llt) "S") (NOT (= mjrg "P")) (NOT (= (SUBSTR prod 1 1) "-")) ) ;_ end of AND (SETQ ltyp "streamd") ) ((= (STRCASE llt) "E") (SETQ ltyp "continuous")) ;(get_lt) ((= (STRCASE llt) "X") (SETQ ltyp "continuous")) ;(get_lt) ((= (STRCASE llt) "F") (SETQ ltyp "phantom")) ) ;_ end of cond ) ((AND (= (SUBSTR clayr 2 1) "-") (clnmstd)) (SETQ llt "-") (SETQ ltyp "continuous") ) ((AND (= (SUBSTR clayr 2 1) "A") (clnmstd)) (SETQ llt "A") (SETQ ltyp "dashdot") ) ((AND (= (SUBSTR clayr 2 1) "B") (clnmstd)) (SETQ llt "B") (SETQ ltyp "border") ) ((AND (= (SUBSTR clayr 2 1) "C") (clnmstd)) (SETQ llt "C") (SETQ ltyp "center") ) ((AND (= (SUBSTR clayr 2 1) "D") (clnmstd)) (SETQ llt "D") (SETQ ltyp "dashed") ) ((AND (= (SUBSTR clayr 2 1) "G") (clnmstd)) (SETQ llt "G") (SETQ ltyp "dashed2") ) ((AND (= (SUBSTR clayr 2 1) "H") (clnmstd)) (SETQ llt "H") (SETQ ltyp "hidden") ) ((AND (= (SUBSTR clayr 2 1) "I") (clnmstd)) (SETQ llt "I") (SETQ ltyp "hidden2") ) ((AND (= (SUBSTR clayr 2 1) "L") (clnmstd)) (SETQ llt "L") (SETQ ltyp "border2") ) ((AND (= (SUBSTR clayr 2 1) "M") (clnmstd)) (SETQ llt "M") (SETQ ltyp "match") ) ((AND (= (SUBSTR clayr 2 1) "N") (clnmstd)) (SETQ llt "N") (SETQ ltyp "center2") ) ((AND (= (SUBSTR clayr 2 1) "O") (clnmstd)) (SETQ llt "O") (SETQ ltyp "dot") ) ((AND (= (SUBSTR clayr 2 1) "P") (clnmstd)) (SETQ llt "P") (SETQ ltyp "phantom") ) ((AND (= (SUBSTR clayr 2 1) "Q") (clnmstd)) (SETQ llt "Q") (SETQ ltyp "phantom2") ) ((AND (= (SUBSTR clayr 2 1) "T") (clnmstd)) (SETQ llt "T") (SETQ ltyp "continuous") ) ((AND (= (SUBSTR clayr 2 1) "V") (clnmstd)) (SETQ llt "V") (SETQ ltyp "divide") ) ((AND (= (SUBSTR clayr 2 1) "R") (clnmstd)) (SETQ llt "R") (SETQ ltyp "streamd2") ) ((AND (= (SUBSTR clayr 2 1) "S") (clnmstd)) (SETQ llt "S") (SETQ ltyp "streamd") ) ((AND (= (SUBSTR clayr 2 1) "E") (clnmstd)) (SETQ llt "E") (SETQ ltyp "continuous") ) ((AND (= (SUBSTR clayr 2 1) "X") (clnmstd)) (SETQ llt "X") (SETQ ltyp "continuous") ) ((AND (= (SUBSTR clayr 2 1) "F") (clnmstd)) (SETQ llt "F") (SETQ ltyp "phantom") ) ((AND (= (SUBSTR clayr 2 1) "1") (clnmstd)) (SETQ llt "1") (SETQ ltyp "dot1d") ) ((AND (= (SUBSTR clayr 2 1) "3") (clnmstd)) (SETQ llt "3") (SETQ ltyp "dot3d") ) ) ;_ end of cond ;;; (COND ;;; (modf nil) ;;; ((>= (STRLEN clayr) 8) (SETQ modf (SUBSTR clayr 8))) ;;; ) ;_ end of cond (IF (AND mjrg prod) (SETQ new_ln (STRCASE (STRCAT mjrg (IF (AND llt (NOT (WCMATCH llt "* *")) (NOT (WCMATCH llt "*`**")) ) ;_ end of AND llt "-" ) ;_ end of if prod (IF colra colra (IF (AND colr (/= colr "-") (NOT (WCMATCH colr "*`**")) ) ;_ end of AND colr (IF (AND modf (/= modf "") (NOT (WCMATCH modf "*`**")) ) ;_ end of and "-" "" ) ;_ end of if ) ;_ end of if ) ;_ end of if (IF (AND modf (/= modf "") (NOT (WCMATCH modf "* *")) (NOT (WCMATCH modf "*`**")) ) ;_ end of AND modf "" ) ;_ end of if (COND ((AND usrd usrd1 usrd2 (/= usrd "") (/= usrd1 "") (/= usrd2 "") (NOT (WCMATCH usrd "* *,*`**")) (NOT (WCMATCH usrd1 "* *,*`**")) (NOT (WCMATCH usrd2 "* *,*`**")) ) (STRCAT "-" usrd "-" usrd1 "-" usrd2)) ((AND usrd usrd1 (/= usrd "") (/= usrd1 "") (NOT (WCMATCH usrd "* *,*`**")) (NOT (WCMATCH usrd1 "* *,*`**")) ) (STRCAT "-" usrd "-" usrd1)) ((AND usrd (/= usrd "") (NOT (WCMATCH usrd "* *,*`**")) ) (STRCAT "-" usrd)) (T "") ) ;_ end of COND (IF (and clg_status (/= clg_status "")(NOT (WCMATCH clg_status "* *,*`**"))) (STRCAT "-" clg_status) "" ) ) ;_ end of strcat ) ;_ end of STRCASE ) ;_ end of setq ) ;_ end of IF (SETQ usrd NIL usrd1 NIL usrd2 NIL clg_status NIL ) (SETQ tbl_le (TBLSEARCH "layer" new_ln)) (IF (AND tbl_le (OR (AND (EQ (TYPE (READ (SUBSTR new_ln 7 1))) 'INT) (EQ (ABS (CDR (ASSOC 62 tbl_le))) (IF (AND (EQ (SUBSTR new_ln 7 1) "6") (OR (EQ (SUBSTR new_ln 8 4) "DIMS") (EQ (SUBSTR new_ln 8 4) "TEXT") (EQ (SUBSTR new_ln 8 4) "NOTE") (EQ (SUBSTR new_ln 8 4) "ATTR") (WCMATCH (SUBSTR new_ln 8 4) "TX##") ) ;_ end of OR ) ;_ end of AND 6 (READ (SUBSTR new_ln 7 1)) ) ;_ end of IF ) ;_ end of EQ ) ;_ end of AND (AND (EQ (TYPE (READ (SUBSTR new_ln 7 1))) 'SYM) (NOT (EQ (SUBSTR new_ln 7 1) "-")) (EQ (ABS (CDR (ASSOC 62 tbl_le))) (COND ((EQ (SUBSTR new_ln 7 1) "A") 10) ((EQ (SUBSTR new_ln 7 1) "B") 11) ((EQ (SUBSTR new_ln 7 1) "C") 12) ((EQ (SUBSTR new_ln 7 1) "D") 13) ((EQ (SUBSTR new_ln 7 1) "E") 14) ((EQ (SUBSTR new_ln 7 1) "F") 15) ((EQ (SUBSTR new_ln 7 1) "G") 16) ((EQ (SUBSTR new_ln 7 1) "H") 17) ((EQ (SUBSTR new_ln 7 1) "I") 18) ((EQ (SUBSTR new_ln 7 1) "J") 19) ((EQ (SUBSTR new_ln 7 1) "K") 20) ((EQ (SUBSTR new_ln 7 1) "L") 21) ((EQ (SUBSTR new_ln 7 1) "M") 22) ((EQ (SUBSTR new_ln 7 1) "N") 23) ((EQ (SUBSTR new_ln 7 1) "O") 24) ((EQ (SUBSTR new_ln 7 1) "P") 25) ((EQ (SUBSTR new_ln 7 1) "Q") 26) ((EQ (SUBSTR new_ln 7 1) "R") 27) ((EQ (SUBSTR new_ln 7 1) "S") 28) ((EQ (SUBSTR new_ln 7 1) "T") 29) ((EQ (SUBSTR new_ln 7 1) "U") 250) ((EQ (SUBSTR new_ln 7 1) "V") 251) ((EQ (SUBSTR new_ln 7 1) "W") 252) ((EQ (SUBSTR new_ln 7 1) "X") 253) ((EQ (SUBSTR new_ln 7 1) "Y") 254) ((EQ (SUBSTR new_ln 7 1) "Z") 255) ) ;_ end of COND ) ;_ end of EQ ) ;_ end of AND ) ;_ end of or ) ;_ end of and (PROGN ;;; (PRINC "\n\tMJRG=\t") ;;; (princ MJRG) ;;; (PRINC "\n\tLLT=\t") ;;; (princ LLT) ;;; (PRINC "\n\tPROD=\t") ;;; (princ PROD) ;;; (PRINC "\n\tCOLR=\t") ;;; (princ COLR) ;;; (PRINC "\n\tCOLRI=\t") ;;; (princ COLRI) ;;; (PRINC "\n\tCOLRA=\t") ;;; (princ COLRA) ;;; (PRINC "\n\tMODF=\t") ;;; (princ MODF) ;;; (PRINC) (IF debug_mklayr (PROGN (PRINC "\nnew_ln = ") (PRINC new_ln) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (PROGN (force_layonthaw new_ln) (SETVAR "clayer" new_ln) ) ;_ end of PROGN (IF debug_mklayr (PROGN (PRINC "\nWE JUST SETVAR \"clayer\" to ") (PRINC new_ln) (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN (PROGN (IF (= colr "-") (SETQ laycol (CDR (ASSOC 62 (TBLSEARCH "LAYER" new_ln)))) ;;; (hycolr) ) ;_ end of if ;;;(princ "\nnew_ln = ") ;;;(princ new_ln) ;;;(princ "\ncolr = ") ;;;(princ colr) ;;;(princ "\ncolra = ") ;;;(princ colra) ;;;(princ "\ncolri = ") ;;;(princ colri) ;;;(princ "\nlaycol = ") ;;;(princ laycol) ;;;(princ "\nltyp = ") ;;;(princ ltyp) (COND ((AND new_ln (EQ (TYPE (READ (SUBSTR new_ln 7 1))) 'INT) (NOT (AND (EQ (SUBSTR new_ln 7 1) "6") modf (OR (EQ (STRCASE modf) "DIMS") (EQ (STRCASE modf) "TEXT") (EQ (STRCASE modf) "NOTE") (EQ (STRCASE modf) "ATTR") (WCMATCH (STRCASE modf) "TX##") ) ;_ end of OR ) ;_ end of AND ) ;_ end of NOT ) ;_ end of and (SETQ use_pcolor (SUBSTR new_ln 7 1)) ) ((AND (EQ (SUBSTR new_ln 7 1) "6") (OR (EQ (SUBSTR new_ln 8 4) "DIMS") (EQ (SUBSTR new_ln 8 4) "TEXT") (EQ (SUBSTR new_ln 8 4) "NOTE") (EQ (SUBSTR new_ln 8 4) "ATTR") (WCMATCH (SUBSTR new_ln 8 4) "TX##") ) ;_ end of OR ) ;_ end of AND (SETQ use_pcolor "6") ) ((EQ (TYPE (READ (SUBSTR new_ln 7 1))) 'SYM) (COND ((EQ (SUBSTR new_ln 7 1) "A") (SETQ use_pcolor "10") ) ((EQ (SUBSTR new_ln 7 1) "B") (SETQ use_pcolor "11") ) ((EQ (SUBSTR new_ln 7 1) "C") (SETQ use_pcolor "12") ) ((EQ (SUBSTR new_ln 7 1) "D") (SETQ use_pcolor "13") ) ((EQ (SUBSTR new_ln 7 1) "E") (SETQ use_pcolor "14") ) ((EQ (SUBSTR new_ln 7 1) "F") (SETQ use_pcolor "15") ) ((EQ (SUBSTR new_ln 7 1) "G") (SETQ use_pcolor "16") ) ((EQ (SUBSTR new_ln 7 1) "H") (SETQ use_pcolor "17") ) ((EQ (SUBSTR new_ln 7 1) "I") (SETQ use_pcolor "18") ) ((EQ (SUBSTR new_ln 7 1) "J") (SETQ use_pcolor "19") ) ((EQ (SUBSTR new_ln 7 1) "K") (SETQ use_pcolor "20") ) ((EQ (SUBSTR new_ln 7 1) "L") (SETQ use_pcolor "21") ) ((EQ (SUBSTR new_ln 7 1) "M") (SETQ use_pcolor "22") ) ((EQ (SUBSTR new_ln 7 1) "N") (SETQ use_pcolor "23") ) ((EQ (SUBSTR new_ln 7 1) "O") (SETQ use_pcolor "24") ) ((EQ (SUBSTR new_ln 7 1) "P") (SETQ use_pcolor "25") ) ((EQ (SUBSTR new_ln 7 1) "Q") (SETQ use_pcolor "26") ) ((EQ (SUBSTR new_ln 7 1) "R") (SETQ use_pcolor "27") ) ((EQ (SUBSTR new_ln 7 1) "S") (SETQ use_pcolor "28") ) ((EQ (SUBSTR new_ln 7 1) "T") (SETQ use_pcolor "29") ) ((EQ (SUBSTR new_ln 7 1) "U") (SETQ use_pcolor "250") ) ((EQ (SUBSTR new_ln 7 1) "V") (SETQ use_pcolor "251") ) ((EQ (SUBSTR new_ln 7 1) "W") (SETQ use_pcolor "252") ) ((EQ (SUBSTR new_ln 7 1) "X") (SETQ use_pcolor "253") ) ((EQ (SUBSTR new_ln 7 1) "Y") (SETQ use_pcolor "254") ) ((EQ (SUBSTR new_ln 7 1) "Z") (SETQ use_pcolor "255") ) (T (SETQ use_pcolor "-")) ) ;_ end of COND ) ;;; ((AND laycol (EQ (TYPE laycol) 'STR)) ;;; (SETQ use_pcolor laycol) ;;; ) (T (SETQ use_pcolor "-")) ) ;_ end of COND (IF (AND ltyp (EQ (TYPE ltyp) 'STR) (NOT (TBLSEARCH "LTYPE" ltyp)) (/= ltyp "-") ) ;_ end of AND (IF (FINDFILE "custom.lin") (COMMAND "-LINETYPE" "L" ltyp "custom.lin" "") (COMMAND "-LINETYPE" "L" ltyp "acad.lin" "") ) ;_ end of IF NIL ) ;_ end of IF (IF debug_remlt (PROGN (PRINC "\n16 ") (PRINC new_ln) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (IF (= (STRCASE (SUBSTR new_ln 1 3)) "PS-") (layentmake new_ln (IF (AND colr (/= colr "-")) colr (IF colri colri (CDR (ASSOC 62 (TBLSEARCH "LAYER" new_ln))) ) ;_ end of IF ) ;_ end of IF (IF ltyp ltyp "Continuous" ) ;_ end of IF ) ;_ end of layentmake ;;; (COMMAND ".-layer" ;;; "make" ;;; new_ln ;;; "" ;;; ) ;_ end of command (layentmake new_ln (IF (AND colr (/= colr "-")) colr (IF colri colri (CDR (ASSOC 62 (TBLSEARCH "LAYER" new_ln))) ) ;_ end of IF ) ;_ end of IF (IF ltyp ltyp "Continuous" ) ;_ end of IF ) ;_ end of layentmake ;;; (COMMAND ".-layer" ;;; "make" ;;; new_ln ;;; "color" ;;; use_pcolor ;;; new_ln ;;; "ltype" ;;; (IF ltyp ;;; ltyp ;;; "continuous" ;;; ) ;_ end of if ;;; new_ln ;;; "" ;;; ) ;_ end of command ) ;_ end of IF ) ;_ end of progn ) ;_ end of if (IF debug_mklayr (PROGN (PRINC "\nEND OF PART A ") (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of progn (IF (AND mjrg prod) (PROGN (IF debug_mklayr (PROGN (PRINC "\n WE ARE DOING THE \"B.1\" PART OF THE FIRST IF!!! " ) ;_ end of princ (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETQ new_ln (STRCAT mjrg (IF llt llt "-" ) ;_ end of if prod (IF colra colra (IF (AND colr (/= colr "-")) colr (IF (AND modf (/= modf "")) "-" "" ) ;_ end of if ) ;_ end of if ) ;_ end of if (IF (AND modf (/= modf "") (NOT (WCMATCH modf "* *"))) modf "" ) ;_ end of if (COND ((AND usrd usrd1 usrd2 (/= usrd "") (/= usrd1 "") (/= usrd2 "") (NOT (WCMATCH usrd "* *,*`**")) (NOT (WCMATCH usrd1 "* *,*`**")) (NOT (WCMATCH usrd2 "* *,*`**")) ) (STRCAT "-" usrd "-" usrd1 "-" usrd2)) ((AND usrd usrd1 (/= usrd "") (/= usrd1 "") (NOT (WCMATCH usrd "* *,*`**")) (NOT (WCMATCH usrd1 "* *,*`**")) ) (STRCAT "-" usrd "-" usrd1)) ((AND usrd (/= usrd "") (NOT (WCMATCH usrd "* *,*`**")) ) (STRCAT "-" usrd)) (T "") ) ;_ end of COND (IF (and clg_status (/= clg_status "")(NOT (WCMATCH clg_status "* *,*`**"))) (STRCAT "-" clg_status) "" ) ) ;_ end of strcat ) ;_ end of setq (SETQ tbl_le (TBLSEARCH "layer" new_ln)) (IF (AND tbl_le (OR (AND (EQ (TYPE (READ (SUBSTR new_ln 7 1))) 'INT) (EQ (ABS (CDR (ASSOC 62 tbl_le))) (IF (AND (EQ (SUBSTR new_ln 7 1) "6") (OR (EQ (SUBSTR new_ln 8 4) "DIMS") (EQ (SUBSTR new_ln 8 4) "TEXT") (EQ (SUBSTR new_ln 8 4) "NOTE") (EQ (SUBSTR new_ln 8 4) "ATTR") (WCMATCH (SUBSTR new_ln 8 4) "TX##") ) ;_ end of OR ) ;_ end of AND 6 (READ (SUBSTR new_ln 7 1)) ) ;_ end of IF ) ;_ end of EQ ) ;_ end of AND (AND (EQ (TYPE (READ (SUBSTR new_ln 7 1))) 'SYM) (EQ (ABS (CDR (ASSOC 62 tbl_le))) (COND ((EQ (SUBSTR new_ln 7 1) "A") 10) ((EQ (SUBSTR new_ln 7 1) "B") 11) ((EQ (SUBSTR new_ln 7 1) "C") 12) ((EQ (SUBSTR new_ln 7 1) "D") 13) ((EQ (SUBSTR new_ln 7 1) "E") 14) ((EQ (SUBSTR new_ln 7 1) "F") 15) ((EQ (SUBSTR new_ln 7 1) "G") 16) ((EQ (SUBSTR new_ln 7 1) "H") 17) ((EQ (SUBSTR new_ln 7 1) "I") 18) ((EQ (SUBSTR new_ln 7 1) "J") 19) ((EQ (SUBSTR new_ln 7 1) "K") 20) ((EQ (SUBSTR new_ln 7 1) "L") 21) ((EQ (SUBSTR new_ln 7 1) "M") 22) ((EQ (SUBSTR new_ln 7 1) "N") 23) ((EQ (SUBSTR new_ln 7 1) "O") 24) ((EQ (SUBSTR new_ln 7 1) "P") 25) ((EQ (SUBSTR new_ln 7 1) "Q") 26) ((EQ (SUBSTR new_ln 7 1) "R") 27) ((EQ (SUBSTR new_ln 7 1) "S") 28) ((EQ (SUBSTR new_ln 7 1) "T") 29) ((EQ (SUBSTR new_ln 7 1) "U") 250) ((EQ (SUBSTR new_ln 7 1) "V") 251) ((EQ (SUBSTR new_ln 7 1) "W") 252) ((EQ (SUBSTR new_ln 7 1) "X") 253) ((EQ (SUBSTR new_ln 7 1) "Y") 254) ((EQ (SUBSTR new_ln 7 1) "Z") 255) ) ;_ end of COND ) ;_ end of EQ ) ;_ end of AND ) ;_ end of or ) ;_ end of and (PROGN (force_layonthaw new_ln) (SETVAR "clayer" new_ln) ) ;_ end of PROGN (PROGN (IF (= colr "-") (SETQ laycol (CDR (ASSOC 62 (TBLSEARCH "LAYER" new_ln)))) ;;; (hycolr) ) ;_ end of if (COND ((AND new_ln (EQ (TYPE (SUBSTR new_ln 7 1)) 'INT) (NOT (AND (EQ colr "6") modf (OR (EQ (STRCASE modf) "DIMS") (EQ (STRCASE modf) "TEXT") (EQ (STRCASE modf) "NOTE") (EQ (STRCASE modf) "ATTR") (WCMATCH (STRCASE modf) "TX##") ) ;_ end of OR ) ;_ end of AND ) ;_ end of NOT ) ;_ end of and (SETQ use_pcolor (SUBSTR new_ln 7 1)) ) ((AND (EQ (SUBSTR new_ln 7 1) "6") (OR (EQ (SUBSTR new_ln 8 4) "DIMS") (EQ (SUBSTR new_ln 8 4) "TEXT") (EQ (SUBSTR new_ln 8 4) "NOTE") (EQ (SUBSTR new_ln 8 4) "ATTR") (WCMATCH (SUBSTR new_ln 8 4) "TX##") ) ;_ end of OR ) ;_ end of AND (SETQ use_pcolor "6") ) ((EQ (TYPE (SUBSTR new_ln 7 1)) 'STR) (COND ((EQ (SUBSTR new_ln 7 1) "A") (SETQ use_pcolor "10") ) ((EQ (SUBSTR new_ln 7 1) "B") (SETQ use_pcolor "11") ) ((EQ (SUBSTR new_ln 7 1) "C") (SETQ use_pcolor "12") ) ((EQ (SUBSTR new_ln 7 1) "D") (SETQ use_pcolor "13") ) ((EQ (SUBSTR new_ln 7 1) "E") (SETQ use_pcolor "14") ) ((EQ (SUBSTR new_ln 7 1) "F") (SETQ use_pcolor "15") ) ((EQ (SUBSTR new_ln 7 1) "G") (SETQ use_pcolor "16") ) ((EQ (SUBSTR new_ln 7 1) "H") (SETQ use_pcolor "17") ) ((EQ (SUBSTR new_ln 7 1) "I") (SETQ use_pcolor "18") ) ((EQ (SUBSTR new_ln 7 1) "J") (SETQ use_pcolor "19") ) ((EQ (SUBSTR new_ln 7 1) "K") (SETQ use_pcolor "20") ) ((EQ (SUBSTR new_ln 7 1) "L") (SETQ use_pcolor "21") ) ((EQ (SUBSTR new_ln 7 1) "M") (SETQ use_pcolor "22") ) ((EQ (SUBSTR new_ln 7 1) "N") (SETQ use_pcolor "23") ) ((EQ (SUBSTR new_ln 7 1) "O") (SETQ use_pcolor "24") ) ((EQ (SUBSTR new_ln 7 1) "P") (SETQ use_pcolor "25") ) ((EQ (SUBSTR new_ln 7 1) "Q") (SETQ use_pcolor "26") ) ((EQ (SUBSTR new_ln 7 1) "R") (SETQ use_pcolor "27") ) ((EQ (SUBSTR new_ln 7 1) "S") (SETQ use_pcolor "28") ) ((EQ (SUBSTR new_ln 7 1) "T") (SETQ use_pcolor "29") ) ((EQ (SUBSTR new_ln 7 1) "U") (SETQ use_pcolor "250") ) ((EQ (SUBSTR new_ln 7 1) "V") (SETQ use_pcolor "251") ) ((EQ (SUBSTR new_ln 7 1) "W") (SETQ use_pcolor "252") ) ((EQ (SUBSTR new_ln 7 1) "X") (SETQ use_pcolor "253") ) ((EQ (SUBSTR new_ln 7 1) "Y") (SETQ use_pcolor "254") ) ((EQ (SUBSTR new_ln 7 1) "Z") (SETQ use_pcolor "255") ) ) ;_ end of COND ) ;;; ((AND laycol (EQ (TYPE laycol) 'STR)) ;;; (SETQ use_pcolor laycol) ;;; ) (T (SETQ use_pcolor "1")) ) ;_ end of COND (IF (AND ltyp (EQ (TYPE ltyp) 'STR) (NOT (TBLSEARCH "LTYPE" ltyp)) (/= ltyp "-") ) ;_ end of AND (IF (FINDFILE "custom.lin") (COMMAND "-LINETYPE" "L" ltyp "custom.lin" "") (COMMAND "-LINETYPE" "L" ltyp "acad.lin" "") ) ;_ end of IF NIL ) ;_ end of IF (IF (= (STRCASE (SUBSTR new_ln 1 3)) "PS-") (layentmake new_ln (IF (AND colr (/= colr "-")) colr (IF colri colri (CDR (ASSOC 62 (TBLSEARCH "LAYER" new_ln))) ) ;_ end of IF ) ;_ end of IF (IF ltyp ltyp "Continuous" ) ;_ end of IF ) ;_ end of layentmake ;;; (COMMAND ".layer" ;;; "make" ;;; new_ln ;;; "" ;;; ) ;_ end of command (layentmake new_ln (IF (AND colr (/= colr "-")) colr (IF colri colri (CDR (ASSOC 62 (TBLSEARCH "LAYER" new_ln))) ) ;_ end of IF ) ;_ end of IF (IF ltyp ltyp "Continuous" ) ;_ end of IF ) ;_ end of layentmake ;;; (COMMAND ".layer" ;;; "make" ;;; new_ln ;;; "color" ;;; use_pcolor ;;; "" ;;; "ltype" ;;; (IF ltyp ;;; ltyp ;;; "" ;;; ) ;_ end of if ;;; "" ;;; "" ;;; ) ;_ end of command ) ;_ end of IF ) ;_ end of progn ) ;_ end of if ) ;_ end of progn (PROGN (IF debug_mklayr (PROGN (PRINC "\n WE ARE DOING THE \"B.2\" PART OF THE FIRST IF!!! " ) ;_ end of princ (PRINC) ) ;_ end of PROGN ) ;_ end of IF (PROMPT "\nSet CLG Layer Name first! ") ) ;_ end of progn ) ;_ end of if ) ;_ end of if (SETQ curvno (GETVAR "cvport")) (IF (AND (> curvno 1) (EQ (GETVAR "tilemode") 0)) (PROGN (SETQ prvss (SSGET "P")) (SETQ cvpss (SSGET "X" (LIST (CONS 410 (GETVAR "CTAB")) (CONS 69 curvno)) ) ;_ end of SSGET ) ;_ end of SETQ (SETQ cvpent (ENTGET (SSNAME cvpss 0) (LIST "ACAD"))) (SETQ acad_eed (MEMBER "ACAD" (CADR (ASSOC -3 cvpent)))) (IF (MEMBER (CONS 1003 (GETVAR "clayer")) acad_eed) (SETQ vp_msg "Current layer is frozen in this Viewport") (SETQ vp_msg "") ) ;_ end of if (IF prvss (COMMAND ".select" prvss "") ) ;_ end of IF ;;; (COMMAND) ) ;_ end of progn ) ;_ end of if (SETQ cur_le (TBLSEARCH "layer" (GETVAR "clayer"))) (IF (EQ (BOOLE 1 4 (CDR (ASSOC 70 cur_le))) 4) (SETQ lo_msg "Current layer is Locked") (SETQ lo_msg "") ) ;_ end of if ;;; (IF (< (CDR (ASSOC 62 cur_le)) 0) ;;; (SETQ of_msg "Current layer is Off") ;;; (SETQ of_msg "") ;;; ) ;_ end of if (IF (AND vp_msg (/= vp_msg "")) (IF (AND lo_msg (/= lo_msg "")) (IF (AND of_msg (/= of_msg "")) (SETQ al_msg (STRCAT vp_msg "\n" lo_msg "\n" of_msg)) (SETQ al_msg (STRCAT vp_msg "\n" lo_msg)) ) ;_ end of if (IF (AND of_msg (/= of_msg "")) (SETQ al_msg (STRCAT vp_msg "\n" of_msg)) (SETQ al_msg vp_msg) ) ;_ end of if ) ;_ end of if (IF (AND lo_msg (/= lo_msg "")) (IF (AND of_msg (/= of_msg "")) (SETQ al_msg (STRCAT lo_msg "\n" of_msg)) (SETQ al_msg lo_msg) ) ;_ end of if (IF (AND of_msg (/= of_msg "")) (SETQ al_msg of_msg) (SETQ al_msg nil) ) ;_ end of if ) ;_ end of if ) ;_ end of if (IF (AND al_msg (/= (GETVAR "cmdactive") 4)) (ALERT al_msg) ) ;_ end of if (SETVAR "cmdecho" cmde) (IF tracefuns (PROGN (PRINC "\nExiting MKLAYR ") (PRINC)) ) ;_ end of IF (SETQ *ERROR* OLD_ERROR) (IF debug_gen_symbols (PROGN (PRINC "\nEnding MKLAYR\nmjrg=") (PRINC mjrg) (PRINC "\nllt=") (PRINC llt) (PRINC "\nltyp=") (PRINC ltyp) (PRINC "\nprod=") (PRINC prod) (PRINC "\ncolr=") (PRINC colr) (PRINC "\ncolri=") (PRINC colri) (PRINC "\ncolra=") (PRINC colra) (PRINC "\n=modf") (PRINC modf) (PRINC "\nusrd=") (PRINC usrd) (PRINC "\nusrsfx=") (PRINC usrsfx) (PRINC "\n") (PRINC) ) ;_ end of PROGN ) ;_ end of IF (IF debug_mklayr (PROGN (PRINC "\nclayr = ") (PRINC clayr) (PRINC "\nclayer = ") (PRINC (GETVAR "clayer")) (PRINC "\nDone with C:MKLAYR\n") (PRINC) ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of defun ;;;**************************************************************************** (DEFUN clmgxst () ;does current layer major group exist? (IF (NOT clayr) (SETQ clayr (GETVAR "clayer")) ) ;_ end of IF (IF (WCMATCH clayr "$0$*") (SETQ clayr (SUBSTR clayr 4)) ) (MEMBER (STRCASE (SUBSTR clayr 1 1)) (LIST "G" "C" "L" "A" "S" "M" "P" "F" "E" "I" "O" "Q" "T" "Z") ;_ end of LIST ) ;_ end of member ) ;_ end of defun ;;;**************************************************************************** (DEFUN clltxst () ;does current layer linetype exist? (IF (NOT clayr) (SETQ clayr (GETVAR "clayer")) ) ;_ end of IF (IF (WCMATCH clayr "$0$*") (SETQ clayr (SUBSTR clayr 4)) ) (MEMBER (STRCASE (SUBSTR clayr 2 1)) (LIST "-" "A" "B" "C" "D" "E" "G" "H" "I" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "V" "X" "F" "1" "3" ) ) ;_ end of member ) ;_ end of defun ;;;**************************************************************************** (DEFUN clcoxst () ;does current layer color exist (IF (NOT clayr) (SETQ clayr (GETVAR "clayer")) ) ;_ end of IF (IF (WCMATCH clayr "$0$*") (SETQ clayr (SUBSTR clayr 4)) ) (MEMBER (STRCASE (SUBSTR clayr 7 1)) (LIST "-" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" ) ) ;_ end of member ) ;_ end of defun ;;;**************************************************************************** (DEFUN clnmstd () ;is current layer name standard? (IF (NOT clayr) (SETQ clayr (STRCASE (GETVAR "clayer"))) ) ;_ end of IF (IF (WCMATCH clayr "$0$*") (SETQ clayr (SUBSTR clayr 4)) ) ;_ end of IF (IF ;;;CLG 5 one-character discipline pattern (AND (NOT (WCMATCH clayr "*|*")) (OR (IF usrsfx (WCMATCH (STRCASE clayr) (STRCAT "[GCLASMPFEIOQTZ][-ABCDEHIMNOPQRSTVXF13]????[-123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ]????-" usrsfx)) (WCMATCH (STRCASE clayr) "[GCLASMPFEIOQTZ][-ABCDEHIMNOPQRSTVXF13]????[-123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ]????") ) (WCMATCH (STRCASE clayr) "[GCLASMPFEIOQTZ][-ABCDEHIMNOPQRSTVXF13]????[-123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ]????P") (AND (EQ (STRLEN clayr) 6) (WCMATCH clayr "?-????") ) ;_ end of AND (AND (EQ (STRLEN clayr) 11) (WCMATCH clayr "?-????-????") ) ;_ end of AND (AND (EQ (STRLEN clayr) 16) (WCMATCH clayr "?-????-????") ) ;_ end of AND (AND (EQ (STRLEN clayr) 21) (WCMATCH clayr "?-????-????") ) ;_ end of AND (AND (EQ (STRLEN clayr) 8) (WCMATCH clayr "?-????-?") ) ;_ end of AND (AND (EQ (STRLEN clayr) 13) (WCMATCH clayr "?-????-????-?") ) ;_ end of AND (AND (EQ (STRLEN clayr) 18) (WCMATCH clayr "?-????-????-????-?") ) ;_ end of AND (AND (EQ (STRLEN clayr) 23) (WCMATCH clayr "?-????-????-????-????-?") ) ;_ end of AND ) ;_ end of OR (MEMBER (STRCASE (SUBSTR clayr 1 1)) ;;;One-character Discipline Identifiers (LIST "G" ;General: "H" ;Hazardous Materials: "V" ;Survey / Mapping: "B" ;Geotechnical: "C" ;Civil: "L" ;Landscape: "S" ;Structural: "A" ;Architectural: "I" ;Interiors: "Q" ;Equipment: "F" ;Fire Protection: "P" ;Plumbing: "D" ;Process: "M" ;Mechanical: "E" ;Electrical: "T" ;Telecommunications: "R" ;Resource: "W" ;Distributed Energy: "X" ;Other Disciplines: "Z" ;Contractor / Shop Drawings: "O" ;Operations: ) ;_ end of LIST ;_ end of LIST ) ;_ end of MEMBER ) ;_ end of AND (PROGN (IF (AND (NOT (EQ (STRLEN clayr) 6)) (NOT (EQ (STRLEN clayr) 11)) (NOT (EQ (STRLEN clayr) 16)) (NOT (AND (EQ (STRLEN clayr) 12) (WCMATCH (STRCASE (SUBSTR clayr 10 3)) "#[0-9EQH]P") ) ) (NOT (WCMATCH (SUBSTR clayr 2 1) "-")) (NOT (WCMATCH (SUBSTR clayr 7 1) "-")) (NOT (WCMATCH (SUBSTR clayr 12 1) "-")) ) (PROGN (SETQ isitclg (ukword 1 "Yes No" (STRCAT "Is layer " clayr " a CLG layer? [Yes/No]") "No")) (IF (EQ isitclg "Yes") (SETQ c1_disc_clg T) (SETQ c1_disc_clg NIL) ) ) (SETQ c1_disc_clg T) ) ) (SETQ c1_disc_clg NIL) ) ;_ end of IF (IF ;;;CLG 5 two-character discipline pattern (AND (NOT (WCMATCH clayr "*|*")) (OR (AND (EQ (STRLEN clayr) 7) (WCMATCH clayr "??-????") ) ;_ end of AND (AND (EQ (STRLEN clayr) 12) (WCMATCH clayr "??-????-????") ) ;_ end of AND (AND (EQ (STRLEN clayr) 17) (WCMATCH clayr "??-????-????") ) ;_ end of AND (AND (EQ (STRLEN clayr) 22) (WCMATCH clayr "??-????-????") ) ;_ end of AND (AND (EQ (STRLEN clayr) 9) (WCMATCH clayr "??-????-?") ) ;_ end of AND (AND (EQ (STRLEN clayr) 14) (WCMATCH clayr "??-????-????-?") ) ;_ end of AND (AND (EQ (STRLEN clayr) 19) (WCMATCH clayr "??-????-????-????-?") ) ;_ end of AND (AND (EQ (STRLEN clayr) 24) (WCMATCH clayr "??-????-????-????-????-?") ) ;_ end of AND ) ;_ end of OR (MEMBER (STRCASE (SUBSTR clayr 1 2)) ;;;Two-character Discipline Identifiers (LIST "GI" ;General Informational: "GC" ;General Contractual: "GR" ;General Resource: "HA" ;Hazmat Asbestos: "HC" ;Hazmat Chemicals: "HL" ;Hazmat Lead: "HP" ;Hazmat PCB: "HR" ;Hazmat Refrigerants: "VA" ;Aerial Survey: "VF" ;Field Survey: "VI" ;Digital Survey: "CD" ;Civil Demolition: "CS" ;Civil Site: "CG" ;Civil Grading: "CP" ;Civil Paving: "CI" ;Civil Improvements: "CT" ;Civil Transportation: "CU" ;Civil Utilities: "LD" ;Landscape Demolition: "LI" ;Landscape Irrigation: "LP" ;Landscape Planting: "SD" ;Structural Demolition: "SS" ;Structural Site: "SB" ;Structural Substructure: "SF" ;Structural Framing: "AS" ;Architectural Site "AD" ;Architectural Demolition: "AE" ;Architectural Elements: "AI" ;Architectural Interiors: "AF" ;Architectural Finishes: "AG" ;Architectural Graphics: "ID" ;Interior Demolition: "IN" ;Interior Design: "IF" ;Interior Furnishings: "IG" ;Interior Graphics: "QA" ;Athletic Equipment: "QB" ;Bank Equipment: "QC" ;Dry Cleaning Equipment: "QD" ;Detention Equipment: "QE" ;Educational Equipment: "QF" ;Food service Equipment: "QH" ;Hospital Equipment: "QL" ;Laboratory Equipment: "QM" ;Maintenance Equipment: "QP" ;Parking Lot Equipment: "QR" ;Retail Equipment: "QS" ;Site Equipment: "QT" ;Theatrical Equipment: "QV" ;Video / Photographic Equipment: "QY" ;Security Equipment: "FA" ;Fire Detection and Alarm: "FX" ;Fire Suppression: "PS" ;Plumbing Site: "PD" ;Plumbing Demolition: "PP" ;Plumbing Piping: "PQ" ;Plumbing Equipment: "DS" ;Process Site: "DD" ;Process Demolition: "DL" ;Process Liquids: "DG" ;Process Gases: "DP" ;Process Piping: "DQ" ;Process Equipment: "DE" ;Process Electrical: "DI" ;Process Instrumentation: "DW" ;Process Waters: "DC" ;Process Chemicals: "DA" ;Process Airs: "DX" ;Process Exhaust: "DR" ;Process Drains and Reclaims: "DM" ;Process HPM Gases: "DY" ;Process Slurry: "DO" ;Process Oils: "DV" ;Process Vacuum: "MS" ;Mechanical Site: "MD" ;Mechanical Demolition: "MH" ;Mechanical HVAC: "MP" ;Mechanical Piping: "MI" ;Mechanical Instrumentation: "ES" ;Electrical Site: "ED" ;Electrical Demolition: "EP" ;Electrical Power: "EL" ;Electrical Lighting: "EI" ;Electrical Instrumentation: "ET" ;Electrical Telecommunications: "EY" ;Electrical Auxiliary Systems: "TA" ;Telecom Audio Visual: "TC" ;Telecom Clock and Program: "TI" ;Telecom Intercom: "TM" ;Telecom Monitoring: "TN" ;Telecom Data Networks: "TT" ;Telecom Telephone: "TY" ;Telecom Security: "RC" ;Resource Civil: "RS" ;Resource Structural: "RA" ;Resource Architectural: "RM" ;Resource Mechanical: "RE" ;Resource Electrical: ) ;_ end of LIST ;_ end of LIST ) ;_ end of member ) ;_ end of AND (SETQ c2_disc_clg T) (SETQ c2_disc_clg NIL) ) ;_ end of IF (IF (AND ;;; (< (ATOI (GETVAR "ACADVER")) 18) ;;;Old modified CLG pattern (NOT (WCMATCH clayr "*|*")) (MEMBER (STRCASE (SUBSTR clayr 1 1)) (LIST "G" ;General: "H" ;Hazardous Materials: "V" ;Survey / Mapping: "B" ;Geotechnical: "C" ;Civil: "L" ;Landscape: "S" ;Structural: "A" ;Architectural: "I" ;Interiors: "Q" ;Equipment: "F" ;Fire Protection: "P" ;Plumbing: "D" ;Process: "M" ;Mechanical: "E" ;Electrical: "T" ;Telecommunications: "R" ;Resource: "W" ;Distributed Energy: "X" ;Other Disciplines: "Z" ;Contractor / Shop Drawings: "O" ;Operations: ) ;_ end of LIST ;_ end of LIST ) ;_ end of MEMBER (NOT (WCMATCH clayr "* *")) (MEMBER (STRCASE (SUBSTR clayr 2 1)) (LIST "-" "A" "B" "C" "D" "E" "F" "G" "H" "I" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "V" "X" "F" "1" "3" ) ;_ end of LIST ;_ end of LIST ) ;_ end of member (MEMBER (STRCASE (SUBSTR clayr 7 1)) (LIST "-" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" ) ;_ end of LIST ;_ end of LIST ) ;_ end of member (WCMATCH clayr "???????*") ) ;_ end of AND (SETQ old_disc_clg T) (SETQ old_disc_clg NIL) ) ;_ end of IF (IF (OR c1_disc_clg c2_disc_clg old_disc_clg ) ;_ end of or T NIL ) ;_ end of AND ) ;_ end of defun ;;;**************************************************************************** (DEFUN tlnmstd (this_lname /) ;is this layer name standard? (SETQ layer_color NIL layer_ltype NIL orig_lname this_lname sub_lname this_lname ) ;_ end of SETQ (IF (WCMATCH sub_lname "*|*") (PROGN (WHILE (NOT (WCMATCH sub_lname "|*")) (SETQ sub_lname (SUBSTR sub_lname 2)) ) ;_ end of WHILE (SETQ sub_lname (SUBSTR sub_lname 2)) ) ;_ end of PROGN ) ;_ end of IF (IF (WCMATCH sub_lname "$0$*") (SETQ sub_lname (SUBSTR sub_lname 4) this_lname sub_lname ) ) (IF (MEMBER (STRCASE (SUBSTR sub_lname 2 1)) (LIST "-" "A" "B" "C" "D" "E" "F" "G" "H" "I" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "V" "X" "F" "1" "3" ) ;_ end of LIST ;_ end of LIST ;_ end of LIST ;_ end of LIST ;_ end of LIST ;_ end of LIST ;_ end of LIST ) ;_ end of member (set_layer_ltype_name sub_lname) ) ;_ end of IF (IF (AND (> (STRLEN sub_lname) 6) (MEMBER (STRCASE (SUBSTR sub_lname 7 1)) (LIST "-" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" ) ;_ end of LIST ;_ end of LIST ;_ end of LIST ;_ end of LIST ;_ end of LIST ;_ end of LIST ) ;_ end of member ) ;_ end of AND (PROGN (SETQ color_symb (SUBSTR sub_lname 7 1) cur_lay_ent (TBLSEARCH "LAYER" this_lname) cur_lay_color (CDR (ASSOC 62 cur_lay_ent)) ) (COND ((WCMATCH (STRCASE color_symb) "-") (SETQ layer_color cur_lay_color)) ((WCMATCH (STRCASE color_symb) "1") (SETQ layer_color "1")) ((WCMATCH (STRCASE color_symb) "2") (SETQ layer_color "2")) ((WCMATCH (STRCASE color_symb) "3") (SETQ layer_color "3")) ((WCMATCH (STRCASE color_symb) "4") (SETQ layer_color "4")) ((WCMATCH (STRCASE color_symb) "5") (SETQ layer_color "5")) ((WCMATCH (STRCASE color_symb) "6") (SETQ layer_color "6")) ((WCMATCH (STRCASE color_symb) "7") (SETQ layer_color "7")) ((WCMATCH (STRCASE color_symb) "8") (SETQ layer_color "8")) ((WCMATCH (STRCASE color_symb) "9") (SETQ layer_color "9")) ((WCMATCH (STRCASE color_symb) "A") (SETQ layer_color "10")) ((WCMATCH (STRCASE color_symb) "B") (SETQ layer_color "11")) ((WCMATCH (STRCASE color_symb) "C") (SETQ layer_color "12")) ((WCMATCH (STRCASE color_symb) "D") (SETQ layer_color "13")) ((WCMATCH (STRCASE color_symb) "E") (SETQ layer_color "14")) ((WCMATCH (STRCASE color_symb) "F") (SETQ layer_color "15")) ((WCMATCH (STRCASE color_symb) "G") (SETQ layer_color "16")) ((WCMATCH (STRCASE color_symb) "H") (SETQ layer_color "17")) ((WCMATCH (STRCASE color_symb) "I") (SETQ layer_color "18")) ((WCMATCH (STRCASE color_symb) "J") (SETQ layer_color "19")) ((WCMATCH (STRCASE color_symb) "K") (SETQ layer_color "20")) ((WCMATCH (STRCASE color_symb) "L") (SETQ layer_color "21")) ((WCMATCH (STRCASE color_symb) "M") (SETQ layer_color "22")) ((WCMATCH (STRCASE color_symb) "N") (SETQ layer_color "23")) ((WCMATCH (STRCASE color_symb) "O") (SETQ layer_color "24")) ((WCMATCH (STRCASE color_symb) "P") (SETQ layer_color "25")) ((WCMATCH (STRCASE color_symb) "Q") (SETQ layer_color "26")) ((WCMATCH (STRCASE color_symb) "R") (SETQ layer_color "27")) ((WCMATCH (STRCASE color_symb) "S") (SETQ layer_color "28")) ((WCMATCH (STRCASE color_symb) "T") (SETQ layer_color "29")) ((WCMATCH (STRCASE color_symb) "U") (SETQ layer_color "250")) ((WCMATCH (STRCASE color_symb) "V") (SETQ layer_color "251")) ((AND (WCMATCH (STRCASE color_symb) "W") (WCMATCH (STRCASE layer_modifier) "GRID")) (SETQ layer_color "169"));HUA Std Grid Color - Minor ((WCMATCH (STRCASE color_symb) "W") (SETQ layer_color "252")) ((AND (WCMATCH (STRCASE color_symb) "X") (WCMATCH (STRCASE layer_modifier) "GRID")) (SETQ layer_color "109"));HUA Std Grid Color - Intermediate ((WCMATCH (STRCASE color_symb) "X") (SETQ layer_color "253")) ((AND (WCMATCH (STRCASE color_symb) "Y") (WCMATCH (STRCASE layer_modifier) "GRID")) (SETQ layer_color "56"));HUA Std Grid Color - Primary ((WCMATCH (STRCASE color_symb) "Y") (SETQ layer_color "254")) ((WCMATCH (STRCASE color_symb) "Z") (SETQ layer_color "255")) ) ;_ end of cond ) ;_ end of PROGN ) ;_ end of IF (AND layer_color layer_ltype) ) ;_ end of defun ;;;**************************************************************************** (DEFUN set_layer_ltype_name (sub_lname /) (PROGN (SETQ ltype_symb (SUBSTR sub_lname 2 1)) (COND ((WCMATCH (STRCASE sub_lname) "BREAKLINE*")(SETQ layer_ltype "continuous")) ((WCMATCH ltype_symb "-") (SETQ layer_ltype "continuous")) ((AND sub_lname (= (SUBSTR sub_lname 2 1) "-") (clnmstd)) (SETQ llt "-") (SETQ ltyp "continuous") ) ((WCMATCH (STRCASE ltype_symb) "A") (SETQ layer_ltype "dashdot") ) ((WCMATCH (STRCASE ltype_symb) "B") (SETQ layer_ltype "border") ) ((WCMATCH (STRCASE ltype_symb) "C") (SETQ layer_ltype "center") ) ((WCMATCH (STRCASE ltype_symb) "D") (SETQ layer_ltype "dashed") ) ((WCMATCH (STRCASE ltype_symb) "E") (SETQ layer_ltype "continuous") ) ((WCMATCH (STRCASE ltype_symb) "F") (SETQ layer_ltype "phantom") ) ((WCMATCH (STRCASE ltype_symb) "G") (SETQ layer_ltype "dashed2") ) ((WCMATCH (STRCASE ltype_symb) "H") (SETQ layer_ltype "hidden") ) ((WCMATCH (STRCASE ltype_symb) "I") (SETQ layer_ltype "hidden2") ) ((WCMATCH (STRCASE ltype_symb) "L") (SETQ layer_ltype "border2") ) ((WCMATCH (STRCASE ltype_symb) "M") (SETQ layer_ltype "match") ) ((WCMATCH (STRCASE ltype_symb) "N") (SETQ layer_ltype "center2") ) ((WCMATCH (STRCASE ltype_symb) "O") (SETQ layer_ltype "dot") ) ((WCMATCH (STRCASE ltype_symb) "P") (SETQ layer_ltype "phantom") ) ((WCMATCH (STRCASE ltype_symb) "Q") (SETQ layer_ltype "phantom2") ) ((WCMATCH (STRCASE ltype_symb) "R") (SETQ layer_ltype "streamd2") ) ((WCMATCH (STRCASE ltype_symb) "S") (SETQ layer_ltype "streamd") ) ((WCMATCH (STRCASE ltype_symb) "T") (SETQ layer_ltype "continuous") ) ((WCMATCH (STRCASE ltype_symb) "V") (SETQ layer_ltype "divide") ) ((WCMATCH (STRCASE ltype_symb) "X") (SETQ layer_ltype "continuous") ) ((WCMATCH (STRCASE ltype_symb) "1") (SETQ layer_ltype "dot1d") ) ((WCMATCH (STRCASE ltype_symb) "3") (SETQ layer_ltype "dot3d") ) ((WCMATCH (STRCASE ltype_symb) "[24567890]") (SETQ layer_ltype "continuous") ) ) ;_ end of cond ) ;_ end of PROGN ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN set_color_# (color_symb layer_modifier /) (IF (MEMBER (STRCASE color_symb) (LIST "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" "-" "1" "2" "3" "4" "5" "6" "7" "8" "9" ) ;_ end of LIST ;_ end of LIST ) ;_ end of MEMBER (COND ((WCMATCH (STRCASE color_symb) "-") (SETQ thiscolor# 1)) ((WCMATCH (STRCASE color_symb) "1") (SETQ thiscolor# 1)) ((WCMATCH (STRCASE color_symb) "2") (SETQ thiscolor# 2)) ((WCMATCH (STRCASE color_symb) "3") (SETQ thiscolor# 3)) ((WCMATCH (STRCASE color_symb) "4") (SETQ thiscolor# 4)) ((WCMATCH (STRCASE color_symb) "5") (SETQ thiscolor# 5)) ((WCMATCH (STRCASE color_symb) "6") (SETQ thiscolor# 6)) ((WCMATCH (STRCASE color_symb) "7") (SETQ thiscolor# 7)) ((WCMATCH (STRCASE color_symb) "8") (SETQ thiscolor# 8)) ((WCMATCH (STRCASE color_symb) "9") (SETQ thiscolor# 9)) ((WCMATCH (STRCASE color_symb) "A") (SETQ thiscolor# 10)) ((WCMATCH (STRCASE color_symb) "B") (SETQ thiscolor# 11)) ((WCMATCH (STRCASE color_symb) "C") (SETQ thiscolor# 12)) ((WCMATCH (STRCASE color_symb) "D") (SETQ thiscolor# 13)) ((WCMATCH (STRCASE color_symb) "E") (SETQ thiscolor# 14)) ((WCMATCH (STRCASE color_symb) "F") (SETQ thiscolor# 15)) ((WCMATCH (STRCASE color_symb) "G") (SETQ thiscolor# 16)) ((WCMATCH (STRCASE color_symb) "H") (SETQ thiscolor# 17)) ((WCMATCH (STRCASE color_symb) "I") (SETQ thiscolor# 18)) ((WCMATCH (STRCASE color_symb) "J") (SETQ thiscolor# 19)) ((WCMATCH (STRCASE color_symb) "K") (SETQ thiscolor# 20)) ((WCMATCH (STRCASE color_symb) "L") (SETQ thiscolor# 21)) ((WCMATCH (STRCASE color_symb) "M") (SETQ thiscolor# 22)) ((WCMATCH (STRCASE color_symb) "N") (SETQ thiscolor# 23)) ((WCMATCH (STRCASE color_symb) "O") (SETQ thiscolor# 24)) ((WCMATCH (STRCASE color_symb) "P") (SETQ thiscolor# 25)) ((WCMATCH (STRCASE color_symb) "Q") (SETQ thiscolor# 26)) ((WCMATCH (STRCASE color_symb) "R") (SETQ thiscolor# 27)) ((WCMATCH (STRCASE color_symb) "S") (SETQ thiscolor# 28)) ((WCMATCH (STRCASE color_symb) "T") (SETQ thiscolor# 29)) ((WCMATCH (STRCASE color_symb) "U") (SETQ thiscolor# 250)) ((WCMATCH (STRCASE color_symb) "V") (SETQ thiscolor# 251)) ((AND (WCMATCH (STRCASE color_symb) "W") (WCMATCH (STRCASE layer_modifier) "GRID")) (SETQ thiscolor# 169));HUA Std Grid Color - Minor ((WCMATCH (STRCASE color_symb) "W") (SETQ thiscolor# 252)) ((AND (WCMATCH (STRCASE color_symb) "X") (WCMATCH (STRCASE layer_modifier) "GRID")) (SETQ thiscolor# 109));HUA Std Grid Color - Intermediate ((WCMATCH (STRCASE color_symb) "X") (SETQ thiscolor# 253)) ((AND (WCMATCH (STRCASE color_symb) "Y") (WCMATCH (STRCASE layer_modifier) "GRID")) (SETQ thiscolor# 56));HUA Std Grid Color - Primary ((WCMATCH (STRCASE color_symb) "Y") (SETQ thiscolor# 254)) ((WCMATCH (STRCASE color_symb) "Z") (SETQ thiscolor# 255)) ) ;_ end of cond (SETQ thiscolor# 1) ) ;_ end of IF ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN hycolr () (IF uint NIL (LOAD "uint" "\nFile UINT.LSP not loaded! ") ) ;_ end of IF (SETQ laycol (ITOA (uint 0 "" "Enter color number for this layer" (IF laycol (ATOI laycol) nil ) ;_ end of if ) ;_ end of uint ) ;_ end of itoa colr nil colra nil ) ;_ end of setq ) ;_ end of defun ;;;**************************************************************************** (DEFUN get_lt () (IF nentl (PROGN (SETQ lentd (TBLSEARCH "layer" nentl)) (SETQ tltyp (CDR (ASSOC 6 lentd))) ) ;_ end of progn ) ;_ end of if (IF ustr NIL (LOAD "ustr" "\nFile USTR.LSP not loaded! ") ) ;_ end of IF (SETQ ltyp (ustr 1 "Linetype: " (IF tltyp tltyp "continuous" ) ;_ end of if nil ) ;_ end of ustr ) ;_ end of setq (PRINC) ) ;_ end of defun ;;;**************************************************************************** (DEFUN layentmake (thisname thiscolor thisltname /) (IF (OR debug_mklayr debug_remlt) (PROGN (PRINC "\nthisname = ") (PRINC thisname) (PRINC "\nthiscolor = ") (PRINC thiscolor) (PRINC "\nthisltname = ") (PRINC thisltname) (PRINC) ) ;_ end of PROGN ) ;_ end of IF ;;; (IF (OR (NOT (TBLOBJNAME "STYLE" "SYMETEO"))(NOT (TBLOBJNAME "STYLE" "SYMAP"))) ;;; (PROGN ;;; (IF initandsdichk NIL (LOAD "initandsdichk" "\nFile INITANDSDICHK.LSP not loaded! ")) ;;; (initandsdichk) ;;; ) ;;; ) (SETQ thisltype thisltname) (IF (SETQ thislayenam (TBLOBJNAME "LAYER" thisname)) (PROGN (force_layonthaw thisname) (layentupdate) (IF (MEMBER (STRCASE thisname) laupdnmlst) NIL (PROGN (SETQ laupdnmlst (APPEND laupdnmlst (LIST thisname))) (PRINC (STRCAT "\nLayer " (STRCASE thisname) " has been updated. ") ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN (PROGN (IF (AND thiscolor (> (ATOI thiscolor) 0) (<= (ATOI thiscolor) 255) ) ;_ end of AND NIL (IF thiscolor (progn (setq thismodifier (substr thisname 8 4)) (set_color_# thiscolor thismodifier) ) ) ;_ end of IF ) ;_ end of IF (IF (ENTMAKE (LIST (CONS 0 "LAYER") (CONS 100 "AcDbSymbolTableRecord") (CONS 100 "AcDbLayerTableRecord") (CONS 2 thisname) (CONS 70 0) (CONS 62 (IF (AND (> (ATOI thiscolor) 0) (<= (ATOI thiscolor) 255) ) ;_ end of AND (ATOI thiscolor) (IF thiscolor# thiscolor# 1 ) ;_ end of IF ) ;_ end of IF ) ;_ end of CONS (CONS 6 (IF (TBLSEARCH "ltype" thisltname) thisltname "Continuous" ) ;_ end of IF ) ;_ end of CONS (CONS 290 1) ) ;_ end of LIST ) ;_ end of ENTMAKE (PROGN (layentupdate) (IF (MEMBER (STRCASE thisname) laupdnmlst) NIL (PROGN (SETQ laupdnmlst (APPEND laupdnmlst (LIST thisname))) (PRINC (STRCAT "\nLayer " (STRCASE thisname) " has been created." ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN (IF (MEMBER (STRCASE thisname) laupdnmlst) NIL (PROGN (SETQ laupdnmlst (APPEND laupdnmlst (LIST thisname))) (PRINC (STRCAT "\nLayer creation failed for layer " (STRCASE thisname) "." ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (IF debug_mklayr (PROGN (PRINC "\nthisname = ") (PRINC thisname) (PRINC "\ at end of LAYENTMAKE ") (PRINC) ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN force_layonthaw (alayername /) (IF (TBLSEARCH "LAYER" alayername) (PROGN (SETQ layer_ename (TBLOBJNAME "LAYER" alayername) layer_ent (ENTGET layer_ename) ) ;_ end of SETQ (IF (EQ (BOOLE 1 (CDR (ASSOC 70 layer_ent)) 1) 1) (PROGN (SETQ layer_ent (SUBST (CONS 70 (1- (CDR (ASSOC 70 layer_ent))) ) ;_ end of CONS (ASSOC 70 layer_ent) layer_ent ) ;_ end of SUBST ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF (SETQ layer_ent (SUBST (CONS 62 (ABS (CDR (ASSOC 62 layer_ent))) ) ;_ end of CONS (ASSOC 62 layer_ent) layer_ent ) ;_ end of SUBST ) ;_ end of SETQ (ENTMOD layer_ent) ) ;_ end of PROGN (IF (WCMATCH alayername "`*") (PROGN (COMMAND nil nil nil) (COMMAND "-layer" "on" "*" "thaw" "*" "") (VLA-REGEN (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)) ACALLVIEWPORTS ) ;_ end of VLA-REGEN ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of IF ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN C:ALLON (/ do_force_layonthaw) (IF DOS_MSGBOX NIL (PROGN (IF check_for_doslib NIL (LOAD "check_for_doslib" "\File CHECK_FOR_DOSLIB.LSP not loaded! ")) (IF check_for_doslib (check_for_doslib)) ) ) (IF DOS_MSGBOX (SETQ do_force_layonthaw (DOS_MSGBOX "This will thaw and turn on all layers!\nDo you really want to do this?\n(vplayer frozen layers will not be affected.)" "Really thaw and turn on all layers?" 2 5 ) ;_ end of DOS_MSGBOX ) ;_ end of SETQ (PROGN (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ")) (SETQ answer_do_force_layonthaw (ukword 1 "Yes No" "This will thaw and turn on all layers! Do you really want to do this? (vplayer frozen layers will not be affected.) [Yes/No]" (IF answer_do_force_layonthaw answer_do_force_layonthaw "No")) ) (SETQ do_force_layonthaw (IF (EQ answer_do_force_layonthaw "Yes") 4 1 ) ) ) ) (IF (EQ do_force_layonthaw 4) (force_layonthaw "*") ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN force_layoffreeze (alayername /) (IF (AND (TBLSEARCH "LAYER" alayername) (NOT (EQ (STRCASE (GETVAR "clayer")) (STRCASE alayername))) ) ;_ end of AND (PROGN (SETQ layer_ename (TBLOBJNAME "LAYER" alayername) layer_ent (ENTGET layer_ename) ) ;_ end of SETQ (IF (EQ (BOOLE 1 (CDR (ASSOC 70 layer_ent)) 1) 1) NIL (PROGN (SETQ layer_ent (SUBST (CONS 70 (1+ (CDR (ASSOC 70 layer_ent))) ) ;_ end of CONS (ASSOC 70 layer_ent) layer_ent ) ;_ end of SUBST ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF (SETQ layer_ent (SUBST (CONS 62 (- (ABS (CDR (ASSOC 62 layer_ent)))) ) ;_ end of CONS (ASSOC 62 layer_ent) layer_ent ) ;_ end of SUBST ) ;_ end of SETQ (ENTMOD layer_ent) ) ;_ end of PROGN (PROGN (COMMAND nil nil nil) (COMMAND "-layer" "m" alayername "") ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN force_layoff (alayername /) (IF (AND (TBLSEARCH "LAYER" alayername) (NOT (EQ (STRCASE (GETVAR "clayer")) (STRCASE alayername))) ) ;_ end of AND (PROGN (SETQ layer_ename (TBLOBJNAME "LAYER" alayername) layer_ent (ENTGET layer_ename) ) ;_ end of SETQ (SETQ layer_ent (SUBST (CONS 62 (- (ABS (CDR (ASSOC 62 layer_ent)))) ) ;_ end of CONS (ASSOC 62 layer_ent) layer_ent ) ;_ end of SUBST ) ;_ end of SETQ (ENTMOD layer_ent) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN force_layunlock (alayername /) (IF (TBLSEARCH "LAYER" alayername) (PROGN (SETQ layer_ename (TBLOBJNAME "LAYER" alayername) layer_ent (ENTGET layer_ename) ) ;_ end of SETQ (IF (EQ (BOOLE 1 (CDR (ASSOC 70 layer_ent)) 4) 4) (PROGN (SETQ layer_ent (SUBST (CONS 70 (- (CDR (ASSOC 70 layer_ent)) 4) ) ;_ end of CONS (ASSOC 70 layer_ent) layer_ent ) ;_ end of SUBST ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF (ENTMOD layer_ent) ) ;_ end of PROGN (PROGN (COMMAND nil nil nil) (COMMAND "-layer" "m" alayername "") ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN c:updlay () (IF from_resize_pens NIL (SETQ layer_sels (SSGET)) ) (IF layer_sels (PROGN (SETQ cnt 0) (WHILE (< cnt (SSLENGTH layer_sels)) (SETQ this_sel (ENTGET (SSNAME layer_sels cnt))) (SETQ thisname (CDR (ASSOC 8 this_sel))) (IF (tlnmstd thisname) (PROGN (SETQ color_symb (SUBSTR thisname 7 1) thismodifier (SUBSTR thisname 8 4) ) (set_color_# color_symb thismodifier) (SETQ thiscolor (ITOA thiscolor#)) (set_layer_ltype_name thisname) (IF layer_ltype (SETQ thisltname layer_ltype) (SETQ thisltname nil) ) (IF (AND thisname thiscolor thisltname) (layentupdate) ) ) ) (SETQ cnt (1+ cnt)) ) (SETQ from_resize_pens NIL) ) ) ) ;;;**************************************************************************** (DEFUN layentupdate () (IF (OR debug_mklayr debug_remlt) (PROGN (PRINC "\nthisname = ") (PRINC thisname) (PRINC "\nthiscolor = ") (PRINC thiscolor) (PRINC "\nthisltype = ") (PRINC thisltype) (PRINC "\nthisltname = ") (PRINC thisltname) (PRINC "\nlayer_ltype = ") (PRINC layer_ltype) (PRINC) ) ;_ end of PROGN ) ;_ end of IF ;;; (SETQ layer_ltype thisltype) (IF (SETQ thislayenam (TBLOBJNAME "LAYER" thisname)) (PROGN (set_layer_ltype_name thisname) (IF (AND thiscolor (IF (EQ (TYPE thiscolor) 'INT) (AND (SETQ thiscolor (ITOA thiscolor)) (> (ATOI thiscolor) 0) (<= (ATOI thiscolor) 255) ) (AND (> (ATOI thiscolor) 0) (<= (ATOI thiscolor) 255) ) ) ) ;_ end of AND NIL (IF thiscolor (PROGN (IF (EQ (TYPE thiscolor) 'INT) (SETQ thiscolor (ITOA thiscolor)) ) (setq thismodifier (substr thisname 8 4)) (set_color_# thiscolor thismodifier);'thismodifier' permits check of CLG modifier for "GRID" to assign HUA Std. grid color ) ) ;_ end of IF ) ;_ end of IF (SETQ thislayent (ENTGET thislayenam)) (SETQ thislayent (SUBST (CONS 62 (IF (AND (> (ATOI thiscolor) 0) (<= (ATOI thiscolor) 255) ) ;_ end of AND (ATOI thiscolor) (IF thiscolor# thiscolor# 1 ) ;_ end of IF ) ;_ end of IF ) ;_ end of CONS (ASSOC 62 thislayent) thislayent ) ;_ end of SUBST ) ;_ end of SETQ ;;; (ENTMOD thislayent) ;;; (ENTUPD (CDR (ASSOC -1 thislayent))) ;;; (SETQ thislayent (ENTGET thislayenam)) (IF layer_ltype (SETQ thislayent (SUBST (CONS 6 (IF (TBLSEARCH "ltype" layer_ltype) layer_ltype "Continuous" ) ;_ end of IF ) ;_ end of CONS (ASSOC 6 thislayent) thislayent ) ;_ end of SUBST ) ;_ end of SETQ ) ;_ end of IF (ENTMOD thislayent) (ENTUPD (CDR (ASSOC -1 thislayent))) (IF debug_mklayr (PROGN (PRINC "\nthislayenam = ") (PRINC (CDR (ASSOC -1 thislayent))) (PRINC "\nthisname = ") (PRINC (CDR (ASSOC 2 thislayent))) (PRINC "\nthiscolor = ") (PRINC (CDR (ASSOC 62 thislayent))) (PRINC "\nthisltype = ") (PRINC (CDR (ASSOC 6 thislayent))) (PRINC "\nDONE with LAYENTMAKE!\n") (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETVAR "clayer" thisname) (SETQ ;thisname NIL thiscolor NIL thisltype NIL thisltname NIL thislayent NIL thislayenam NIL ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN nonstd-nomod-msg (alayername) (PRINC (STRCAT "\n\n\t\tLayer \"" alayername "\" is not in CLG name format and could not be used to\n\t\tcreate or update a CLG name with the modification you requested! " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN C:CLGMAJOR (/ clgmajor_ss skip_lst) (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ") ) ;_ end of IF (SETQ new_major (ukword 1 "G C L A S M P F E I O Q T V Z" "Enter new major group string [G/C/L/A/S/M/P/F/E/I/O/Q/T/V/Z]" (IF new_major new_major "G" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ (WHILE (OR (NOT new_major) (NOT (MEMBER new_major (LIST "G" "C" "L" "A" "S" "M" "P" "F" "E" "I" "O" "Q" "T" "V" "Z" ) ;_ end of LIST ;_ end of LIST ;_ end of LIST ;_ end of LIST ;_ end of LIST ;_ end of LIST ) ;_ end of MEMBER ) ;_ end of NOT ) ;_ end of OR (SETQ new_major (ukword 1 "G C L A S M P F E I O Q T V Z" "Enter new major group string (1 character [G/C/L/A/S/M/P/F/E/I/O/Q/T/V/Z])" (IF new_major new_major "-" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ ) ;_ end of WHILE (SETQ mjrg new_major) (SETQ clgmajor_ss (SSGET)) (IF clgmajor_ss (PROGN (SETQ cnt 0) (SETQ clgmajor_sslen (SSLENGTH clgmajor_ss)) (SETQ laupdnmlst NIL) (IF make_layer_ent NIL (LOAD "make_layer_ent" "\nFile MAKE_LAYER_ENT.LSP not loaded! " ) ;_ end of LOAD ) ;_ end of IF (WHILE (< cnt clgmajor_sslen) (SETQ this_ent (ENTGET (SSNAME clgmajor_ss cnt))) (SETQ this_layer (CDR (ASSOC 8 this_ent))) (IF (AND (SETQ clayr this_layer) (clnmstd) ) ;_ end of AND (PROGN (SETQ thisname (STRCAT new_major (IF (> (STRLEN clayr) 1) (SUBSTR clayr 2) "" ) ;_ end of IF ) ;_ end of STRCAT thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST ) ;_ end of SETQ (force_layonthaw thisname) (make_layer_ent (LIST (CONS 8 thisname))) (ENTMOD this_ent) ) ;_ end of PROGN (IF (MEMBER this_layer skip_lst) NIL (PROGN (SETQ skip_lst (APPEND skip_lst (LIST this_layer))) (nonstd-nomod-msg this_layer) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of IF (SETQ cnt (1+ cnt)) ) ;_ end of WHILE ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN C:CLGLTYPE (/ clgltype_ss skip_lst) (SETQ skip_lst NIL) (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ") ) ;_ end of IF (IF from_clthid NIL (PROGN (IF (AND new_ltype (WCMATCH new_ltype "`?")) (ALERT (STRCAT "\tCLG Linetype/Status Symbols:" "\n\n- = Continuous" "\nA = Dashdot" "\nB = Border" "\nC = Center" "\nD = Dashed" "\nE = Status Indicator - Existing to remain" "\n\t(initially Continuous but may be any linetype)" "\nF = Status Indicator - Future" "\nG = Dashed2" "\n\t(initially Phantom but may be any linetype)" "\nH = Hidden" "\nI = Hidden2" "\nL = Border2" "\nM = Match" "\nN = Center2" "\nO = Dot" "\nP = Phantom" "\nQ = Phantom2" "\nR = Streamd2" "\nS = Streamd" "\nT = Status Indicator - Temporary" "\n\t(initially Continuous but may be any linetype)" "\nV = Divide" "\nX = Status Indicator - Existing to be demolished" "\n\t(initially Continuous but may be any linetype)" "\n1 = Dot1d (dot at intersections for grid spacing in tenths" "\n\tline length is critical)" "\n3 = Dot3d (dot at intersections for grid spacing in thirds" "\n\tline length is critical)" "\n? - Shows this symbol map" ) ) ) (SETQ new_ltype (ukword 1 "- A B C D E F G H I L M N O P Q R S T V X 1 3 ?" "Enter new ltype group string [-/A/B/C/D/E/F/G/H/I/L/M/N/O/P/Q/R/S/T/V/X/1/3/?]" (IF new_ltype new_ltype "-" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ ) ) ;_ end of IF (WHILE (OR (NOT new_ltype) (NOT (MEMBER new_ltype (LIST "-" "A" "B" "C" "D" "E" "F" "G" "H" "I" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "V" "X" "1" "3" ) ;_ end of LIST ;_ end of LIST ;_ end of LIST ;_ end of LIST ;_ end of LIST ) ;_ end of MEMBER ) ;_ end of NOT ) ;_ end of OR (IF (AND new_ltype (WCMATCH new_ltype "`?")) (ALERT (STRCAT "\tCLG Linetype/Status Symbols:" "\n\n- = Continuous" "\nA = Dashdot" "\nB = Border" "\nC = Center" "\nD = Dashed" "\nE = Status Indicator - Existing to remain" "\n\t(initially Continuous but may be any linetype)" "\nF = Status Indicator - Future" "\n\t(initially Phantom but may be any linetype)" "\nH = Hidden" "\nI = Hidden2" "\nM = Match" "\nN = Center2" "\nO = Dot" "\nP = Phantom" "\nQ = Phantom2" "\nR = Streamd2" "\nS = Streamd" "\nT = Status Indicator - Temporary" "\n\t(initially Continuous but may be any linetype)" "\nV = Divide" "\nX = Status Indicator - Existing to be demolished" "\n\t(initially Continuous but may be any linetype)" "\n1 = Dot1d (dot at intersections for grid spacing in tenths" "\n\tline length is critical)" "\n3 = Dot3d (dot at intersections for grid spacing in thirds" "\n\tline length is critical)" "\n? - Shows this symbol map" ) ) ) (SETQ new_ltype (ukword 1 "- A B C D E F G H I L M N O P Q R S T V X 1 3 ?" "Enter new ltype group string (1 character [-/A/B/C/D/E/F/G/H/I/L/M/N/O/P/Q/R/S/T/V/X/1/3/?])" (IF new_ltype new_ltype "-" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ ) ;_ end of WHILE (SETQ clgltype_ss (SSGET)) (IF from_clthid (SETQ clthidcolor_ss clgltype_ss) ) ;_ end of IF (IF clgltype_ss (PROGN (SETQ cnt 0) (SETQ clgltype_sslen (SSLENGTH clgltype_ss)) (SETQ laupdnmlst NIL) (IF make_layer_ent NIL (LOAD "make_layer_ent" "\nFile MAKE_LAYER_ENT.LSP not loaded! " ) ;_ end of LOAD ) ;_ end of IF (WHILE (< cnt clgltype_sslen) (SETQ this_ent (ENTGET (SSNAME clgltype_ss cnt))) (SETQ this_layer (CDR (ASSOC 8 this_ent))) (IF (AND (SETQ clayr this_layer) (clnmstd) ) ;_ end of AND (PROGN (SETQ thisname (STRCAT (SUBSTR clayr 1 1) new_ltype (IF (> (STRLEN clayr) 2) (SUBSTR clayr 3) "" ) ;_ end of IF ) ;_ end of STRCAT thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST ) ;_ end of SETQ (force_layonthaw thisname) (make_layer_ent (LIST (CONS 8 thisname))) (ENTMOD this_ent) ) ;_ end of PROGN (IF (MEMBER this_layer skip_lst) NIL (PROGN (SETQ skip_lst (APPEND skip_lst (LIST this_layer))) (nonstd-nomod-msg this_layer) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of IF (SETQ cnt (1+ cnt)) ) ;_ end of WHILE ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN c:clgvport (/ clgminor_ss skip_lst) (SETQ skip_lst NIL) (IF ustr NIL (LOAD "USTR" "\nFile USTR.LSP not loaded! ") ) ;_ end of IF (IF (clnmstd) (PROGN (SETQ from_clgvport T) (SETQ curvno (GETVAR "cvport")) (SETQ cvpss (SSGET "X" (LIST (CONS 410 (GETVAR "CTAB")) (CONS 69 curvno)) ) ;_ end of SSGET ) ;_ end of SETQ (SETQ cvpent (ENTGET (SSNAME cvpss 0))) (IF (NOT (WCMATCH (STRCASE (CDR (ASSOC 8 cvpent))) "??VI##*")) (PROGN (IF uint nil (LOAD "uint" "\nFile UINT.LSP not loaded! ") ) ;_ end of IF (SETQ viewno (uint 1 "" (STRCAT "Current layer: " (CDR (ASSOC 8 cvpent)) "; New viewport number?" ) ;_ end of STRCAT viewno ) ;_ end of uint ) ;_ end of SETQ (IF (< viewno 10) (SETQ new_minor (STRCAT "VI0" (ITOA viewno))) (SETQ new_minor (STRCAT "VI" (ITOA viewno))) ) ;_ end of if ) ;_ end of PROGN (SETQ new_minor (STRCASE (SUBSTR (CDR (ASSOC 8 cvpent)) 3 4))) ) ;_ end of IF (C:CLGMINOR) (SETQ from_clgvport NIL) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN c:clgminor (/ clgminor_ss skip_lst) (SETQ skip_lst NIL) (IF ustr NIL (LOAD "USTR" "\nFile USTR.LSP not loaded! ") ) ;_ end of IF (IF (AND from_clgvport new_minor (WCMATCH (STRCASE new_minor) "VI##") ) ;_ end of AND NIL (SETQ new_minor (ustr 1 "Enter new minor group string to assign (4 characters)" (IF new_minor new_minor "" ) ;_ end of IF nil ) ;_ end of ustr ) ;_ end of SETQ ) ;_ end of IF (WHILE (OR (NOT new_minor) (/= (STRLEN new_minor) 4) ) ;_ end of OR (SETQ new_minor (ustr 1 "Enter new minor group string to assign (4 characters)" (IF new_minor new_minor "" ) ;_ end of IF nil ) ;_ end of ustr ) ;_ end of SETQ ) ;_ end of WHILE (SETQ clgminor_ss (SSGET)) (IF clgminor_ss (PROGN (SETQ cnt 0) (SETQ clgminor_sslen (SSLENGTH clgminor_ss)) (SETQ laupdnmlst NIL) (IF make_layer_ent NIL (LOAD "make_layer_ent" "\nFile MAKE_LAYER_ENT.LSP not loaded! " ) ;_ end of LOAD ) ;_ end of IF (WHILE (< cnt clgminor_sslen) (SETQ this_ent (ENTGET (SSNAME clgminor_ss cnt))) (SETQ this_layer (CDR (ASSOC 8 this_ent))) (COND ((AND (NOT (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*|*")) (SETQ clayr this_layer) (clnmstd) ) ;_ end of AND (SETQ thisname (STRCAT (SUBSTR clayr 1 1) (IF (> (STRLEN clayr) 1) (SUBSTR clayr 2 1) "-" ) ;_ end of IF new_minor (IF (> (STRLEN clayr) 6) (SUBSTR clayr 7) (CDR (ASSOC 62 (TBLSEARCH "layer" this_layer) ) ;_ end of ASSOC ) ;_ end of CDR ) ;_ end of IF ) ;_ end of STRCAT thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST ) ;_ end of SETQ (force_layonthaw thisname) (make_layer_ent (LIST (CONS 8 thisname))) (ENTMOD this_ent) ) ((AND (NOT (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*|*")) (SETQ clayr this_layer) (NOT (clnmstd)) ) ;_ end of AND (IF (MEMBER this_layer skip_lst) NIL (PROGN (SETQ skip_lst (APPEND skip_lst (LIST this_layer))) (nonstd-nomod-msg this_layer) ) ;_ end of PROGN ) ;_ end of IF ) ) ;_ end of COND (SETQ cnt (1+ cnt)) ) ;_ end of WHILE ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN C:CLGCOLOR (/ clgcolor_ss skip_lst) (SETQ skip_lst NIL) (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ") ) ;_ end of IF (IF from_clthid NIL (SETQ new_color (ukword 1 "- 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z" "Enter new color group string [1/2/3/4/5/6/7/8/9/A/B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/-]" (IF new_color new_color "-" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ ) ;_ end of IF (WHILE (OR (NOT new_color) (NOT (MEMBER new_color (LIST "-" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" ) ;_ end of LIST ) ;_ end of MEMBER ) ;_ end of NOT ) ;_ end of OR (SETQ new_color (ukword 1 "- 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z" "Enter new color group string [1/2/3/4/5/6/7/8/9/A/B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/-]" (IF new_color new_color "1" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ ) ;_ end of WHILE (IF from_clthid (SETQ clgcolor_ss clthidcolor_ss) (SETQ clgcolor_ss (SSGET)) ) ;_ end of IF (IF clgcolor_ss (PROGN (SETQ cnt 0) (SETQ clgcolor_sslen (SSLENGTH clgcolor_ss)) (SETQ laupdnmlst NIL) (IF make_layer_ent NIL (LOAD "make_layer_ent" "\nFile MAKE_LAYER_ENT.LSP not loaded! " ) ;_ end of LOAD ) ;_ end of IF (WHILE (< cnt clgcolor_sslen) (SETQ this_ent (ENTGET (SSNAME clgcolor_ss cnt))) (SETQ this_layer (CDR (ASSOC 8 this_ent))) (IF (AND (SETQ clayr this_layer) (clnmstd) ) ;_ end of AND (PROGN (SETQ thisname (STRCAT (SUBSTR clayr 1 6) new_color (SUBSTR clayr 8) ) ;_ end of STRCAT thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST ) ;_ end of SETQ (force_layonthaw thisname) (make_layer_ent (LIST (CONS 8 thisname))) (ENTMOD this_ent) ) ;_ end of PROGN (IF (MEMBER this_layer skip_lst) NIL (PROGN (SETQ skip_lst (APPEND skip_lst (LIST this_layer))) (nonstd-nomod-msg this_layer) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of IF (SETQ cnt (1+ cnt)) ) ;_ end of WHILE ) ;_ end of PROGN ) ;_ end of IF (SETQ from_clthid NIL) (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN c:clgmodif (/ clgmodif_ss skip_lst) (SETQ skip_lst NIL) (IF ustr NIL (LOAD "USTR" "\nFile USTR.LSP not loaded! ") ) ;_ end of IF (SETQ new_modif (ustr 1 "Enter new modifier group string to assign (4 characters, NILS for none)" (IF new_modif new_modif "" ) ;_ end of IF nil ) ;_ end of ustr ) ;_ end of SETQ (WHILE (OR (NOT new_modif) (< (STRLEN new_modif) 4) (AND (> (STRLEN new_modif) 4) (NOT (OR (WCMATCH (STRCASE new_modif) "[NRDFEX][SDFGRTKL]#[0-9HQE]P") ;5 char. ParaPIPE designation of status, component, and pipe size (WCMATCH (STRCASE new_modif) "[WGSF][MS]X##") ;5 char. GPDGN designation of existing alignment component ) ) ) ;_ end of AND ) ;_ end of OR (SETQ new_modif (ustr 1 "Enter new modifier group string to assign (4 characters, NILS for none)" (IF new_modif new_modif "" ) ;_ end of IF nil ) ;_ end of ustr ) ;_ end of SETQ ) ;_ end of WHILE (SETQ clgmodif_ss (SSGET)) (IF clgmodif_ss (PROGN (SETQ cnt 0) (SETQ clgmodif_sslen (SSLENGTH clgmodif_ss)) (SETQ laupdnmlst NIL) (IF make_layer_ent NIL (LOAD "make_layer_ent" "\nFile MAKE_LAYER_ENT.LSP not loaded! " ) ;_ end of LOAD ) ;_ end of IF (WHILE (< cnt clgmodif_sslen) (SETQ this_ent (ENTGET (SSNAME clgmodif_ss cnt))) (SETQ this_layer (CDR (ASSOC 8 this_ent))) (COND ((AND (NOT (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*|*")) (SETQ clayr this_layer) (clnmstd) ) ;_ end of AND (PROGN (SETQ thisname (STRCAT (SUBSTR clayr 1 7) (IF (EQ new_modif "NILS") "" new_modif ) (IF (> (STRLEN clayr) 11) (IF (AND (> (STRLEN clayr) 12) (AND (WCMATCH (STRCASE (SUBSTR clayr 12 1)) "P") (NOT (WCMATCH (STRCASE new_modif) "[NRDFEX][SDFGRTKL]#[0-9HQE]P" ) ;_ end of WCMATCH ) ;_ end of NOT ) ) ;_ end of AND (STRCAT "-" (SUBSTR clayr 13)) (IF (WCMATCH (SUBSTR (STRCASE clayr) 8) "[WGSF][MS]X##*") ;5 char. GPDGN designation of existing alignment component (SUBSTR clayr 13) (SUBSTR clayr 12) ) ) ;_ end of IF "" ) ;_ end of IF ) ;_ end of STRCAT thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST ) ;_ end of SETQ (force_layonthaw thisname) (make_layer_ent (LIST (CONS 8 thisname))) (ENTMOD this_ent) ) ;_ end of PROGN ) ((AND (NOT (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*|*")) (SETQ clayr this_layer) (NOT (clnmstd)) ) ;_ end of AND (IF (MEMBER this_layer skip_lst) NIL (PROGN (SETQ skip_lst (APPEND skip_lst (LIST this_layer))) (nonstd-nomod-msg this_layer) ) ;_ end of PROGN ) ;_ end of IF ) ) ;_ end of COND (SETQ cnt (1+ cnt)) ) ;_ end of WHILE ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN c:clguser (/ clguserd_ss skip_lst) (SETQ skip_lst NIL) (SETQ clguserd_ss (SSGET)) (IF ustr NIL (LOAD "USTR" "\nFile USTR.LSP not loaded! ") ) ;_ end of IF (SETQ new_userd (ustr 1 "User string? (4 characters, more if GPDGN with \"any user suffix\" checked, \"NILS\" for none)" (IF new_userd new_userd "" ) ;_ end of IF nil ) ;_ end of ustr ) ;_ end of SETQ (WHILE (COND ((NOT new_userd)) ((AND (EQ use_any_usrsfx "1") (< (STRLEN new_userd) 4) )) ((AND (EQ use_any_usrsfx "0") (> (STRLEN new_userd) 4) )) ) ;_ end of OR (SETQ new_userd (ustr 1 "User string? (4 characters, more if GPDGN with \"any user suffix\" checked, \"NILS\" for none)" (IF new_userd new_userd "" ) ;_ end of IF nil ) ;_ end of ustr ) ;_ end of SETQ ) ;_ end of WHILE ;;; (IF allclg_userd ;;; (SETQ clgusers_ss (SSGET '((8 . "*[~|]???????*")))) ;;; ) (IF clguserd_ss (PROGN (SETQ cnt 0) (SETQ clguserd_sslen (SSLENGTH clguserd_ss)) (SETQ laupdnmlst NIL) (IF make_layer_ent NIL (LOAD "make_layer_ent" "\nFile MAKE_LAYER_ENT.LSP not loaded! " ) ;_ end of LOAD ) ;_ end of IF (WHILE (< cnt clguserd_sslen) (SETQ this_ent (ENTGET (SSNAME clguserd_ss cnt))) (SETQ this_layer (CDR (ASSOC 8 this_ent))) (COND ((AND (NOT (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*|*")) (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*--????") ;;; (OR ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*--NPLT") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*--LV##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*--SC##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*--PL##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*--PH##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*--AL##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*--EL##") ;;; ) ;_ end of OR (SETQ clayr this_layer) (clnmstd) ) ;_ end of AND (IF (WCMATCH (STRCASE new_userd) "NILS") (SETQ thisname (SUBSTR clayr 1 (- (STRLEN clayr) 6)) thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST usrd nil cusrd nil usdf nil ) ;_ end of SETQ (SETQ thisname (STRCAT (SUBSTR clayr 1 (- (STRLEN clayr) 5) ) ;_ end of SUBSTR new_userd ) ;_ end of STRCAT thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST ) ;_ end of SETQ ) ;_ end of IF ) ((AND (NOT (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*|*")) (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-????") ;;; (OR ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-NPLT") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-LV##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-SC##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-PL##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-PH##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-AL##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-EL##") ;;; ) ;_ end of OR (SETQ clayr this_layer) (clnmstd) ) ;_ end of AND (IF (WCMATCH (STRCASE new_userd) "NILS") (SETQ thisname (SUBSTR clayr 1 (- (STRLEN clayr) 5)) thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST usrd nil cusrd nil usdf nil ) ;_ end of SETQ (SETQ thisname (STRCAT (SUBSTR clayr 1 (- (STRLEN clayr) 4) ) ;_ end of SUBSTR new_userd ) ;_ end of STRCAT thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST ) ;_ end of SETQ ) ;_ end of IF ) ((AND usrsfx (NOT (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*|*")) (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) (STRCASE (STRCAT "*-" usrsfx))) ;;; (OR ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-NPLT") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-LV##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-SC##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-PL##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-PH##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-AL##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-EL##") ;;; ) ;_ end of OR (SETQ clayr this_layer) (clnmstd) ) ;_ end of AND (IF (WCMATCH (STRCASE new_userd) "NILS") (SETQ thisname (SUBSTR clayr 1 (- (STRLEN clayr) (1+(STRLEN usrsfx)))) thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST usrd nil cusrd nil usdf nil ) ;_ end of SETQ (SETQ thisname (STRCAT (SUBSTR clayr 1 (- (STRLEN clayr) (1+(STRLEN usrsfx)))) "-" new_userd) thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST ) ;_ end of SETQ ) ;_ end of IF ) ((AND (NOT (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*|*")) (SETQ clayr this_layer) (clnmstd) ) ;_ end of AND (IF (WCMATCH (STRCASE new_userd) "NILS") NIL (SETQ thisname (STRCAT clayr "-" new_userd) thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST usrd nil cusrd nil usdf nil ) ;_ end of SETQ ) ;_ end of IF ) ((AND (NOT (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*|*")) (SETQ clayr this_layer) (NOT (clnmstd)) ) ;_ end of AND (IF (MEMBER this_layer skip_lst) NIL (PROGN (SETQ skip_lst (APPEND skip_lst (LIST this_layer))) (nonstd-nomod-msg this_layer) ) ;_ end of PROGN ) ;_ end of IF ) ) ;_ end of COND (force_layonthaw thisname) (make_layer_ent (LIST (CONS 8 thisname))) (ENTMOD this_ent) (SETQ cnt (1+ cnt)) ) ;_ end of WHILE ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN c:clg5user (/ clg5userd_ss skip_lst) (SETQ skip_lst NIL) (IF ustr NIL (LOAD "USTR" "\nFile USTR.LSP not loaded! ") ) ;_ end of IF (SETQ new_userd5 (ustr 1 "Enter new user defined group string to assign, NILS for none" (IF new_userd5 new_userd5 "" ) ;_ end of IF nil ) ;_ end of ustr ) ;_ end of SETQ (WHILE (NOT new_userd5) (SETQ new_userd5 (ustr 1 "Enter new user defined group string to assign, NILS for none)" (IF new_userd5 new_userd5 "" ) ;_ end of IF nil ) ;_ end of ustr ) ;_ end of SETQ ) ;_ end of WHILE ;;; (IF allclg5_userd ;;; (SETQ clg5users_ss (SSGET '((8 . "*[~|]???????*")))) (SETQ clg5userd_ss (SSGET)) ;;; ) (IF clg5userd_ss (PROGN (SETQ cnt 0) (SETQ clg5userd_sslen (SSLENGTH clg5userd_ss)) (SETQ laupdnmlst NIL) (IF make_layer_ent NIL (LOAD "make_layer_ent" "\nFile MAKE_LAYER_ENT.LSP not loaded! " ) ;_ end of LOAD ) ;_ end of IF (WHILE (< cnt clg5userd_sslen) (SETQ this_ent (ENTGET (SSNAME clg5userd_ss cnt))) (SETQ this_layer (CDR (ASSOC 8 this_ent))) (COND ((AND (NOT (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*|*")) (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*--????") ;;; (OR ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*--NPLT") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*--LV##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*--SC##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*--PL##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*--PH##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*--AL##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*--EL##") ;;; ) ;_ end of OR (SETQ clayr this_layer) (clnmstd) ) ;_ end of AND (IF (WCMATCH (STRCASE new_userd5) "NILS") (SETQ thisname (SUBSTR clayr 1 (- (STRLEN clayr) 6)) thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST usrd nil cusrd nil usdf nil ) ;_ end of SETQ (SETQ thisname (STRCAT (SUBSTR clayr 1 (- (STRLEN clayr) 5) ) ;_ end of SUBSTR new_userd5 ) ;_ end of STRCAT thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST ) ;_ end of SETQ ) ;_ end of IF ) ((AND (NOT (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*|*")) (OR (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "???????????-*") (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "???????-*") ) ;;; (OR ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-NPLT") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-LV##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-SC##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-PL##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-PH##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-AL##") ;;; (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*-EL##") ;;; ) ;_ end of OR (SETQ clayr this_layer) (clnmstd) ) ;_ end of AND (IF (WCMATCH (STRCASE new_userd5) "NILS") (SETQ thisname (SUBSTR clayr 1 11) thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST usrd nil cusrd nil usdf nil ) ;_ end of SETQ (SETQ thisname (STRCAT (SUBSTR clayr 1 (IF (> (STRLEN clayr) 10) 11 7 ) ) ;_ end of SUBSTR new_userd5 ) ;_ end of STRCAT thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST ) ;_ end of SETQ ) ;_ end of IF ) ((AND (NOT (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*|*")) (SETQ clayr this_layer) (clnmstd) ) ;_ end of AND (IF (WCMATCH (STRCASE new_userd5) "NILS") NIL (SETQ thisname (STRCAT clayr "-" new_userd5) thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST usrd nil cusrd nil usdf nil ) ;_ end of SETQ ) ;_ end of IF ) ((AND (NOT (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*|*")) (SETQ clayr this_layer) (NOT (clnmstd)) ) ;_ end of AND (IF (MEMBER this_layer skip_lst) NIL (PROGN (SETQ skip_lst (APPEND skip_lst (LIST this_layer))) (nonstd-nomod-msg this_layer) ) ;_ end of PROGN ) ;_ end of IF ) ) ;_ end of COND (force_layonthaw thisname) (make_layer_ent (LIST (CONS 8 thisname))) (ENTMOD this_ent) (SETQ cnt (1+ cnt)) ) ;_ end of WHILE ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN C:SRLAYER () (SETQ skip_lst NIL) (IF ustr NIL (LOAD "USTR" "\nFile USTR.LSP not loaded! ") ) ;_ end of IF (SETQ chstr (ustr 1 (STRCAT "Enter full or partial layer name to replace.") (IF chstr chstr "" ) ;_ end of IF nil ) ;_ end of ustr ) ;_ end of SETQ (SETQ ss1 (SSGET (LIST (CONS 8 (STRCAT "*" chstr "*"))))) (IF ss1 (PROGN (SETQ nwstr (ustr 1 (STRCAT "Enter new string to replace " chstr " with in selected entity layers.") (IF nwstr nwstr "" ) ;_ end of IF nil ) ;_ end of ustr ) ;_ end of SETQ (IF (AND ss1 nwstr) (PROGN (SETQ cnt 0) (SETQ ss1len (SSLENGTH ss1)) (SETQ laupdnmlst NIL) (IF make_layer_ent NIL (LOAD "make_layer_ent" "\nFile MAKE_LAYER_ENT.LSP not loaded! " ) ;_ end of LOAD ) ;_ end of IF (IF srstring NIL (LOAD "srstring" "\nFile SRSTRING.LSP not loaded! ")) (WHILE (< cnt ss1len) (SETQ this_ent (ENTGET (SSNAME ss1 cnt))) (SETQ this_layer (CDR (ASSOC 8 this_ent))) (SETQ thisname (srstring this_layer chstr nwstr) thiscolor (SUBSTR thisname 7 1) thisltype (SUBSTR thisname 2 1) this_ent (SUBST (CONS 8 thisname) (ASSOC 8 this_ent) this_ent ) ;_ end of SUBST ) ;_ end of SETQ (COND ((AND (NOT (WCMATCH (STRCASE (CDR (ASSOC 8 this_ent))) "*|*")) (SETQ clayr this_layer) (NOT (clnmstd)) ) ;_ end of AND (IF (MEMBER this_layer skip_lst) NIL (PROGN (SETQ skip_lst (APPEND skip_lst (LIST this_layer))) (nonstd-nomod-msg this_layer) ) ;_ end of PROGN ) ;_ end of IF ) ) ;_ end of COND (force_layonthaw thisname) (make_layer_ent (LIST (CONS 8 thisname))) (ENTMOD this_ent) (SETQ cnt (1+ cnt)) ) ;_ end of WHILE ) ;_ end of PROGN ) ;_ end of IF ) ) (PRINC) ) ;;;**************************************************************************** (DEFUN C:APPENDLAYER ();appends a user specified string to the layer name of selected objects while maintaining the color and linetype of the original layer (SETQ thess (ssget)) (IF thess (PROGN (SETQ thess_len (SSLENGTH thess)) (SETQ cnt 0) (IF ustr NIL (LOAD "ustr" "\nFile USTR.LSP not loaded! ")) (SETQ new_layer_suffix (ustr 1 "Enter new layer suffix" (IF new_layer_suffix new_layer_suffix "") T)) (WHILE (< cnt thess_len) (SETQ this_ent (ENTGET (SSNAME thess cnt))) (SETQ this_layer_name (CDR (ASSOC 8 this_ent))) (SETQ this_layer_data (tblsearch "layer" this_layer_name)) (SETQ thisltname (CDR (ASSOC 6 this_layer_data))) (SETQ thiscolor (ITOA (CDR (ASSOC 62 this_layer_data)))) (SETQ thisname (STRCAT this_layer_name new_layer_suffix)) (SETQ this_ent (SUBST (CONS 8 thisname)(ASSOC 8 this_ent) this_ent)) (ENTMOD this_ent) (layentupdate);requires string values assigned to thisname, thisltname, thiscolor (SETQ cnt (1+ cnt)) ) ) ) (PRINC) ) ;;;**************************************************************************** (DEFUN C:CLTHID () (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ") ) ;_ end of IF (SETQ clthid_ltype (ukword 1 "Half Normal" "Half size or Normal hidden linetype? [Half/Normal]" (IF clthid_ltype clthid_ltype "Normal" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ (IF (WCMATCH clthid_ltype "Half") (SETQ new_ltype "I") (SETQ new_ltype "H") ) ;_ end of IF (SETQ new_color "1" from_clthid T ) ;_ end of SETQ (C:CLGLTYPE) (C:CLGCOLOR) (SETQ from_clthid NIL) ) ;_ end of DEFUN (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! ***|;