;;;Turn off layers, freeze layers, or set to a layer by entity selection. ;;; ;;; ;;; AUTHOR: HENRY C. FRANCIS ;;; 425 N. Ashe Street ;;; Southern Pines, NC 28387 ;;; ;;; All rights reserved without prejudice. ;;; ;;; Copyright: 2-5-96 ;;; Edited: 2-21-2004 ;;; ;;; Made C:SHOLAY a separate file ;;; (DEFUN c:laybent (/ lnlen xrnm lmsg blees nentl orig_ent) (vl-load-com) (SETQ old_expert (GETVAR "expert")) (SETVAR "expert" 5) (SETQ lstr "" unmkl (GETVAR "clayer") ) ;_ end of setq (IF (AND clnmstd set_layer_ltype_name) nil (LOAD "mklayr" "\nFile MKLAYR.LSP not loaded! ") ) ;_ end of if (IF ukword nil (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ") ) ;_ end of if (SETQ loper (ukword 1 "Off Freeze Set Isolate VPFreeze VPReset" "\nOff\\Freeze\\Set\\Isolate\\VPFreeze\\VPReset" (IF loper loper "Set" ) ;_ end of if ) ;_ end of ukword ) ;_ end of setq (IF (OR (EQ loper "Set") (EQ loper nil)) (PROGN (IF C:MKLAYR NIL (LOAD "MKLAYR" "\nFile MKLAYR.LSP not loaded! ") ) ;_ end of if (SETQ nent (NENTSEL)) (SETQ blees (LENGTH (CAR (REVERSE nent)))) (IF nent (PROGN (SETQ orig_ent nent) (IF (EQ (CDR (ASSOC 0 (ENTGET (CAR nent)))) "ATTRIB") (WHILE (/= (CDR (ASSOC 0 (ENTGET (CAR nent)))) "SEQEND") (SETQ nent (LIST (ENTNEXT (CAR nent)) (CDR nent))) ) ;_ end of while ) ;_ end of if (IF (EQ (TYPE (CAAR (REVERSE nent))) 'ENAME) (SETQ nent (CAR (REVERSE NENT))) ) ;_ end of if (IF (> (LENGTH nent) 2) (IF (OR (> blees 1) (= (CDR (ASSOC 8 (ENTGET (CAR nent)))) "0")) (SETQ nentl (CDR (ASSOC 8 (ENTGET (CAAR (REVERSE nent)))))) (SETQ nentl (CDR (ASSOC 8 (ENTGET (CAR nent))))) ) ;_ end of IF (IF (AND (EQ (TYPE (CADR nent)) 'ENAME) (WCMATCH (STRCASE (CDR (ASSOC 8 (ENTGET (CAR nent))))) "*HIDE*" ) ;_ end of WCMATCH ) (SETQ nentl (CDR (ASSOC 8 (ENTGET (CADR nent))))) (SETQ nentl (CDR (ASSOC 8 (ENTGET (CAR nent))))) ) ;_ end of IF ) ;_ end of IF (IF (AND (EQ loper "Set") (WCMATCH (CDR (ASSOC 8 (ENTGET (CAR nent)))) "*|*") ) ;_ end of and (SETQ loper "Make") ) ;_ end of if (SETQ lnlen (STRLEN nentl)) (WHILE (AND (> lnlen 0)(WCMATCH nentl "*|*")) (IF (WCMATCH nentl "|*") (SETQ nentl (SUBSTR nentl 2) lmsg (STRCAT "\nSet current layer to " nentl ". ") lnlen 1 ) ;_ end of SETQ ) ;_ end of IF (SETQ lnlen (1- lnlen)) ) ;_ end of WHILE (IF lmsg nil (SETQ lmsg (STRCAT "\nLayer " nentl " has been made the current layer. " ) ;_ end of strcat ) ;_ end of setq ) ;_ end of if (IF loper nil (SETQ loper "Set") ) ;_ end of if (SETQ clayr nentl) (IF (< (STRLEN nentl) 8) (SETQ modf nil) ) ;_ end of if (IF (clnmstd) ;(NOT (= (STRCASE (SUBSTR clayr 1 3)) "PS-")) (SETQ mjrg (SUBSTR clayr 1 1) llt (SUBSTR clayr 2 1) prod (SUBSTR clayr 3 4) modf (SUBSTR clayr 8 4) colr (IF (= (TYPE (READ (SUBSTR clayr 7 1))) 'INT) (SUBSTR clayr 7 1) nil ) ;_ end of if colra (IF (= (TYPE (READ (SUBSTR clayr 7 1))) 'INT) nil (SUBSTR clayr 7 1) ) ;_ end of if colri (IF (= (TYPE (READ (SUBSTR clayr 7 1))) 'INT) nil (COND ((AND colra (= (STRCASE colra) "A")) (SETQ colri "10")) ((AND colra (= (STRCASE colra) "B")) (SETQ colri "11")) ((AND colra (= (STRCASE colra) "C")) (SETQ colri "12")) ((AND colra (= (STRCASE colra) "D")) (SETQ colri "13")) ((AND colra (= (STRCASE colra) "E")) (SETQ colri "14")) ((AND colra (= (STRCASE colra) "F")) (SETQ colri "15")) ((AND colra (= (STRCASE colra) "G")) (SETQ colri "16")) ((AND colra (= (STRCASE colra) "H")) (SETQ colri "17")) ((AND colra (= (STRCASE colra) "I")) (SETQ colri "18")) ((AND colra (= (STRCASE colra) "J")) (SETQ colri "19")) ((AND colra (= (STRCASE colra) "K")) (SETQ colri "20")) ((AND colra (= (STRCASE colra) "L")) (SETQ colri "21")) ((AND colra (= (STRCASE colra) "M")) (SETQ colri "22")) ((AND colra (= (STRCASE colra) "N")) (SETQ colri "23")) ((AND colra (= (STRCASE colra) "O")) (SETQ colri "24")) ((AND colra (= (STRCASE colra) "P")) (SETQ colri "25")) ((AND colra (= (STRCASE colra) "Q")) (SETQ colri "26")) ((AND colra (= (STRCASE colra) "R")) (SETQ colri "27")) ((AND colra (= (STRCASE colra) "S")) (SETQ colri "28")) ((AND colra (= (STRCASE colra) "T")) (SETQ colri "29")) ((AND colra (= (STRCASE colra) "U")) (SETQ colri "250")) ((AND colra (= (STRCASE colra) "V")) (SETQ colri "251")) ((AND colra (= (STRCASE colra) "W") (WCMATCH (STRCASE modf) "GRID")) (SETQ colri "169"));CORP Std Grid Color - Minor ((AND colra (= (STRCASE colra) "W")) (SETQ colri "252")) ((AND colra (= (STRCASE colra) "X") (WCMATCH (STRCASE modf) "GRID")) (SETQ colri "109"));CORP Std Grid Color - Intermediate ((AND colra (= (STRCASE colra) "X")) (SETQ colri "253")) ((AND colra (= (STRCASE colra) "Y") (WCMATCH (STRCASE modf) "GRID")) (SETQ colri "56"));CORP Std Grid Color - Primary ((AND colra (= (STRCASE colra) "Y")) (SETQ colri "254")) ((AND colra (= (STRCASE colra) "Z")) (SETQ colri "255")) (T (SETQ colri nil)) ) ;_ end of cond ) ;_ end of if ) ;_ end of SETQ ) ;_ end of IF (COND ((AND (clnmstd) (>= (STRLEN clayr) 8)) (SETQ modf (COND ((OR (WCMATCH (STRCASE (SUBSTR clayr 11)) "#P*") (WCMATCH (STRCASE (SUBSTR clayr 11)) "#P##*") (WCMATCH (STRCASE (SUBSTR clayr 10)) "#[HQ]P*") (WCMATCH (STRCASE (SUBSTR clayr 10)) "#[HQ]P##*") (AND (> (STRLEN clayr) 7) (< (STRLEN clayr) 16)) ) ;_ end of OR (SUBSTR clayr 8) ) ((AND (> (STRLEN clayr) 12) (EQ (SUBSTR clayr 12 1) "-")) (SUBSTR clayr 8 4) ) ) ;_ end of COND ) ;_ end of SETQ ) ) ;_ end of cond (COND ((AND (AND (clnmstd) (>= (STRLEN clayr) 16) (EQ (SUBSTR clayr 12 1) "-"))) (SETQ usrd (SUBSTR clayr 13)) ) (T (SETQ usrd "")) ) ;_ end of cond (IF debug_laybent (PROGN (PRINC "\nmjrg=") (PRINC mjrg) (PRINC "\nltyp=") (PRINC ltyp) (PRINC "\nprod=") (PRINC prod) (PRINC "\ncolr=") (PRINC colr) (PRINC "\ncolra=") (PRINC colra) (PRINC "\ncolri=") (PRINC colri) (PRINC "\nmodf=") (PRINC modf) (PRINC "\nusrd=") (PRINC usrd) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (IF (clnmstd) (PROGN (c:mklayr) (SETQ clayername (GETVAR "clayer")) (SETQ thisname clayr thiscolor (IF (TBLSEARCH "LAYER" clayr) (ITOA (CDR (ASSOC 62 (TBLSEARCH "LAYER" clayr)))) "7") layer_ltype (IF (TBLSEARCH "LAYER" clayr) (CDR (ASSOC 6 (TBLSEARCH "LAYER" clayr))) "Continuous") ) (IF make_layer_ent NIL (LOAD "make_layer_ent" "\nFile MAKE_LAYER_ENT.LSP not loaded! ")) (make_layer_ent (LIST (CONS 8 thisname))) ) (PROGN (SETQ thisname nentl) ) ) (IF (WCMATCH thisname "*|*") (WHILE (WCMATCH thisname "*|*") (SETQ thisname (SUBSTR thisname 2)) (PRINC "\n")\ (PRINC thisname) (PRINC) ) ) (COMMAND ".layer" (IF (EQ loper "Set") "Make" loper) thisname "") (layentupdate) ) ;_ end of PROGN (PRINC "\nNothing selected. ") ) ;_ end of IF ) ;_ end of PROGN (PROGN (IF (OR (EQ loper "VPFreeze") (EQ loper "VPReset")) (vla-put-MSpace (vla-get-Activedocument (vlax-get-Acad-Object)) :vlax-true) ) ;_ end of if (WHILE (AND (SETQ nent (NENTSEL)) (<= (STRLEN lstr) 216) ) ;_ end of AND (SETQ orig_ent nent) (SETQ blees (LENGTH (CAR (REVERSE nent)))) (IF (EQ (CDR (ASSOC 0 (ENTGET (CAR nent)))) "ATTRIB") (PROGN (SETQ attr_ent T) (WHILE (/= (CDR (ASSOC 0 (ENTGET (CAR nent)))) "SEQEND") (SETQ nent (LIST (ENTNEXT (CAR nent)) (CDR nent))) ) ;_ end of while ) ;_ end of progn ) ;_ end of if (IF (> (LENGTH nent) 2) (IF (OR (> blees 1) (= (CDR (ASSOC 8 (ENTGET (CAR nent)))) "0")) (SETQ nentl (CDR (ASSOC 8 (ENTGET (CAAR (REVERSE nent)))))) (IF (AND (ENTGET (CAAR (REVERSE nent))) (WCMATCH (STRCASE (CDR (ASSOC 8 (ENTGET (CAAR (REVERSE nent)))))) (STRCASE "*|g-nplt7hd*") ) ;_ end of wcmatch ) ;_ end of AND (SETQ nentl (CDR (ASSOC 8 (ENTGET (CAAR (REVERSE nent)))))) (IF (ENTGET (NTH 0 nent)) (SETQ nentl (CDR (ASSOC 8 (ENTGET (NTH 0 nent))))) (IF (ENTGET (CAAR (REVERSE nent))) (SETQ nentl (CDR (ASSOC 8 (ENTGET (CAAR (REVERSE nent)))))) ) ;_ end of IF ) ;_ end of IF ) ;_ end of if ) ;_ end of IF (IF (AND attr_ent (EQ (CDR (ASSOC 8 (ENTGET (CAR orig_ent)))) "0") ) ;_ end of and (SETQ nentl (CDR (ASSOC 8 (ENTGET (NTH 0 nent))))) (SETQ nentl (CDR (ASSOC 8 (ENTGET (NTH 0 orig_ent))))) ) ;_ end of if ) ;_ end of IF (SETQ lnlen (STRLEN nentl)) (COND ((EQ loper "Freeze") (IF (EQ (GETVAR "clayer") nentl) (SETQ lmsg (STRCAT "\nCannot freeze current layer " nentl)) (SETQ lmsg (STRCAT "\nLayer " nentl " selected for freezing. ") lstr (IF (> (STRLEN lstr) 0) (STRCAT lstr "," nentl) nentl ) ;_ end of if ) ;_ end of setq ) ;_ end of if (PRINC lmsg) ) ((OR (EQ loper "VPFreeze") (EQ loper "VPReset")) (SETQ lmsg (STRCAT "\nLayer " nentl " selected for vplayer action. ") lstr (IF (> (STRLEN lstr) 0) (STRCAT lstr "," nentl) nentl ) ;_ end of if ) ;_ end of setq (PRINC lmsg) ) ((EQ loper "Off") (IF (EQ (GETVAR "clayer") nentl) (SETQ do_cloff (DOS_MSGBOX (STRCAT "The current layer\n" (GETVAR "clayer") "\nwill be turned off" ) ;_ end of strcat "Current Layer Status" 2 1 ) ;_ end of dos_msgbox ) ;_ end of setq (SETQ do_cloff 4) ) ;_ end of if (IF (EQ do_cloff 4) (PROGN (SETQ lmsg (STRCAT "\nLayer " nentl " selected to be turned off. ") lstr (IF (> (STRLEN lstr) 0) (STRCAT lstr "," nentl) nentl ) ;_ end of if ) ;_ end of setq (PRINC lmsg) ) ;_ end of progn ) ;_ end of if ) ((EQ loper "Isolate") (SETQ lmsg (STRCAT "\nLayer " nentl " selected to be isolated. ") lstr (IF (> (STRLEN lstr) 0) (STRCAT lstr "," nentl) nentl ) ;_ end of if ) ;_ end of setq (PRINC lmsg) ) ) ;_ end of COND ) ;_ end of WHILE ) ;_ end of PROGN ) ;_ end of IF (IF lstr (PROGN (COND ((EQ loper "VPFreeze") (COMMAND ".vplayer" "freeze" lstr "current" "") ) ((EQ loper "VPReset") (COMMAND ".vplayer" "reset" lstr "current" "") ) ((EQ loper "Isolate") (COMMAND ".layer" "off" "*" "on" lstr "") ) (T (COMMAND ".layer" loper lstr "")) ) ;_ end of cond (SETQ old_loper loper) (IF (/= loper "Make") (PRINC (STRCAT "\nUndo now or type \"UNLAY\" at any time to reverse latest layer " loper " operation. " ) ;_ end of strcat ) ;_ end of princ (PRINC (STRCAT "\nUndo now or type \"UNLAY\" at any time to Set layer back to " unmkl ) ;_ end of strcat ) ;_ end of princ ) ;_ end of IF ) ;_ end of progn (PRINC "\nNothing selected. ") ) ;_ end of if (SETVAR "expert" old_expert) (PRINC lmsg) (PRINC) ) ;_ end of DEFUN (DEFUN c:unlay (/) (COND ((= old_loper "Off") (COMMAND ".layer" "on" lstr "") ) ((= old_loper "Freeze") (COMMAND ".layer" "t" lstr "") ) ((= old_loper "VPFreeze") (COMMAND ".vplayer" "t" lstr "current" "") ) ((= old_loper "Make") (COMMAND ".layer" "s" unmkl "") ) ((= old_loper "Isolate") (COMMAND ".layer" "on" lstr "") ) ) ;_ end of COND (IF (clnmstd) (SETQ clayr (GETVAR "clayer") mjrg (SUBSTR clayr 1 1) llt (SUBSTR clayr 2 1) prod (SUBSTR clayr 3 4) colr (IF (= (TYPE (READ (SUBSTR clayr 7 1))) 'INT) (SUBSTR clayr 7 1) nil ) ;_ end of if colra (IF (= (TYPE (READ (SUBSTR clayr 7 1))) 'INT) nil (SUBSTR clayr 7 1) ) ;_ end of if ) ;_ end of SETQ ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;|«Visual LISP© Format Options» (84 2 40 2 T "end of " 60 9 2 0 0 nil T nil T) ;*** DO NOT add text below the comment! ***|;