;;;Turn off layers, freeze layers, or set to a layer by entity selection.
;;;C:SHOLAY will display entity layer data to the command line.
;;;
;;;	AUTHOR: HENRY C. FRANCIS
;;;		425 N. Ashe Street
;;;		Southern Pines, NC 28387
;;;
;;;		All rights reserved without prejudice.
;;;
;;;	Copyright:	2-5-96
;;;	Edited:		2-8-96
;;;
(defun c:laybent ( / lnlen xrnm lmsg blees nentl orig_ent)
  (setq lstr ""
        unmkl (getvar"clayer"))
  (if clnmstd nil (load"mklayr"))
;  (initget 0 "Off Freeze Set Vpfreeze")
;  (setq loper (getkword "\nOff\\Freeze\\Set\\Vpfreeze <Set>"))
  (setq loper (ukword 1 "Off Freeze Set Isolate Vpfreeze" "\nOff\\Freeze\\Set\\Isolate\\Vpfreeze" (if loper loper "Set")))
  (if (or(eq loper "Set")(eq loper nil))
    (progn
      (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)))
	    )
	  )
          (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)))))
            );if
            (setq nentl (cdr(assoc 8(entget(car nent)))))
          );if
	  (if (and
		(eq loper "Set")
		(wcmatch(cdr(assoc 8(entget(car nent))))"*|*")
              )
	    (setq loper "Make")
	  )
          (setq lnlen (strlen nentl))
          (while (> lnlen 0)
            (if(eq(substr nentl lnlen 1)"|")
              (setq nentl (substr nentl (1+ lnlen))
                    lmsg (strcat "\nSet current layer to " nentl ". ")
                    lnlen 0
              );setq
              (setq lnlen (1- lnlen))
            );if
          );while
          (if lmsg nil (setq lmsg (strcat "\nLayer " nentl " has been made the current layer. ")))
          (if loper nil (setq loper "Set"))
          (if c:mklayr nil (load"mklayr"))
          (setq clayr nentl)
	  (if(<(strlen nentl)8)
	    (setq modf nil)
	  )
          (if (clnmstd)
            (setq 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)
                  colra (if(=(type(read(substr clayr 7 1)))'INT)
                          nil
                          (substr clayr 7 1))
            );setq
          );if
          (if (>=(strlen nentl)8)
            (setq modf (substr nentl 8))
          );if
	  (c:mklayr)
          (command ".layer" loper nentl "")
        );progn
        (princ "\nNothing selected. ")
      );if nent
    );progn
    (progn
      (while
        (and
          (setq nent (nentsel))
          (<=(strlen lstr)216)
        );and
        (setq orig_ent 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)))
            )
          )
	)
        (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(nth 0 nent)))))
          );if
	  (if (and attr_ent (eq(cdr(assoc 8(entget(car orig_ent))))"0"))
            (setq nentl (cdr(assoc 8(entget(nth 0 nent)))))
            (setq nentl (cdr(assoc 8(entget(nth 0 orig_ent)))))
	  )
        );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)))
            (princ lmsg))
          ((eq loper "Vpfreeze")
              (setq lmsg (strcat "\nLayer " nentl " selected for vplayer/freezing. ")
                    lstr (if(>(strlen lstr)0)(strcat lstr","nentl)nentl))
            (princ lmsg))
          ((eq loper "Off")
            (if (eq(getvar"clayer")nentl)
              (princ (strcat "\nLayer " nentl " is the current layer and will not be turned off. "))
              (setq lmsg (strcat "\nLayer " nentl " selected to be turned off. ")
                    lstr (if(>(strlen lstr)0)(strcat lstr","nentl)nentl))
            )
            (princ lmsg))
          ((eq loper "Isolate")
;            (if (eq(getvar"clayer")nentl)
;              (princ (strcat "\nLayer " nentl " is the current layer and will not be turned off. "))
              (setq lmsg (strcat "\nLayer " nentl " selected to be isolated. ")
                    lstr (if(>(strlen lstr)0)(strcat lstr","nentl)nentl))
;            )
            (princ lmsg))
        );cond
      );while
    );progn
  );if
  (if lstr
    (progn
      (if (eq loper "Vpfreeze")
        (command ".vplayer" "freeze" lstr "current" "")
        (if (eq loper "Isolate")
          (command ".layer" "off" "*" "on" lstr "")
          (command ".layer" loper lstr "")
        )
      )
      (setq old_loper loper)
      (if(/= loper "Make")
        (princ(strcat "\nUndo now or type \"UNLAY\" at any time to reverse latest layer " loper " operation. "))
        (princ(strcat "\nUndo now or type \"UNLAY\" at any time to Set layer back to " unmkl))
      );if
    )
    (princ "\nNothing selected. ")
  )
  (princ lmsg)
  (princ)
);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 ""))
  );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)
          colra (if(=(type(read(substr clayr 7 1)))'INT)
                  nil
                  (substr clayr 7 1))
    );setq
  );if
  (princ)
);defun
(defun c:sholay ( / blees nentl etype onentl); oiname nent
  (while
    (setq get_nent (nentsel "\nSelect object to show layer(s)"))
    (setq attr_ent nil)
    (setq nent get_nent)
    (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)))
        )
      )
    )
    (if
      (>(length nent)2)
      (if
        (or(> blees 1)(=(cdr(assoc 8(entget(car nent))))"0"))
	(progn
          (setq onentl (cdr(assoc 8(entget(caar(reverse nent))))))
	  (setq oiname (cdr(assoc 2(entget(caar(reverse nent))))))
          (setq nentl (cdr(assoc 8(entget(car nent)))))
          (setq etype (cdr(assoc 0(entget(car nent)))))
	  (setq blk_def (tblsearch "BLOCK" oiname))
	  (if blk_def
	    (if(eq(boole 1 (cdr(assoc 70 blk_def))4)4)
              (setq blk_type "Xref")
              (setq blk_type "Block")
            )
	  )
	);progn
	(progn
          (setq nentl (cdr(assoc 8(entget(car nent)))))
          (setq etype (cdr(assoc 0(entget(car nent)))))
          (setq onentl (cdr(assoc 8(entget(caar(reverse nent))))))
	  (setq oiname (cdr(assoc 2(entget(caar(reverse nent))))))
	  (setq blk_def (tblsearch "BLOCK" oiname))
	  (if blk_def
	    (if(eq(boole 1 (cdr(assoc 70 blk_def))4)4)
              (setq blk_type "Xref")
              (setq blk_type "Block")
	    )
	  )
	);progn
      );if
      (progn
        (setq nentl (cdr(assoc 8(entget(car nent)))))
	(if attr_ent
	  (progn
	    (setq orig_nentl (cdr(assoc 8(entget(car orig_ent)))))
            (setq onentl nentl)
	    (setq nentl orig_nentl)
	    (setq oiname "")
            (setq blk_type "A Block")
            (setq etype (cdr(assoc 0(entget(car orig_ent)))))
	  )
          (setq etype (cdr(assoc 0(entget(car nent)))))
	)
      );progn
    );if
    (if attr_ent
      (progn
        (setq ecolor (cdr(assoc 62(entget(car orig_ent)))))
        (setq eltyp (cdr(assoc 6(entget(car orig_ent)))))
      )
      (progn
        (setq ecolor (cdr(assoc 62(entget(car nent)))))
        (setq eltyp (cdr(assoc 6(entget(car nent)))))
      )
    )
    (setq laent (tblsearch "layer" nentl))
    (if ecolor nil
      (setq ecolor (strcat "BYLAYER="(itoa(cdr(assoc 62 laent)))))
    )
    (if eltyp nil
      (setq eltyp (strcat "BYLAYER="(cdr(assoc 6 laent))))
    )
    (if(and onentl oiname)
      (princ (strcat "\n" etype " on layer " nentl " in " blk_type " " oiname " on layer " onentl))
      (princ (strcat "\n" etype " on layer " nentl " "))
    );if
    (princ " color: ")
    (princ ecolor)
    (princ " linetype: ")
    (princ eltyp)
    (setq onentl nil oiname nil ecolor nil eltyp nil)
  );while
  (princ)
);defun