[编程交流] 层提示bef需要lisp

;;--------------------=={ 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 set to be enabled upon loading the program ;;
;;  it can furthermore be toggled on and off using by typing  ;;
;;  'LD' at the command line.                                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
(defun c:LD nil (LM:LayerDirector T))
(defun LM:LayerDirector ( msg )
 (vl-load-com)
 ;; © Lee Mac 2010
 (setq *LayerData*
  '(
    ("*TEXT"           "TEXT"       2)
    ("*DIM*,*QLEADER"  "DIMENSIONS" 2)
    ("*VPORT*"         "DEFPOINTS"  7)
    ("*EXECUTETOOL"    "4"          4)
   )
 )      
 (
   (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 msg
       (if (and react (vlr-added-p react))
         (princ "\n<< Layer Director Enabled >>" )
         (princ "\n<< Layer Director Disabled >>")
       )
     )
   )
   "LayerDirector"
   'LayerDirectorSet
   'LayerDirectorReset
 )
 (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)
     )
   )
 )
)
(defun LayerDirectorSet ( reactor arguments / layerdetails layer )
 (vl-load-com)
 ;; © Lee Mac 2010
 (if
   (and
     (setq layerdetails
       (vl-some
         (function
           (lambda ( x )
             (if (wcmatch (strcase (car arguments)) (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 arguments )
 (vl-load-com)
 ;; © Lee Mac 2010
 (if
   (and (not (wcmatch (strcase (car arguments)) "*UNDO")) *oldlayer*
     (tblsearch "LAYER" *oldlayer*)
     (zerop
       (logand 1
         (cdr
           (assoc 70
             (tblsearch "LAYER" *oldlayer*)
           )
         )
       )
     )
   )
   (progn
     (setvar 'CLAYER *oldlayer*)
     (setq *oldlayer* nil)
   )
 )
 
 (princ)
)
(princ)
(LM:LayerDirector nil)

4

5