;;;Turn off layers, freeze layers, set to a layer, etc. by entity selection.
;;;C:SHOLAY displays entity properties and associated layers so the correct layer
;;;can be selected for action.
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 2-5-96
;;;>		   EDITED: 01-16-2007
;;;
(defun SHOLAY_ERROR (msg / )
  (TERM_DIALOG)
  (SETQ *ERROR* OLD_ERROR)
  (PRINC msg)
  (PRINC)
)
(defun c:sholay ( / blees nentl etype onentl act_lay act_ndx blk_type oiname); oiname nent
  (setq OLD_ERROR *ERROR*)
  (SETQ *ERROR* SHOLAY_ERROR)
  (while
    (setq get_nent (nentsel "\nSelect object to show layer(s)"))
    (setq attr_ent nil)
    (if (and(not(entget(car get_nent)))(eq(type(last get_nent))'LIST)(eq(type(car(last get_nent)))'ENAME))
      (setq nent (LIST(car(last get_nent))(cadr get_nent)))
      (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
        (if (ASSOC 62 (entget(car orig_ent)))
          (setq ecolor (cdr(assoc 62(entget(car orig_ent)))))
        )
        (if (ASSOC 62 (entget(car nent)))
          (setq ecolor (cdr(assoc 62(entget(car nent)))))
        )
      )
      (if attr_ent
        (if (ASSOC 6 (entget(car orig_ent)))
          (setq eltyp (cdr(assoc 6(entget(car orig_ent)))))
	)
        (if (ASSOC 6 (entget(car nent)))
          (setq eltyp (cdr(assoc 6(entget(car nent)))))
        )
      )
    (setq laent (tblsearch "layer" nentl))
    (IF (AND (= ecolor 0) onentl)
      (setq ecolor (strcat "BYBLOCK="(itoa(cdr(assoc 62 (tblsearch "layer" onentl))))))
      (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)
      (setq layer_list (LIST nentl onentl))
      (setq layer_list (LIST nentl))
    )
    (SETQ sholay_dlg# (LOAD_DIALOG "sholay"))
    (SETQ newdlg_sholay
	   (NEW_DIALOG
	     "sholay"
	     sholay_dlg#
	     (IF defact_sholay
	       defact_sholay
	       ""
	     ) ;_ end of IF
	     (IF sholay_loc
	       sholay_loc
	       '(-1 -1)
	     ) ;_ end of IF
	   ) ;_ end of NEW_DIALOG
    ) ;_ end of SETQ
    (IF layer_list
      (set_sholay_list "layer_list" layer_list)
    )
    (IF select_list
      (set_sholay_list "select_list" select_list)
      (set_sholay_list "select_list" (list ""))
    )
    (MODE_TILE "layer_list" 2)
    (SET_TILE "lay_entity" etype)
    (SET_TILE "blk_type" (IF blk_type (strcat "in " blk_type ":") "(not nested)"))
    (IF blk_type
      (SET_TILE "oiname" (IF oiname oiname ""))
    )
    (COND
      ((AND ecolor (EQ (TYPE ecolor) 'STR))
        (SET_TILE "lay_color" ecolor))
      ((AND ecolor (= ecolor 0) onentl)
        (SET_TILE "lay_color" (strcat "BYBLOCK="(itoa(cdr(assoc 62 (tblsearch "layer" onentl)))))))
    )
    (IF (AND eltyp (EQ (TYPE eltyp) 'STR))
      (SET_TILE "lay_ltype" eltyp)
    )
    (ACTION_TILE "layer_list" "(setq act_ndx $value)(set_sel_list)")
    (ACTION_TILE "select_list" "")
    (ACTION_TILE "append_user" "(setq exit_fun \"append_user\")(setq usrd (get_tile\"ap_this\"))(setq sholay_loc(done_dialog 1))")
    (ACTION_TILE "sel_clear" "(setq act_ndx nil select_list nil)(set_sel_list)")
    (ACTION_TILE "lay_set" "(setq exit_fun \"lay_set\")(setq sholay_loc(done_dialog 1))")
    (ACTION_TILE "lay_off" "(setq exit_fun \"lay_off\")(setq sholay_loc(done_dialog 1))")
    (ACTION_TILE "lay_freeze" "(setq exit_fun \"lay_freeze\")(setq sholay_loc(done_dialog 1))")
    (ACTION_TILE "lay_vpfreeze" "(setq exit_fun \"lay_vpfreeze\")(setq sholay_loc(done_dialog 1))")
    (ACTION_TILE "lay_isolate" "(setq exit_fun \"lay_isolate\")(setq sholay_loc(done_dialog 1))")
    (ACTION_TILE "lay_lock" "(setq exit_fun \"lay_lock\")(setq sholay_loc(done_dialog 1))")
    (ACTION_TILE "lay_unlock" "(setq exit_fun \"lay_unlock\")(setq sholay_loc(done_dialog 1))")
    (ACTION_TILE "lay_xrof" "(setq exit_fun \"lay_xrof\")(setq sholay_loc(done_dialog 1))")
    (ACTION_TILE "sel_again" "(setq act_ndx nil exit_fun \"sel_again\")(setq sholay_loc(done_dialog 0))")
    (ACTION_TILE "Cancel" "(setq act_ndx nil exit_fun \"Cancel\")(setq sholay_loc(done_dialog 0))")
    (START_DIALOG)
    (UNLOAD_DIALOG sholay_dlg#)
    (princ)
    (IF select_list
      (PROGN
	(SETQ str_list NIL)
        (foreach n select_list
	  (if str_list
            (setq str_list (strcat str_list "," n))
	    (setq str_list n)
	  )
	)
      )
    )
      (COND ((AND (EQ exit_fun "lay_set") act_lay)
	     (if (wcmatch act_lay "*|*")
	       (while (wcmatch act_lay "*|*")
		 (setq act_lay (substr act_lay 2))
	       )
	     )
             (setq nentl act_lay)
             (lay_set)
             (setq select_list nil)
	     )
            ((EQ exit_fun "lay_set")
             (PRINC "\nLayer name not specified, please try again. "))
	    ((EQ exit_fun "append_user")
	     (foreach n select_list
	       (if (tblsearch "layer" (strcat n "-" usrd))
		 (PRINC (strcat "\nLayer " n "-" usrd " exists, not renamed. "))
	         (command "-rename" "la" n (strcat n "-" usrd))
	       ))
	     (setq select_list nil))
	    ((EQ exit_fun "lay_off")
               (command nil nil nil)
               (command ".layer" "off" str_list "")
               (command nil nil nil)
               (setq select_list nil)
	     )
	    ((EQ exit_fun "lay_freeze")
               (command nil nil nil)
               (command ".layer" "f" str_list "")
               (command nil nil nil)
               (setq select_list nil)
	     )
	    ((EQ exit_fun "lay_vpfreeze")
	     (command ".vplayer" "f" str_list "" "")
             (setq select_list nil)
	     )
	    ((AND (car select_list)(EQ exit_fun "lay_lock"))
	     (command ".layer" "lo" str_list "")
             (setq select_list nil)
             )
	    ((AND (car select_list)(EQ exit_fun "lay_unlock"))
	     (command ".layer" "u" str_list "")
             (setq select_list nil)
             )
	    ((AND (car select_list)(EQ exit_fun "lay_isolate"))
             (IF (AND (EQ (GETVAR "expert") 0)(WCMATCH (GETVAR "clayer")(STRCASE (car select_list))))
               (PROGN
                 (command nil nil nil)
                 (IF (WCMATCH (car select_list) "*|*")
                   (command ".layer" "on" "0" "t" "0" "s" "0" "off" "*" "y" "on" str_list "")
                   (command ".layer" "s" (car select_list) "off" "*" "y" "on" str_list "")
                 )
                 (command nil nil nil)
               )
               (PROGN
                 (command nil nil nil)
                 (IF (WCMATCH (car select_list) "*|*")
                   (command ".layer" "on" "0" "t" "0" "s" "0" "off" "*" "on" str_list "")
                   (command ".layer" "s" (car select_list) "off" "*" "on" str_list "")
                 )
                 (command nil nil nil)
               )
             )
             (setq select_list nil)
	     )
	    ((EQ exit_fun "lay_xrof")
             (if (wcmatch str_list "*|*")
               (progn
                 (setq laystrcnt 1
                       startcnt 1
                       laystrlen (strlen str_list)
                       xrof_list NIL
                 )
                 (while (< laystrcnt laystrlen)
                   (if (eq (substr str_list startcnt 1) ",")
                     (setq startcnt (1+ startcnt)
                           laystrcnt (1+ startcnt)
                     )
                   )
                   (if (wcmatch (substr str_list laystrcnt 1) "|")
                     (setq xrof_list
                            (if xrof_list
                              (strcat xrof_list "," (substr str_list startcnt (- laystrcnt startcnt)) "*")
                              (strcat (substr str_list startcnt (- laystrcnt startcnt))"*")
                            )
                           startcnt (1+ laystrcnt)
                           laystrcnt (1+ startcnt)
                     )
                   )
                   (setq laystrcnt (1+ laystrcnt))
                 )
               )
             )
             (princ "\n")
             (princ xrof_list)
             (princ "\n")
             (princ)
	     (command ".layer" "off" xrof_list "")
             (setq select_list nil)
	     )
	    ((EQ exit_fun "sel_again")
	     (princ))
	    (T
	     (setq select_list nil))
      )
;;;    (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)
    (IF select_list
      (progn
	(princ (strcat "\nNo layer selected " (if (eq exit_fun "lay_off") "to turn " "to ")(substr exit_fun 5) ". "))
	(princ)
      )
    )
    (setq onentl nil oiname nil ecolor nil eltyp nil exit_fun nil act_ndx nil)
  );while
;;;  (setq *ERROR* nil)
  (setq *ERROR* OLD_ERROR)
  (princ)
);defun
;;;********************************************************************
(defun set_sel_list ()
    (IF (AND act_ndx (/= act_ndx ""))
      (SETQ act_lay (nth (Read act_ndx) layer_list))
      (SETQ act_lay nil)
    )
  (IF (AND act_lay (EQ (TYPE act_lay) 'STR))
    (PROGN
      (IF (MEMBER act_lay select_list)
	NIL
	(PROGN
          (SETQ select_list (APPEND select_list (LIST act_lay)))
          (set_sholay_list "select_list" select_list)
	)
      )
    )
    (set_sholay_list "select_list" (LIST ""))
  )
  (PRINC)
)
;;;********************************************************************
(DEFUN set_sholay_list (list_key list_name /)
  (START_LIST list_key 3)
  (MAPCAR 'ADD_LIST list_name)
  (END_LIST)
  (PRINC)
) ;_ end of defun
;;;********************************************************************
(DEFUN lay_set ()
          (if clnmstd nil (load "mklayr" "\nFile MKLAYR.LSP not loaded! "))
          (setq clayr nentl)
	  (if(<(strlen nentl)8)
	    (setq modf nil)
	  )
          (if (and
		(clnmstd)
	        (not(=(STRCASE(SUBSTR clayr 1 3))"PS-"))
	      )
            (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
       (COND
	 ((>= (STRLEN clayr) 8) (SETQ modf (COND
					     ((OR
						(WCMATCH(STRCASE(SUBSTR clayr 11))"#P")
						(WCMATCH(STRCASE(SUBSTR clayr 11))"#P##"))
						(SUBSTR clayr 8 ))
					     ((AND(>(strlen clayr)12)(EQ(SUBSTR clayr 12 1)"-"))
					      (SUBSTR clayr 8 4))
					     ((>=(strlen clayr)11)(SUBSTR clayr 8 4))
					   )))
       ) ;_ end of cond
       (COND
	 ((AND(>=(strlen clayr)16)(EQ(SUBSTR clayr 12 1)"-"))
	  (SETQ usrd (SUBSTR clayr 13 4)))
	 (T (SETQ usrd ""))
       ) ;_ end of cond
	  (c:mklayr)
          (command ".layer" (IF (EQ loper "Set") "Make" loper) nentl "")
	  (COND
	    ((OR
		(WCMATCH (STRCASE nentl) "*6NOTE*")
		(WCMATCH (STRCASE nentl) "*6DIMS*")
		(WCMATCH (STRCASE nentl) "*6TEXT*")
		(WCMATCH (STRCASE nentl) "*6ATTR*")
		(WCMATCH (STRCASE nentl) "*6TX##*")
              )
	    (COMMAND ".layer" "c" "6" nentl ""))
	    ((OR
               (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z][- C N T D A V H I M P Q S E X F]????C*")
               (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z][- C N T D A V H I M P Q S E X F]????C*"))
	    (COMMAND ".layer" "c" "250" nentl ""))
	    ((OR
               (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z][- C N T D A V H I M P Q S E X F]????D*")
               (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z][- C N T D A V H I M P Q S E X F]????D*"))
	    (COMMAND ".layer" "c" "251" nentl ""))
	    ((OR
               (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z][- C N T D A V H I M P Q S E X F]????E*")
               (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z][- C N T D A V H I M P Q S E X F]????E*"))
	    (COMMAND ".layer" "c" "252" nentl ""))
	    ((OR
               (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z][- C N T D A V H I M P Q S E X F]????F*")
               (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z][- C N T D A V H I M P Q S E X F]????F*"))
	    (COMMAND ".layer" "c" "253" nentl ""))
	    ((OR
               (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z][- C N T D A V H I M P Q S E X F]????G*")
               (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z][- C N T D A V H I M P Q S E X F]????G*"))
	    (COMMAND ".layer" "c" "254" nentl ""))
	    ((OR
               (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z][- C N T D A V H I M P Q S E X F]????H*")
               (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z][- C N T D A V H I M P Q S E X F]????H*"))
	    (COMMAND ".layer" "c" "255" nentl ""))
	  )
	  (COND
	    ((OR
		(WCMATCH (STRCASE nentl) "*6NOTE*")
		(WCMATCH (STRCASE nentl) "*6DIMS*")
		(WCMATCH (STRCASE nentl) "*6TEXT*")
		(WCMATCH (STRCASE nentl) "*6ATTR*")
		(WCMATCH (STRCASE nentl) "*6TX##*")
                (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z]-????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]")
                (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z]-????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]")
                (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z]-????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]????")
                (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z]-????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]????")
                (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z]-????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]????-????")
                (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z]-????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]????-????")
              )
	    (COMMAND ".layer" "L" "continuous" nentl ""))
	    ((OR
                (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z]C????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]*")
                (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z]C????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]*")
                (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z]C????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]????")
                (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z]C????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]????")
                (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z]C????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]????-????")
                (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z]C????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]????-????")
		)
             (IF (tblsearch "ltype" "CENTER")
	       (COMMAND ".layer" "L" "CENTER" nentl "")
               (PROGN
                 (COMMAND ".-linetype" "L" "CENTER" "ACAD.LIN")
                 (COMMAND ".layer" "L" "CENTER" nentl "")
               )
             )
             )
	    ((OR
                (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z]H????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]*")
                (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z]H????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]*")
                (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z]H????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]????")
                (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z]H????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]????")
                (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z]H????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]????-????")
                (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z]H????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]????-????")
              )
             (IF (tblsearch "ltype" "HIDDEN")
               (COMMAND ".layer" "L" "HIDDEN" nentl "")
               (PROGN
                 (COMMAND ".-linetype" "L" "HIDDEN" "ACAD.LIN")
                 (COMMAND ".layer" "L" "HIDDEN" nentl "")
               )
             )
             )
	    ((OR
                (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z]P????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]*")
                (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z]P????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]*")
                (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z]P????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]????")
                (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z]P????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]????")
                (WCMATCH (STRCASE nentl) "[A C E F G I L M O P Q S T Z]P????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]????-????")
                (WCMATCH (STRCASE nentl) "*|[A C E F G I L M O P Q S T Z]P????[1 2 3 4 5 6 7 8 9 0 A B C D E F G H I]????-????")
              )
             (IF (tblsearch "ltype" "PHANTOM")
               (COMMAND ".layer" "L" "PHANTOM" nentl "")
               (PROGN
                 (COMMAND ".-linetype" "L" "PHANTOM" "ACAD.LIN")
                 (COMMAND ".layer" "L" "PHANTOM" nentl "")
               )
             )
             )
	  )
)
;;;********************************************************************
(princ)