;; NAME
;; Layer Settings
;;
;; SYNOPSIS
;; Load a previous saved layer file.
;;
;; DESCRIPTION
;; This application will allow you to load previous saved layers
;; (name, color, line type, and state) to the current drawing. If
;; the layers do not exist they will be created using the
;; settings in the file. If the layer name already exists in the
;; drawing, those settings will not be updated -- this is to
;; allow for custom, per drawing, layer overrides-.
;; //-- SEE CHANGE LOG --//
;;
;; To save the current drawings layers use:
;; (process-on-drawing save-layer-list-to-file)
;; A file with the current drawings file name, with the `.la'
;; suffix will be saved to the current drawings location.
;;
;; NOTES
;; My overall objective was to create a fast way for me to load
;; up layer settings for my CAD users.
;;
;; AUTHOR
;; John Kaul
;;
;; VERSION
;; 1.0.3
;;
;; CHANGE LOG
;; 1.0.0 Orig issue
;; 05.20.08
;; 1.0.1 Revised to handle plot/noplot setting
;; (dxf code 290)
;; Closed layer file once done reading
;; 05.27.08
;; 1.0.2 Removed parsing of drawings layer list to
;; names ...making it faster.
;; New time for creating 10,000 layers was 1.36 seconds
;; 05.28.08
;; 1.0.3 Added the ability to modify layers already in dwg which
;; are different the ones found in the layer file.
;; 1.0.4 Added the ability to load and handle linetypes not in
;; drawing or located in .lin file in search path
;; 07.22.08
;; 1.0.5 Added the abililty to set a layer description (assoc 777)
;; layer file (.la)
;; 03.11.09
;; 1.0.6 Added the ability to add comments to the .la files
;; comments begin with a semi colon ( ; )
;; 03.17.09
;;
;; //-- BEGIN SUPPORT PROCEDURES --//
(defun process
-on
-drawing
( process
) ;; a simple `hook' to run a process
(defun save
-layer
-list
-to
-file
( / x f fp
) ;; retrieve all layers from dwg dict and save
;; to a file. file saved where drawing is located
)
(defun get
-list
-from
-file
( name
/ fp lst read
-file
-into
-list ) ;; general file reader
;; given a file name this procedure will read the contents
;; into a list
;; get string from file; if it is a comment, return an empty string.
lst
)
(defun get
-drawing
-dictionary
-list ( what
/ x lst
) ;; retrieve a list of drawing dictionary entries
;; given a list of raw dic entries this proced
;; will report entity names
nil
;; return list of items found in dwg but different from list
x))
ls) )
(defun get
-value
( val lst
) ;; shortcut for returning value in assoc list
(defun strParse
(aStr delim
/ strList pos
) ;; Find the postition where the delimiter first shows up.
;; create a list of the fist substring (up untill the delimiter)
;; Skip over the delimiter and grab the rest of the string,
;; Set that as the new string
)
)
;; remake the drawing ltype list
(process-on-drawing
'
(get
-drawing
-dictionary
-list "LTYPE")))) );_ end progn
);_ end if
)
;; //-- END SUPPORT PROCEDURES --//
(defun LayerSetup
( layers
-to
-load
-from
-file
/ dwg
-layer
-list dwg
-layer
-name
-list todo
-layer
-list timer layers
-to
-modify
ltype
-file
-locations file
-layer
-list ltype
-locations dwg
-ltype
-name
-list )
dwg
-layer
-list (process
-on
-drawing '
(get
-drawing
-dictionary
-list "LAYER")) ;; build a list of layers in current drawing
;; build a list of layer names (names only) in current drawing
(build
-name
-list (process
-on
-drawing '
(get
-drawing
-dictionary
-list "LTYPE"))) ;; build a list of litetype names loaded in dwg
ltype-file-locations
;; itterate thru the entire search path to look for .lin files
x
"\\"
(strparse
(getvar "ACADPREFIX") ";") )) ltype-locations
;; a list of lists for the lietypes and their locations
;; ( <path>+<file> ( <ltype> <ltype> ... ))
(get-list-from-file x)
)
)
)
ltype-file-locations
)
'
read (get
-list
-from
-file
;; get the layers from the file (layers to impliment)
x))
)
;; parse out the already defined common layers
;;
;; create layers not in drawing already
;;
;; create the layers
;; do not opperate on null entries.
lt
;; itterate thru the ltype file list to see which
;; file contains the missing linetype, then load it
'lt-find
ltype-locations )
;; another search level incase we still coulnt find lt.
"\nLinetype for Layer: "
(get-value 2 x)
" Not found, using continuous instead."))
)
);_ end if
)
);_ end cond
plot
((get-value 290 x)
(cons 290 (get
-value
290 x
))) (t
(cons 290 1))));_ end setq '(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
(cons 70 (get
-value
70 x
)) (cons 62 (get
-value
62 x
)) plot
lt
);_ end list
);_ end entmake
;; add some description
;; Descriptions are assoc code 777 in .la file
(get-value 777 x)) )
);_ end progn
);_ end if
)
)
)
(setq dwg
-layer
-list (process
-on
-drawing '
(get
-drawing
-dictionary
-list "LAYER")) layers
-to
-modify
(build
-modify
-list file
-layer
-list) ;; build a list of layers that need to be modified.
)
;;
;; Update or change layers that do not have properties
;; listed in layer file
;;
;; TODO: Add linetype support -- inline
'
(lambda ( x
/ lt plot layer
) ;; do not opperate on null entries in list
;; get the layer from the dwg dict.
;; we are going to modify several of the drawing layer props at once
;; the dxf codes can be found at the end of the mapcar function call
;; if we are on key 290 (ploting flag)
(set 'plot
(if (get
-value key x
) 0 1)) ;; determine if the layer value has the 290 entry;
;; if not return 1 (plot able) if it does return 0
;; mod the layer list
)
;; ((eq key 6)
;; (mapcar 'lt-find
((get-value key layer)
;; other wise just mod the layer list
'(6 62 70 290) )
;; make modifications
;; add some description
(get-value 777 x)) )
);_ end progn
);_ end if
)
layers-to-modify
)
)
(princ "\n ==> Layers created/modified")
)
;; Example Ussage:
;;
;; (defun MyLayerSetup ( / )
;; (LayerSetup "\\SERVER\\DIR\\Lisp\\MyLayers.la")
