;;;C:XRLAYERS writes XREF layers to file.  C:RXRLAY sets XREF layer color/linetype from file.
;;;C:RLAYERS strips filename prefix and sets layer color/linetype from file.
;;;If XREF layer linetype is overridden in current drawing but not in settings file, linetype will remain unchanged.
;;;Turn off VISRETAIN, reopen the file, turn on VISRETAIN, then use C:RXRLAY to full effect.
;;;
;;;If symbol named write_ltype_needs is not nil, filename ltneeds.txt is written/appended with ltype needs.
;;;
;;;
;;;
;;;
;;;	Added Xref layer settings import (same layer names, different xref name prefix)
;;;	type IMPORTXRL at the command prompt.  May use wildcards preceding "|".
;;;	Do not include "|" (the [shift+backslash] key).
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 6-30-99
;;;>		   EDITED: 07-18-2006
;;;
(DEFUN C:XRLAYERS (/ overwrite_xrl xrlay_can xrlay_fil)
  (SETQ xrlay_lst NIL)
  (TBLNEXT "layer" T)
  (WHILE
    (SETQ xrlay_can (TBLNEXT "layer"))
					;     (IF
					;       (WCMATCH (CDR (ASSOC 2 xrlay_can)) "*|*")
     (IF xrlay_lst
       (SETQ xrlay_lst (APPEND xrlay_lst (LIST xrlay_can)))
       (SETQ xrlay_lst (LIST xrlay_can))
     ) ;_ end of if
					;     ) ;_ end of if
  ) ;_ end of while
  (SETQ	xrl_file_pick
	 (STRCAT (GETVAR "dwgprefix")
		 (SUBSTR (GETVAR "dwgname")
			 1
			 (- (STRLEN (GETVAR "dwgname")) 4)
		 ) ;_ end of substr
		 ".xrl"
	 ) ;_ end of STRCAT
  ) ;_ end of setq
  (IF ukword NIL (LOAD "UKWORD" "\nFile UKWORD.LSP not loaded! "))
  (WHILE
    (AND (FINDFILE xrl_file_pick) (/= overwrite_xrl "Yes"))
     (SETQ overwrite_xrl
	    (ukword 1
		    "Yes No"
		    (STRCAT
		      xrl_file_pick
		      " exists! Overwrite it?"
		    ) ;_ end of strcat
		    (IF overwrite_xrl
		      overwrite_xrl
		      "Yes"
		    )
	    ) ;_ end of ukword
     ) ;_ end of setq
     (COND ((EQ overwrite_xrl "No")
	    (SETQ xrl_file_pick
		   (GETFILED "Create New XREF Layer File"
			     (GETVAR "dwgprefix")
			     "xrl"
			     1
		   ) ;_ end of getfiled
	    ) ;_ end of setq
	   )
     ) ;_ end of cond
  ) ;_ end of WHILE
  (SETQ xrlay_fil (OPEN xrl_file_pick "w"))
  (FOREACH n xrlay_lst
    (WRITE-LINE
      (STRCAT "((0 . \"LAYER\") (2 . \""
	      (CDR (ASSOC 2 n))
	      "\") (70 . "
	      (ITOA (CDR (ASSOC 70 n)))
	      ") (62 . "
	      (ITOA (CDR (ASSOC 62 n)))
	      ") (6 . \""
	      (CDR (ASSOC 6 n))
	      "\"))"
      ) ;_ end of strcat
      xrlay_fil
    ) ;_ end of write-line
  ) ;_ end of foreach
  (CLOSE xrlay_fil)
  (PRINC (STRCAT "\nXREF layer colors and linetypes saved to "
		 xrl_file_pick
		 " "
	 ) ;_ end of strcat
  ) ;_ end of princ
  (PRINC)
) ;_ end of DEFUN
(DEFUN c:rxrlay
       (/ msg_list msg_lay_str xrl_file xr_well oxrl_file cur_msg)
  (SETQ layandlts NIL)
  (SETQ old_regenmode (GETVAR "regenmode"))
  (SETVAR "regenmode" 0)
  (IF (AND xrlay_lst no_query_run)
    NIL
    (xrl_file_spec)
  )
  (IF ukword NIL (LOAD "UKWORD" "\nFile UKWORD.LSP not loaded! "))
  (IF ustr NIL (LOAD "USTR" "\nFile USTR.LSP not loaded! "))
  (SETQ xrlay_filter (ustr 1 "Enter layer name prefix to filter for or " "None" T))
  (SETQ procd_laycnt 0)
  (IF (EQ xrlay_filter "None")
    (SETQ xrlay_filter NIL)
  )
  (FOREACH n xrlay_lst
    (IF
      (AND (SETQ nlay_ent (TBLOBJNAME "LAYER" (CDR (ASSOC 2 n)))) (WCMATCH (STRCASE (CDR (ASSOC 2 n))) (IF xrlay_filter (STRCAT (STRCASE xrlay_filter) "*") "*")))
;;;      (TBLSEARCH "LAYER" (CDR (ASSOC 2 n)))
       (PROGN
         (SETQ procd_laycnt (1+ procd_laycnt))
	 (SETQ nlay_ent (ENTGET nlay_ent))
	 (SETQ nlay_ents
		(SUBST (ASSOC 62 n) (ASSOC 62 nlay_ent) nlay_ent)
	 ) ;_ end of SETQ
;;;	 (COMMAND ".layer"
;;;		  "c"
;;;		  (CDR (ASSOC 62 n))
;;;		  (CDR (ASSOC 2 n))
;;;		  ""
;;;	 ) ;_ end of COMMAND
	 (COND
;;;	   ((WCMATCH (CDR (ASSOC 6 n)) "*|*")
;;;	    (IF
;;;	      (EQ (CDR (ASSOC 6 (TBLSEARCH "LAYER" (CDR (ASSOC 2 n)))))
;;;		  (CDR (ASSOC 6 n))
;;;	      ) ;_ end of eq
;;;	       nil
;;;	       (PRINC (STRCAT "\n    Current linetype for layer "
;;;			      (CDR (ASSOC 2 n))
;;;			      " cannot be reset to "
;;;			      (CDR (ASSOC 6 n))
;;;		      ) ;_ end of STRCAT
;;;	       ) ;_ end of PRINC
;;;	    ) ;_ end of IF
;;;	   )
	   ((TBLSEARCH "LTYPE" (CDR (ASSOC 6 n)))
	    (SETQ nlay_ents
		   (SUBST (ASSOC 6 n) (ASSOC 6 nlay_ents) nlay_ents)
	    ) ;_ end of SETQ
;;;	    (COMMAND ".layer"
;;;		     "lt"
;;;		     (CDR (ASSOC 6 n))
;;;		     (CDR (ASSOC 2 n))
;;;		     ""
;;;	    ) ;_ end of command
	   )
	   (T
	    (SETQ
	      cur_msg
	       (STRCAT
		 "\n\n    Linetype "
		 (CDR (ASSOC 6 n))
		 " not found!  Use LINETYPE command to load it.\n"
	       ) ;_ end of strcat
	    ) ;_ end of setq
	    (IF	msg_list
	      (IF (MEMBER cur_msg msg_list)
		nil
		(PROGN
		  (SETQ	msg_list (APPEND msg_list
					 (LIST cur_msg
					 ) ;_ end of list
				 ) ;_ end of append
		  ) ;_ end of SETQ
		  (PRINC cur_msg)
		) ;_ end of progn
	      ) ;_ end of if
	      (PROGN
		(SETQ msg_list (LIST cur_msg))
		(PRINC cur_msg)
	      ) ;_ end of progn
	    ) ;_ end of if
	    (SETQ msg_lay_str (CDR (ASSOC 2 n)))
	    (WHILE (< (STRLEN msg_lay_str) 32)
	      (SETQ msg_lay_str (STRCAT msg_lay_str "."))
	    ) ;_ end of while
	    (PRINC (STRCAT "\n    Layer "
			   msg_lay_str
			   " linetype should be "
			   (CDR (ASSOC 6 n))
		   ) ;_ end of strcat
	    ) ;_ end of princ
	    (COND
	      (write_ltype_needs
	       (IF layandlts
		 (IF (MEMBER (LIST (CDR (ASSOC 2 n)) (CDR (ASSOC 6 n)))
			     layandlts
		     ) ;_ end of MEMBER
		   NIL
		   (PROGN
		     (SETQ need_lts (OPEN (STRCAT (GETVAR "dwgprefix")
						  "ltneeds.txt"
					  ) ;_ end of STRCAT
					  "a"
				    ) ;_ end of OPEN
		     ) ;_ end of SETQ
		     (IF (MEMBER (GETVAR "dwgname") layandlts)
		       (SETQ layandlts
			      (APPEND layandlts
				      (LIST (LIST (CDR (ASSOC 2 n))
						  (CDR (ASSOC 6 n))
					    ) ;_ end of LIST
				      ) ;_ end of LIST
			      ) ;_ end of APPEND
		       ) ;_ end of SETQ
		       (PROGN
			 (SETQ layandlts
				(APPEND	layandlts
					(LIST (GETVAR "dwgname")
					      (LIST (CDR (ASSOC 2 n))
						    (CDR (ASSOC 6 n))
					      ) ;_ end of LIST
					) ;_ end of LIST
				) ;_ end of APPEND
			 ) ;_ end of SETQ
			 (WRITE-LINE
			   (STRCAT (GETVAR "dwgname")
				   " needs linetype "
				   (CDR (ASSOC 6 n))
			   ) ;_ end of STRCAT
			   need_lts
			 ) ;_ end of WRITE-LINE
		       ) ;_ end of PROGN
		     ) ;_ end of IF
		     (WRITE-LINE
		       (STRCAT "    Layer "
			       (CDR (ASSOC 2 n))
			       " linetype should be "
			       (CDR (ASSOC 6 n))
		       ) ;_ end of STRCAT
		       need_lts
		     ) ;_ end of WRITE-LINE
		     (CLOSE need_lts)
		   ) ;_ end of PROGN
		 ) ;_ end of IF
		 (PROGN
		   (SETQ need_lts (OPEN	(STRCAT	(GETVAR "dwgprefix")
						"ltneeds.txt"
					) ;_ end of STRCAT
					"a"
				  ) ;_ end of OPEN
		   ) ;_ end of SETQ
		   (SETQ layandlts (LIST (GETVAR "dwgname")
					 (LIST (CDR (ASSOC 2 n))
					       (CDR (ASSOC 6 n))
					 ) ;_ end of LIST
				   ) ;_ end of LIST
		   ) ;_ end of SETQ
		   (WRITE-LINE
		     (STRCAT (GETVAR "dwgname")
			     " needs linetype "
			     (CDR (ASSOC 6 n))
		     ) ;_ end of STRCAT
		     need_lts
		   ) ;_ end of WRITE-LINE
		   (WRITE-LINE
		     (STRCAT "    Layer "
			     (CDR (ASSOC 2 n))
			     " linetype should be "
			     (CDR (ASSOC 6 n))
		     ) ;_ end of STRCAT
		     need_lts
		   ) ;_ end of WRITE-LINE
		   (CLOSE need_lts)
		 ) ;_ end of PROGN
	       ) ;_ end of IF
	      )
	    ) ;_ end of COND
	    (COMMAND ".linetype" "load" (CDR (ASSOC 6 n)) "acad.lin" "")
	   )
	 ) ;_ end of cond
	 (SETQ nlay_ents
		(SUBST (ASSOC 70 n) (ASSOC 70 nlay_ents) nlay_ents)
	 ) ;_ end of SETQ
;;;	 (IF (EQ (BOOLE 1 1 (CDR (ASSOC 70 n))) 1)
;;;	   (IF layfrz_lst
;;;	     (SETQ layfrz_lst
;;;		    (APPEND layfrz_lst (LIST (CDR (ASSOC 2 n))))
;;;	     ) ;_ end of SETQ
;;;	     (SETQ layfrz_lst (LIST (CDR (ASSOC 2 n))))
;;;	   ) ;_ end of IF
;;;	 ) ;_ end of IF
	 (ENTMOD nlay_ents)
	 (ENTUPD (CDR (ASSOC -1 nlay_ents)))
       ) ;_ end of progn
       (IF xrlay_filter
	 NIL
;;;         (PRINC (STRCAT "\nLayer " (CDR (ASSOC 2 n)) " skipped by filter!"))
         (PRINC (STRCAT "\nLayer " (CDR (ASSOC 2 n)) " not found!"))
       )
    ) ;_ end of if
  ) ;_ end of foreach
;;;  (COMMAND "-layer" "t" "*" "")
;;;  (COMMAND "-layer")
;;;  (FOREACH n layfrz_lst
;;;    (COMMAND "freeze" n)
;;;  ) ;_ end of FOREACH
;;;  (COMMAND "")
  (COND
    ((EQ procd_laycnt 0)
      (PRINC (STRCAT "\nNo layers have had their color and linetype restored" (IF xrl_file_pick (STRCAT " from settings in:\n" xrl_file_pick) ""))))
    ((EQ procd_laycnt 1)
      (PRINC (STRCAT "\nOne layer has had it's color and linetype restored" (IF xrl_file_pick (STRCAT " from settings in:\n" xrl_file_pick) "") "\n(unless noted otherwise). ")))
    ((> procd_laycnt 1)
      (PRINC (STRCAT "\n" (ITOA procd_laycnt) " layers have had their color and linetype restored" (IF xrl_file_pick (STRCAT " from settings in:\n" xrl_file_pick) "") "\n(unless noted otherwise). ")))
  )
  (SETVAR "regenmode" old_regenmode)
  (PRINC)
) ;_ end of defun
(DEFUN xrl_file_spec ()
  (IF ukword NIL (LOAD "UKWORD" "\nFile UKWORD.LSP not loaded! "))
  (IF xrlay_lst
    (SETQ xr_well (ukword 1
			  "Yes No"
			  "Use the layer list in memory?"
			  (IF xr_well
			    xr_well
			    "Yes"
			  ) ;_ end of if
		  ) ;_ end of ukword
    ) ;_ end of setq
    (SETQ xr_well "No")
  ) ;_ end of IF
  (IF (EQ xr_well "No")
    (PROGN
      (SETQ
	xrlay_lst NIL
	xrl_file  (GETFILED
		    "Select XREF Layer Settings File"
		    (STRCAT (GETVAR "dwgprefix")
			    (SUBSTR (GETVAR "dwgname")
				    1
				    (- (STRLEN (GETVAR "dwgname")) 4)
			    ) ;_ end of substr
		    ) ;_ end of STRCAT
		    "xrl"
		    4
		  ) ;_ end of getfiled
      ) ;_ end of setq
      (SETQ oxrl_file (OPEN xrl_file "r"))
      (WHILE
	(SETQ red-line (READ-LINE oxrl_file))
	 (SETQ red-line (LIST (READ red-line)))
	 (IF xrlay_lst
	   (SETQ xrlay_lst (APPEND xrlay_lst
				   red-line
			   ) ;_ end of APPEND
	   ) ;_ end of SETQ
	   (SETQ xrlay_lst red-line)
	 ) ;_ end of if
      ) ;_ end of WHILE
      (CLOSE oxrl_file)
    ) ;_ end of PROGN
  ) ;_ end of IF
  (SETQ	cur_file_name
	 (SUBSTR (GETVAR "DWGNAME")
		 1
		 (- (STRLEN (GETVAR "DWGNAME")) 4)
	 ) ;_ end of SUBSTR
	laycnt 0
	lay_found NIL
  ) ;_ end of SETQ
  (WHILE
    (AND (< laycnt (LENGTH xrlay_lst))
	 (NOT
	   (SETQ
	     lay_found (WCMATCH
			 (STRCASE (CDR (ASSOC 2 (NTH laycnt xrlay_lst))))
			 (STRCASE (STRCAT cur_file_name "|*"))
		       ) ;_ end of WCMATCH
	   ) ;_ end of SETQ
	 ) ;_ end of NOT
    ) ;_ end of AND
     (SETQ laycnt (1+ laycnt))
  ) ;_ end of WHILE
  (IF (AND lay_found
	   (EQ (SETQ do_xrconv
		      (ukword
			1
			"Yes No"
			"Shall we treat this file as the primary file and the primary file as an xref in this layer list?"
			(IF do_xrconv
			  do_xrconv
			  "No"
			) ;_ end of IF
		      ) ;_ end of ukword
	       ) ;_ end of SETQ
	       "Yes"
	   ) ;_ end of EQ
      ) ;_ end of AND
    (PROGN
      (IF ustr NIL (LOAD "USTR" "\nFile USTR.LSP not loaded! "))
      (IF xrl_file
	(SETQ xrl_file_name (NTH 2 (DOS_SPLITPATH xrl_file)))
      ) ;_ end of IF
      (SETQ pri_file_name
	     (ustr 1
		   "Enter name of primary file to treat as an xref"
		   (IF xrl_file_name
		     xrl_file_name
		     (IF pri_file_name
		       pri_file_name
		       ""
		     ) ;_ end of IF
		   ) ;_ end of IF
		   NIL
	     ) ;_ end of ustr
      ) ;_ end of SETQ
      (FOREACH n xrlay_lst
	(COND ((WCMATCH	(STRCASE (CDR (ASSOC 2 n)))
			(STRCASE (STRCAT cur_file_name "|*"))
	       ) ;_ end of WCMATCH
	       (SETQ new_n
			(SUBST (CONS 2
				     (SUBSTR (CDR (ASSOC 2 n))
					     (+ 2 (STRLEN cur_file_name))
				     ) ;_ end of SUBSTR
			       ) ;_ end of CONS
			       (ASSOC 2 n)
			       n
			) ;_ end of SUBST
	       ) ;_ end of SETQ
	       (SETQ new_n
			(SUBST (CONS 70 0)
			       (ASSOC 70 new_n)
			       new_n
			) ;_ end of SUBST
	       ) ;_ end of SETQ
	       (SETQ xrlay_lst (SUBST new_n n xrlay_lst))
	      )
	      ((NOT (WCMATCH (CDR (ASSOC 2 n)) "*|*"))
	       (SETQ xrlay_lst
		      (SUBST
			(SUBST
			  (CONS 2 (STRCAT pri_file_name "|" (CDR (ASSOC 2 n))))
			  (ASSOC 2 n)
			  n
			) ;_ end of SUBST
			n
			xrlay_lst
		      ) ;_ end of SUBST
	       ) ;_ end of SETQ
	      )
	) ;_ end of COND
      ) ;_ end of FOREACH
    ) ;_ end of PROGN
  ) ;_ end of IF
  (SETQ layfrz_lst nil)
) ;_ end of defun
(DEFUN c:rlayers (/)
  (FOREACH n xrlay_lst
    (SETQ lllnm (CDR (ASSOC 2 n)))
    (SETQ llllt (CDR (ASSOC 6 n)))
    (SETQ lllco (CDR (ASSOC 62 n)))
    (WHILE (WCMATCH lllnm "*|*")
      (SETQ lllnm (SUBSTR lllnm 2))
    ) ;_ end of while
    (WHILE (WCMATCH llllt "*|*")
      (SETQ llllt (SUBSTR llllt 2))
    ) ;_ end of while
    (IF	(TBLSEARCH "layer" lllnm)
      (COMMAND ".layer"	"lt" llllt lllnm "") ;_ end of COMMAND
 ;_ end of command
      (COMMAND ".layer"	"c" lllco lllnm	"") ;_ end of COMMAND
 ;_ end of command
    ) ;_ end of if
  ) ;_ end of foreach
) ;_ end of defun
(DEFUN c:importxrl (/ found_a_match)
  (xrl_file_spec)
  (IF ustr NIL (LOAD "USTR" "\nFile USTR.LSP not loaded! "))
  (SETQ xrfname (ustr 1 "Name of source Xref" xrfname nil))
  (PRINC
    (STRCAT "\nImport layer settings from Xref(s) named \""
	    xrfname
	    "\" to layers...\n"
    ) ;_ end of STRCAT
  ) ;_ end of PRINC
  (FOREACH n xrlay_lst
    (IF	(WCMATCH (STRCASE (CDADR n))
		 (STRCASE (STRCAT xrfname "|*"))
	) ;_ end of WCMATCH
      (PROGN
	(SETQ found_a_match T)
	(IF (WCMATCH (CDR (NTH 4 n)) "*|*")
	  (COMMAND "-layer"
		   "c"
		   (CDR (NTH 3 n))
		   (CDADR n)
		   ""
	  ) ;_ end of command
	  (COMMAND "-layer"
		   "c"
		   (CDR (NTH 3 n))
		   (CDADR n)
		   "lt"
		   (CDR (NTH 4 n))
		   (CDADR n)
		   ""
	  ) ;_ end of command
	) ;_ end of if
	(PRINC "\n\t\t")
	(PRINC (CDADR n))
      ) ;_ end of PROGN
    ) ;_ end of IF
  ) ;_ end of foreach
  (IF found_a_match
    NIL
    (PRINC
      (STRCAT "\nNo Xref name matching \"" xrfname "\" found! ")
    ) ;_ end of PRINC
  ) ;_ end of IF
  (PRINC)
) ;_ end of defun
(DEFUN c:replpfx ()
  (IF ustr NIL (LOAD "USTR" "\nFile USTR.LSP not loaded! "))
  (SETQ
    exlpfx (STRCASE (ustr 1
			  "Existing Xref layer prefix to be replaced"
			  exlpfx
			  T
		    ) ;_ end of ustr
	   ) ;_ end of STRCASE
  ) ;_ end of SETQ
  (SETQ
    newlpfx (STRCASE (ustr 1
			   (STRCAT "New Xref layer prefix to replace "
				   exlpfx
				   " with"
			   ) ;_ end of STRCAT
			   newlpfx
			   T
		     ) ;_ end of ustr
	    ) ;_ end of STRCASE
  ) ;_ end of SETQ
  (xrl_file_spec)
  (SETQ step_cnt 0)
  (FOREACH n xrlay_lst
    (IF	(WCMATCH (STRCASE (CDR (ASSOC 2 n))) (STRCAT exlpfx "*"))
      (PROGN
	(SETQ laycnt 1)
	(WHILE
	  (NOT (WCMATCH	(STRCASE (SUBSTR (CDR (ASSOC 2 n)) 1 laycnt))
			exlpfx
	       ) ;_ end of WCMATCH
	  ) ;_ end of NOT
	   (SETQ laycnt (1+ laycnt))
	) ;_ end of WHILE
	(SETQ xrlay_lst
	       (SUBST
		 (SUBST
		   (CONS
		     2
		     (STRCAT newlpfx
			     (SUBSTR (CDR (ASSOC 2 n)) (1+ laycnt))
		     ) ;_ end of STRCAT
		   ) ;_ end of CONS
		   (CDR (ASSOC 2 n))
		   n
		 ) ;_ end of SUBST
		 n
		 xrlay_lst
	       ) ;_ end of SUBST
	) ;_ end of SETQ
	(IF (WCMATCH (STRCASE (SUBSTR (CDR (ASSOC 6 n)) 1 laycnt))
		     exlpfx
	    ) ;_ end of WCMATCH
	  (SETQ	xrlay_lst
		 (SUBST
		   (SUBST
		     (CONS 6
			   (STRCAT
			     newlpfx
			     (SUBSTR (CDR (ASSOC 6 n)) (1+ laycnt))
			   ) ;_ end of STRCAT
		     ) ;_ end of CONS
		     (CDR (ASSOC 6 n))
		     n
		   ) ;_ end of SUBST
		   n
		   xrlay_lst
		 ) ;_ end of SUBST
	  ) ;_ end of SETQ
	) ;_ end of IF
	(PRINC "\n")
	(PRINC (NTH step_cnt xrlay_lst))
	(PRINC)
      ) ;_ end of PROGN
    ) ;_ end of IF
    (SETQ step_cnt (1+ step_cnt))
  ) ;_ end of FOREACH
  (PRINC)
) ;_ end of DEFUN
(PRINC)

 ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 0 0 T T nil T)
 ***Don't add text below the comment!***|;