[编程交流] 层状反应器

(defun c:TabNameOn ()
(vl-load-com)
 (if (not com:react)
   (progn
     (setq com:react
  (vlr-command-reactor nil
    '((:vlr-commandWillStart . ComReactBegin)
      (:vlr-commandEnded . ComReactEnd)
      (:vlr-commandCancelled . ComReactCancel))))
     (princ "\n<<< Command reactor Switched ON >>>")
      ); end progn
     ); end if
   (princ)
   ); end of c:TabNameOn
 (defun c:TabNameOff ()
   (if com:react
     (progn
      (vlr-Remove com:react)
      (setq com:react nil)
      (princ "\n<<< Command reactor Switched OFF >>> ")
      ); end progn
     ); end if
   ); end of c:TabNameOff
 (defun ComReactBegin (react args / layname comLst nLay)
   (setq layname (getvar 'ctab))
   (setq layname (strcase (strcat "C-ANNO-" layname "-TEXT")))
   (setq comLst '(((layname 3)
                   "MTEXT"
                   "DTEXT"
                   "TEXT"
                   "EATTEXT"
                   "QLEADER"
                   "MLEADER"
                   "LEADER"
                   "REVCLOUD"
                   "TABLE"
                   "DATAEXTRACTION"
                  )
                 ) ; end comLst
   ) ; end setq
   (foreach itm comLst
     (if (member (car args) itm)
(progn
  (if (not (tblsearch "LAYER" layname))
    (progn
     (setq nLay (vla-Add (vla-get-Layers
        (vla-get-ActiveDocument
          (vlax-get-acad-object))) layname))
     (vla-put-Color nLay (cadar itm))
     (setq com:resFlg T)
     ); end progn
    ); end if
   (setq com:oldLay (getvar 'clayer)
         com:resFlg T)
   (setvar 'clayer layname)
  ); end progn
); end if
     ); end foreach
   (princ)
   ); end of ComReactBegin
 (defun ComReactEnd(react args)
   (if com:resFlg
     (progn
(setq com:resFlg nil)
       (setvar 'clayer com:oldLay)
      ); end progn
     ); end if
   (princ)
   ); end of ComReactEnd
 (defun ComReactCancel(react args)
   (if com:resFlg
     (progn
(setq com:resFlg nil)
       (setvar 'clayer com:oldLay)
      ); end progn
     ); end if
   (princ)
   ); end of ComReactCancel
(princ "\nType TABNAMEON to switch-on and TABNAMEOFF switch-off command reactor! ")
(c:TabNameOn)

(vl-load-com)
;; Tharwat - 16.Oct.2017        ;;
(defun SetLayerApp ()
 (or *SetLayerReactor*
   (setq *SetLayerReactor* (vlr-sysvar-reactor nil '((:vlr-sysVarChanged . SetLayer)))) 
 ) 
) 
(defun SetLayer (e p / l)
 (if (or (eq (car p) "CLAYOUT") (eq (car p) "CTAB"))
   (and (or (tblsearch "LAYER" (setq l (strcat "anno-text-" (setq *currenttab* (getvar 'CTAB)))))
            (vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) l))
        (setvar 'CLAYER l)
        )
   )
 )
 (SetLayerApp)

(vl-load-com)
(foreach rtr (cdar (vlr-reactors :vlr-miscellaneous-reactor))
   (if (= "layout-text-reactor" (vlr-data rtr)) (vlr-remove rtr))
)
(vlr-miscellaneous-reactor "layout-text-reactor" '((:vlr-layoutswitched . layout-text-reactor-callback)))
(defun layout-text-reactor-callback ( rtr arg / lyn )
   (if (/= "model" (strcase (car arg) t))
       (progn
           (vla-put-freeze
               (vla-add
                   (cond
                       (layout-text-reactor-layers)
                       ((setq layout-text-reactor-layers (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))))
                   )
                   (setq lyn (strcat "anno-text-" (car arg)))
               )
               :vlax-false
           )
           (setvar 'clayer lyn)
       )
   )
   (princ)
)