;;------------------------=={ Layer Director }==------------------------;;
;;                                                                      ;;
;;  This program uses a Visual LISP Command Reactor to automatically    ;;
;;  set the current layer when a command is called, proceeding to       ;;
;;  reset to the previous current layer when the command is completed.  ;;
;;                                                                      ;;
;;  The chosen layer will be created with the specified properties if   ;;
;;  it doesn't already exist in the active drawing.                     ;;
;;                                                                      ;;
;;  The data controlling the layer to be set when certain commands are  ;;
;;  called and the corresponding layer properties for new layers is     ;;
;;  tabulated at the top of the code - this may be altered and expanded ;;
;;  to suit the user's requirements.                                    ;;
;;                                                                      ;;
;;  The first item of each list in the table is the name of a command   ;;
;;  to trigger a layer change. This command name should be the full     ;;
;;  command name, not a command alias. The command is not               ;;
;;  case-sensitive and may use wildcards.                               ;;
;;                                                                      ;;
;;  To give a few examples, "[DM]TEXT,TEXT" will cue a layer change     ;;
;;  for the Text, DText and MText commands; "[QM]LEADER,LEADER" will    ;;
;;  cue a layer change for the Leader, QLeader and MLeader commands.    ;;
;;                                                                      ;;
;;  The second item is the name of the layer to be set to current when  ;;
;;  the command is called. This layer will be created if not present    ;;
;;  in the active drawing, using the layer properties specified in the  ;;
;;  remainder of the list.                                              ;;
;;                                                                      ;;
;;  The program will automatically enable the Command Reactor when      ;;
;;  loaded, and the current layer will be automatically changed when    ;;
;;  any of the listed commands are called. The reactor may be           ;;
;;  subsequently disabled or enabled manually using the commands        ;;
;;  'LDOFF' & 'LDON' respectively.                                      ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2014  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2011-04-16                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2012-04-24                                      ;;
;;                                                                      ;;
;;  - Program rewritten & updated.                                      ;;
;;----------------------------------------------------------------------;;
;;  Version 1.2    -    2014-06-15                                      ;;
;;                                                                      ;;
;;  - Added the ability to specify basic layer properties to be         ;;
;;    applied to new layers created by the program.                     ;;
;;  - Changed loading method to use the s::startup post-initialisation  ;;
;;    loading function.                                                 ;;
;;----------------------------------------------------------------------;;

;;----------------------------------------------------------------------;;
;;  Layer Data                                                          ;;
;;  ==================================================================  ;;
;;                                                                      ;;
;;  Populate this list with commands for which the current layer        ;;
;;  should be changed.                                                  ;;
;;                                                                      ;;
;;  -----------------------------------                                 ;;
;;  COMMAND PATTERN                                                     ;;
;;  -----------------------------------                                 ;;
;;  The first item is the name of a command that will cue a layer       ;;
;;  change. The command name should be the full command name, not an    ;;
;;  alias. This command name is not case-sensitive and may use          ;;
;;  wildcards.                                                          ;;
;;                                                                      ;;
;;  e.g. "[DM]TEXT,TEXT" will cue a layer change for the TEXT, DTEXT    ;;
;;  and MTEXT commands.                                                 ;;
;;                                                                      ;;
;;  e.g. "LINE,[XP]LINE" will cue a layer change for the LINE, PLINE,   ;;
;;  and XLINE commands.                                                 ;;
;;                                                                      ;;
;;  -----------------------------------                                 ;;
;;  LAYER NAME                                                          ;;
;;  -----------------------------------                                 ;;
;;  The second item is the name of the layer to be set current when     ;;
;;  the command is called. This layer will be created if not present    ;;
;;  in the active drawing.                                              ;;
;;                                                                      ;;
;;  The remaining items are basic layer properties to be applied to     ;;
;;  layers that are created by the program.                             ;;
;;                                                                      ;;
;;  -----------------------------------                                 ;;
;;  LAYER COLOUR                                                        ;;
;;  -----------------------------------                                 ;;
;;  The third item is the layer colour and should be a positive         ;;
;;  non-zero integer less than 256, representing the ACI colour of      ;;
;;  the layer.                                                          ;;
;;                                                                      ;;
;;  -----------------------------------                                 ;;
;;  LAYER LINETYPE                                                      ;;
;;  -----------------------------------                                 ;;
;;  The fourth item is the layer linetype; this is a non-case-sensitive ;;
;;  string representing a linetype defined in a .lin file, or           ;;
;;  "Continuous" if the layer should use the default continuous         ;;
;;  linetype. The program will attempt to load specified linetypes      ;;
;;  which are not defined in the drawing, and will use the Continuous   ;;
;;  linetype if the specified linetype cannot be loaded.                ;;
;;                                                                      ;;
;;  -----------------------------------                                 ;;
;;  LAYER LINEWEIGHT                                                    ;;
;;  -----------------------------------                                 ;;
;;  The fifth item is the layer lineweight; this should be an integer   ;;
;;  representing one of the standard lineweight values multiplied by    ;;
;;  100 (i.e. 2.11mm becomes 211). Use -3 to specify the 'Default'      ;;
;;  lineweight.                                                         ;;
;;                                                                      ;;
;;  -----------------------------------                                 ;;
;;  LAYER PLOT FLAG                                                     ;;
;;  -----------------------------------                                 ;;
;;  Finally, the sixth item is the layer plot flag; this should be an   ;;
;;  integer value of either 1 or 0. A value of 1 indicates that the     ;;
;;  layer should be plotted; a value of 0 means the layer will not      ;;
;;  plot.                                                               ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;

(setq layerdirector:data
   '(
                           
;;----------------------------------------------------------------------------------------------------------------------;;
;;  Command Pattern       |  Layer Name            |    Colour    |   Linetype   |    Lineweight    |        Plot       ;;
;;----------------------------------------------------------------------------------------------------------------------;;
;;     [string]           |   [string]             | 0 < int <256 |   [string]   | -3 = Default     |  1 = Will Plot    ;;
;;                        |                        |              |              |  0 <= int <= 211 |  0 = Won't Plot   ;;
;;----------------------------------------------------------------------------------------------------------------------;;
     
("[DM]TEXT,TEXT"            "---061-Text"                  7        "Continuous"           -3                1     )
("DIM*,*LEADER"             "---063-Bemassung_weiß"        7        "Continuous"           -3                1     )
("XLINE"                    "---000-Konlinie"            191        "Continuous"            009              0     )
("*VPORT*"                  "DEFPOINTS"                    7        "HIDDEN"               -3                0     )     

;;----------------------------------------------------------------------------------------------------------------------;;

    )
)

;;----------------------------------------------------------------------;;
;;  Print Command (Debug Mode)  [ t / nil ]                             ;;
;;  ==================================================================  ;;
;;                                                                      ;;
;;  If set to T the program will print the command name when a command  ;;
;;  is called. This is useful when determining the correct command name ;;
;;  to use in the Layer Data list.                                      ;;
;;----------------------------------------------------------------------;;

(setq layerdirector:printcommand nil)

;;----------------------------------------------------------------------;;
;;  Commands:  [ LDON / LDOFF ]                                         ;;
;;  ==================================================================  ;;
;;                                                                      ;;
;;  Use these to manually turn the Layer Director on & off.             ;;
;;----------------------------------------------------------------------;;

(defun c:ldon  nil (LM:layerdirector  t ))
(defun c:ldoff nil (LM:layerdirector nil))

;;----------------------------------------------------------------------;;

(defun LM:layerdirector ( on )
    (foreach obj (cdar (vlr-reactors :vlr-command-reactor))
        (if (= "LM:layerdirector" (vlr-data obj))
            (vlr-remove obj)
        )
    )
    (or (and on
            (vlr-command-reactor "LM:layerdirector"
               '(
                    (:vlr-commandwillstart . LM:layerdirector:set)
                    (:vlr-commandended     . LM:layerdirector:reset)
                    (:vlr-commandcancelled . LM:layerdirector:reset)
                    (:vlr-commandfailed    . LM:layerdirector:reset)
                )
            )
            (princ "\nLayer Director enabled.")
        )
        (princ "\nLayer Director disabled.")
    )
    (princ)
)

;;----------------------------------------------------------------------;;

(defun LM:layerdirector:set ( obj arg / lst tmp )
    (if
        (and
            (setq arg (strcase (car arg)))
            (setq lst (cdar (vl-member-if '(lambda ( x ) (wcmatch arg (strcase (car x)))) layerdirector:data)))
            (setq tmp (LM:layerdirector:createlayer lst))
            (zerop (logand 1 (cdr (assoc 70 tmp))))
        )
        (progn
            (setq layerdirector:oldlayer (getvar 'clayer))
            (setvar 'clayer (car lst))
        )
    )
    (if layerdirector:printcommand (print arg))
    (princ)
)

;;----------------------------------------------------------------------;;

(defun LM:layerdirector:reset ( obj arg / tmp )
    (if
        (and
            (not (wcmatch (strcase (car arg)) "U,UNDO"))
            (= 'str (type layerdirector:oldlayer))
            (setq tmp (tblsearch "layer" layerdirector:oldlayer))
            (zerop (logand 1 (cdr (assoc 70 tmp))))
        )
        (progn
            (setvar 'clayer layerdirector:oldlayer)
            (setq layerdirector:oldlayer nil)
        )
    )
    (princ)
)

;;----------------------------------------------------------------------;;

(defun LM:layerdirector:createlayer ( lst )
    (cond
        (   (tblsearch "layer" (car lst)))
        (   (apply
                (function
                    (lambda ( lay col ltp lwt plt )
                        (entmake
                            (list
                               '(000 . "LAYER")
                               '(100 . "AcDbSymbolTableRecord")
                               '(100 . "AcDbLayerTableRecord")
                               '(070 . 0)
                                (cons 002 lay)
                                (cons 062 (if (< 0 col 256) col 7))
                                (cons 006 (if (or (tblsearch "ltype" ltp) (LM:loadlinetypes (list ltp) nil)) ltp "Continuous"))
                                (cons 370 (if (or (= -3 lwt) (<= 0 lwt 211)) lwt -3))
                                (cons 290 plt)
                            )
                        )
                    )
                )
                lst                           
            )
        )
    )
)

;;----------------------------------------------------------------------;;

;; Load Linetypes  -  Lee Mac
;; Attempts to load a list of linetypes from any .lin files found in the support path.
;; Excludes known metric & imperial definition files based on the value of MEASUREMENT
;; lts - [lst] List of linetypes to load
;; rdf - [bol] If T, linetypes will be redefined from file if already loaded
;; Returns: [bol] T if all linetypes are loaded successfully, else nil

(defun LM:loadlinetypes ( lts rdf / lst ltc rtn val var )
    (if (zerop (getvar 'measurement))
        (setq lst (mapcar 'strcase '("acadiso.lin" "iso.lin")))  ;; Known metric .lin files
        (setq lst (mapcar 'strcase '("acad.lin" "default.lin"))) ;; Known imperial .lin files
    )
    (setq ltc  (vla-get-linetypes (vla-get-activedocument (vlax-get-acad-object)))
          var '(cmdecho expert)
          val  (mapcar 'getvar var)
          lst  (vl-remove-if '(lambda ( x ) (member (strcase x) lst))
                   (apply 'append
                       (mapcar '(lambda ( dir ) (vl-directory-files dir "*.lin" 1))
                           (vl-remove "" (LM:str->lst (getenv "ACAD") ";"))
                       )
                   )
               )
    )
    (mapcar 'setvar var '(0 5))
    (setq rtn
        (apply 'and
            (mapcar
               '(lambda ( typ )
                    (cond
                        (   (not (tblsearch "ltype" typ))
                            (vl-some
                               '(lambda ( lin )
                                    (vl-catch-all-apply 'vla-load (list ltc typ lin))
                                    (tblsearch "ltype" typ)
                                )
                                lst
                            )
                        )
                        (   rdf
                            (vl-some
                               '(lambda ( lin )
                                    (and (LM:ltdefined-p typ lin)
                                         (vl-cmdf "_.-linetype" "_L" typ lin "")
                                         (tblsearch "ltype" typ)
                                    )
                                )
                                lst
                            )
                        )
                        (   t   )
                    )
                )
                lts
            )
        )
    )
    (mapcar 'setvar var val)
    rtn
)

;;----------------------------------------------------------------------;;

;; Linetype Defined-p  -  Lee Mac
;; Returns T if the linetype is defined in the specified .lin file
;; ltp - [str] Linetype name
;; lin - [str] Filename of linetype definition file (.lin)

(defun LM:ltdefined-p ( ltp lin / str rtn )
    (if
        (and
            (setq lin (findfile lin))
            (setq lin (open lin "r"))
        )
        (progn
            (setq ltp (strcat "`*" (strcase ltp) "`,*"))
            (while
                (and (setq str (read-line lin))
                     (not (setq rtn (wcmatch (strcase str) ltp)))
                )
            )
            (close lin)
            rtn
        )
    )
)

;;----------------------------------------------------------------------;;

;; String to List  -  Lee Mac
;; Separates a string using a given delimiter
;; str - [str] String to process
;; del - [str] Delimiter by which to separate the string
;; Returns: [lst] List of strings

(defun LM:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)

;;----------------------------------------------------------------------;;

(   (lambda ( )
        (vl-load-com)
        (if (= 'list (type s::startup))
            (if (not (member '(LM:layerdirector t) s::startup))
                (setq s::startup (append s::startup '((LM:layerdirector t))))
            )
            (defun-q s::startup nil (LM:layerdirector t))
        )
        (princ)
    )
)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;