[编程交流] 层控制器故障

;;-------------------=={ Layer Director }==-------------------;; ;;                                                            ;; ;;  Uses a command reactor to automatically set the layer     ;; ;;  upon the user invoking certain commands.                  ;; ;;                                                            ;; ;;  Layer settings are stored in the list at the top of the   ;; ;;  program. The first entry in the list is the command on    ;; ;;  which the reactor will trigger, it may use wildcards.     ;; ;;  The second entry is the designated layer for the command  ;; ;;  entered, this layer will be created if non-existent.      ;; ;;  The third entry is the layer colour that will be used if  ;; ;;  the layer is to be created in the drawing.                ;; ;;                                                            ;; ;;  The Reactor is enabled upon loading the program - it may  ;; ;;  be toggled on and off by typing 'LD' at the command line. ;; ;;------------------------------------------------------------;; ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;; ;;------------------------------------------------------------;;  (defun c:LD nil (LM:LayerDirector))  (defun LM:LayerDirector nil (vl-load-com)    (setq *LayerData*    '(      ("*TEXT"           "TEXT"       2)      ("*DIM*,*QLEADER"  "DIMENSIONS" 2)      ("*VPORT*"         "DEFPOINTS"  7)     )   )          (     (lambda ( data callback1 callback2 / react )       (if         (setq react           (vl-some             (function               (lambda ( reactor )                 (if (eq data (vlr-data reactor))                   reactor                 )               )             )             (cdar (vlr-reactors :vlr-command-reactor))           )         )         (if (vlr-added-p react)           (vlr-remove react)           (vlr-add react)         )         (setq react           (vlr-command-reactor data             (list               (cons :vlr-commandWillStart callback1)               (cons :vlr-commandEnded     callback2)               (cons :vlr-commandCancelled callback2)             )           )         )       )              (if (and react (vlr-added-p react))         (princ "\n<< Layer Director Enabled >>" )         (princ "\n<< Layer Director Disabled >>")       )     )      "LayerDirector"     'LayerDirectorSet     'LayerDirectorReset   )   (princ) )  (defun LayerDirectorSet ( reactor params / layerdetails layer ) (vl-load-com)   (if     (and       (setq params (strcase (car params)) layerdetails         (vl-some           (function             (lambda ( x )               (if (wcmatch params (car x)) (cdr x))             )           )           *LayerData*         )       )       (LM:MakeLayer (setq layer (car layerdetails)) (cadr layerdetails))       (zerop         (logand 1           (cdr             (assoc 70               (tblsearch "LAYER" layer)             )           )         )       )     )     (progn       (setq *oldlayer* (getvar 'CLAYER))             (setvar 'CLAYER layer)     )   )   (princ) )  (defun LayerDirectorReset ( reactor params ) (vl-load-com)   (if     (and (not (wcmatch (strcase (car params)) "*UNDO")) *oldlayer* (tblsearch "LAYER" *oldlayer*)       (zerop         (logand 1           (cdr             (assoc 70               (tblsearch "LAYER" *oldlayer*)             )           )         )       )     )     (progn       (setvar 'CLAYER *oldlayer*)       (setq *oldlayer* nil)     )   )     (princ) )  (defun LM:MakeLayer ( name colour )   (or (tblsearch "LAYER" name)     (entmakex       (list         (cons 0   "LAYER")         (cons 100 "AcDbSymbolTableRecord")         (cons 100 "AcDbLayerTableRecord")         (cons 2   name)         (cons 62  colour)         (cons 70  0)       )     )   ) )  (princ) (LM:LayerDirector) (princ)

(LM:LayerDirector)

 
;;-------------------=={ Layer Director }==-------------------;;
;;                                                            ;;
;;  Uses a command reactor to automatically set the layer     ;;
;;  upon the user invoking certain commands.                  ;;
;;                                                            ;;
;;  Layer settings are stored in the list at the top of the   ;;
;;  program. The first entry in the list is the command on    ;;
;;  which the reactor will trigger, it may use wildcards.     ;;
;;  The second entry is the designated layer for the command  ;;
;;  entered, this layer will be created if non-existent.      ;;
;;  The third entry is the layer colour that will be used if  ;;
;;  the layer is to be created in the drawing.                ;;
;;                                                            ;;
;;  The Reactor is enabled upon loading the program - it may  ;;
;;  be toggled on and off by typing 'LD' at the command line. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com/"]www.lee-mac.com[/url]       ;;
;;------------------------------------------------------------;;
(defun c:LD nil (LM:LayerDirector))
(defun LM:LayerDirector nil (vl-load-com)
 (setq *LayerData*
  '(
    ("*TEXT" "CCC_LAYOUT_Text" 7)
    ("*DIM*,*QLEADER*,*MLEADER" "CCC_LAYOUT_Dimensions" 7)
    ("*VPORT*" "CCC_SHEET_LAYOUT_Viewport" 7)
   )
 )      
 (
   (lambda ( data callback1 callback2 / react )
     (if
       (setq react
         (vl-some
           (function
             (lambda ( reactor )
               (if (eq data (vlr-data reactor))
                 reactor
               )
             )
           )
           (cdar (vlr-reactors :vlr-command-reactor))
         )
       )
       (if (vlr-added-p react)
[color=red]        ;(vlr-remove react)[/color]
         (vlr-add react)
       )
       (setq react
         (vlr-command-reactor data
           (list
             (cons :vlr-commandWillStart callback1)
             (cons :vlr-commandEnded     callback2)
             (cons :vlr-commandCancelled callback2)
           )
         )
       )
     )
     (if (and react (vlr-added-p react))
       (princ "\n<< Layer Director Enabled >>" )
       (princ "\n<< Layer Director Disabled >>")
     )
   )
   "LayerDirector"
   'LayerDirectorSet
   'LayerDirectorReset
 )
 (princ)
)
(defun LayerDirectorSet ( reactor params / layerdetails layer ) (vl-load-com)
 (if
   (and
     (setq params (strcase (car params)) layerdetails
       (vl-some
         (function
           (lambda ( x )
             (if (wcmatch params (car x)) (cdr x))
           )
         )
         *LayerData*
       )
     )
     (LM:MakeLayer (setq layer (car layerdetails)) (cadr layerdetails))
     (zerop
       (logand 1
         (cdr
           (assoc 70
             (tblsearch "LAYER" layer)
           )
         )
       )
     )
   )
   (progn
     (setq *oldlayer* (getvar 'CLAYER))      
     (setvar 'CLAYER layer)
   )
 )
 (princ)
)
(defun LayerDirectorReset ( reactor params ) (vl-load-com)
 (if
   (and (not (wcmatch (strcase (car params)) "*UNDO")) *oldlayer* (tblsearch "LAYER" *oldlayer*)
     (zerop
       (logand 1
         (cdr
           (assoc 70
             (tblsearch "LAYER" *oldlayer*)
           )
         )
       )
     )
   )
   (progn
     (setvar 'CLAYER *oldlayer*)
     (setq *oldlayer* nil)
   )
 )  
 (princ)
)
(defun LM:MakeLayer ( name colour )
 (or (tblsearch "LAYER" name)
   (entmakex
     (list
       (cons 0   "LAYER")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbLayerTableRecord")
       (cons 2   name)
       (cons 62  colour)
       (cons 70  0)
     )
   )
 )
)
(princ) (LM:LayerDirector) (princ)

;;-------------------=={ Layer Director }==-------------------;;
;;                                                            ;;
;;  Uses a command reactor to automatically set the layer     ;;
;;  upon the user invoking certain commands.                  ;;
;;                                                            ;;
;;  Layer settings are stored in the list at the top of the   ;;
;;  program. The first entry in the list is the command on    ;;
;;  which the reactor will trigger, it may use wildcards.     ;;
;;  The second entry is the designated layer for the command  ;;
;;  entered, this layer will be created if non-existent.      ;;
;;  The third entry is the layer colour that will be used if  ;;
;;  the layer is to be created in the drawing.                ;;
;;                                                            ;;
;;  The Reactor is enabled upon loading the program - it may  ;;
;;  be toggled on and off by typing 'LDON' or 'LDOFF' at the  ;;
;;  command line.                                             ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
(defun c:LDON  nil (LM:LayerDirector   T))
(defun c:LDOFF nil (LM:LayerDirector nil))
(defun LM:LayerDirector ( on / react )
 (setq *LayerData*
  '(
    ("*TEXT"           "TEXT"       2)
    ("*DIM*,*QLEADER"  "DIMENSIONS" 2)
    ("*VPORT*"         "DEFPOINTS"  7)
   )
 )
 (setq react
   (vl-some
     (function
       (lambda ( reactor )
         (if (eq "LayerDirector" (vlr-data reactor))
           reactor
         )
       )
     )
     (cdar (vlr-reactors :vlr-command-reactor))
   )
 )
 
 (cond
   ( on
     (if react
       (if (vlr-added-p react)
         (princ "\n--> Layer Director Already Running.")
         (vlr-add react)
       )
       (progn
         (vlr-command-reactor "LayerDirector"
           (list
             (cons :vlr-commandWillStart 'LayerDirectorSet)
             (cons :vlr-commandEnded     'LayerDirectorReset)
             (cons :vlr-commandCancelled 'LayerDirectorReset)
           )
         )
         (princ "\n--> Layer Director Enabled.")
       )
     )
   )
   ( react
     (vlr-remove react)
     (princ "\n--> Layer Director Disabled.")
   )
   ( (princ "\n--> Layer Director Not Running.") )
 )
 (princ)
)
(defun LayerDirectorSet ( reactor params / layerdetails layer ) 
 (if
   (and
     (setq params (strcase (car params)) layerdetails
       (vl-some
         (function
           (lambda ( x )
             (if (wcmatch params (car x)) (cdr x))
           )
         )
         *LayerData*
       )
     )
     (LM:MakeLayer (setq layer (car layerdetails)) (cadr layerdetails))
     (zerop
       (logand 1
         (cdr
           (assoc 70
             (tblsearch "LAYER" layer)
           )
         )
       )
     )
   )
   (progn
     (setq *oldlayer* (getvar 'CLAYER))      
     (setvar 'CLAYER layer)
   )
 )
 (princ)
)
(defun LayerDirectorReset ( reactor params ) 
 (if
   (and (not (wcmatch (strcase (car params)) "*UNDO")) *oldlayer* (tblsearch "LAYER" *oldlayer*)
     (zerop
       (logand 1
         (cdr
           (assoc 70
             (tblsearch "LAYER" *oldlayer*)
           )
         )
       )
     )
   )
   (progn
     (setvar 'CLAYER *oldlayer*)
     (setq *oldlayer* nil)
   )
 )  
 (princ)
)
(defun LM:MakeLayer ( name colour )
 (or (tblsearch "LAYER" name)
   (entmakex
     (list
       (cons 0   "LAYER")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbLayerTableRecord")
       (cons 2   name)
       (cons 62  colour)
       (cons 70  0)
     )
   )
 )
)
(princ) (vl-load-com) (LM:LayerDirector T) (princ)