[ Nhờ Chỉnh Sửa ] Lisp Reactor Cho Acad2017

[various 9]

Chào mọi người. Em có dùng lisp reactor. Với cad2017 ( hoặc 2016 ) thì nó vô tác dụng, trong khi 2010 vẫn okie. Mong mọi người có thể giúp tháo gỡ khó khăn này :D

 

Đây là code lisp ạ

 

 

layerdirector:data
   '(
                           
;;-----------------------------------------------------------------------------------------------------------------------------------------------------;;
;;  Command Pattern  |  Layer Name    |       Description       |    Colour    |   Linetype   |    Lineweight    |       Plot       |    Plot Style    ;;
;;-----------------------------------------------------------------------------------------------------------------------------------------------------;;
;;     [string]      |   [string]     |         [string]        | 0 < int <256 |   [string]   | -3 = Default     |  1 = Will Plot   |     [string]     ;;
;;                   |                |     Use "" for none     |              |              |  0 <= int <= 211 |  0 = Won't Plot  |  Use nil for CTB ;;
;;-----------------------------------------------------------------------------------------------------------------------------------------------------;;
 
("[DM]TEXT,TEXT"       "TEXT"           "Text Layer"                   2        "Continuous"           -3                 1                 nil         )
("DIM*,*LEADER"        "DIMENSIONS"     "Dimension Layer"              3        "Continuous"           -3                 1                 nil         )
("*VPORT*"             "DEFPOINTS"      ""                             7        "Continuous"           -3                 0                 nil         )
("XLINE"               "XLINE"          "Construction Lines"          12        "HIDDEN"                0                 0                 nil         )
 
;;-----------------------------------------------------------------------------------------------------------------------------------------------------;;
 
    )
 
;;----------------------------------------------------------------------;;
;;  Force Layer Properties  [ t / nil ]                                 ;;
;;  ==================================================================  ;;
;;                                                                      ;;
;;  If set to T the properties of existing layers will be modified to   ;;
;;  match those found in the Layer Data list above.                     ;;
;;----------------------------------------------------------------------;;
 
layerdirector:forcelayprops nil
 
;;----------------------------------------------------------------------;;
;;  System Variable Settings                                            ;;
;;  ==================================================================  ;;
;;                                                                      ;;
;;  Populate this list with system variables whose values should be     ;;
;;  automatically changed when a layer change is triggered.             ;;
;;                                                                      ;;
;;  The first item should be a symbol or string corresponding to the    ;;
;;  name of a system variable; the second item should represent the     ;;
;;  value to which the system variable should be set when a layer       ;;
;;  change is triggered.                                                ;;
;;                                                                      ;;
;;  This parameter is optional: remove all list items if no system      ;;
;;  variable changes are to be performed.                               ;;
;;----------------------------------------------------------------------;;
 
layerdirector:sysvars
   '(
 
;;---------------------------------;;
;;  System Variable  |    Value    ;;
;;---------------------------------;;
 
(cecolor              "bylayer")
(celtype              "bylayer")
(celweight               -1    )
 
;;----------------------------------------------------------------------;;
 
    )
 
;;----------------------------------------------------------------------;;
;;  XRef-Dependent Layering                                             ;;
;;  ==================================================================  ;;
;;                                                                      ;;
;;  This option will cause external references (xrefs) to be inserted   ;;
;;  on a layer whose layer name is dependent on the name of the xref.   ;;
;;                                                                      ;;
;;  The first and second items in the below list represent an optional  ;;
;;  prefix and suffix which will surround the xref name in the name of  ;;
;;  the layer generated by the program.                                 ;;
;;                                                                      ;;
;;  The remaining items in the list determine the properties of the     ;;
;;  layers generated by the program for each xref; the order and        ;;
;;  permitted values of such properties are identical to those used by  ;;
;;  the Layer Data list above.                                          ;;
;;                                                                      ;;
;;  To disable this option, simply replace the below list with nil.     ;;
;;----------------------------------------------------------------------;;
 
layerdirector:xreflayer
 
;;-----------------------------------------------------------------------------------------------------------------------------------------------------;;
;;   Layer Prefix   |  Layer Suffix   |       Description       |    Colour    |   Linetype   |    Lineweight    |       Plot       |    Plot Style    ;;
;;-----------------------------------------------------------------------------------------------------------------------------------------------------;;
;;    [string]      |    [string]     |         [string]        | 0 < int <256 |   [string]   | -3 = Default     |  1 = Will Plot   |     [string]     ;;
;; Use "" for none  | Use "" for none |     Use "" for none     |              |              |  0 <= int <= 211 |  0 = Won't Plot  |  Use nil for CTB ;;
;;-----------------------------------------------------------------------------------------------------------------------------------------------------;;
 
'("XREF-"             ""               "XRef Layer"                   250        "Continuous"           -3                 1                 nil        )
 
;;-----------------------------------------------------------------------------------------------------------------------------------------------------;;
 
;;----------------------------------------------------------------------;;
;;  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.                                      ;;
;;----------------------------------------------------------------------;;
 
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))
 
;;----------------------------------------------------------------------;;
 
(if layerdirector:sysvars
    (setq layerdirector:sysvars
        (apply 'mapcar
            (cons 'list
                (vl-remove-if-not '(lambda ( x ) (getvar (car x)))
                    layerdirector:sysvars
                )
            )
        )
    )
)
 
;;----------------------------------------------------------------------;;
 
(defun LM:layerdirector ( on )
    (foreach grp (vlr-reactors :vlr-command-reactor :vlr-lisp-reactor)
        (foreach obj (cdr grp)
            (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)
                )
            )
            (vlr-lisp-reactor "LM:layerdirector"
               '(
                    (:vlr-lispwillstart . LM:layerdirector:set)
                    (:vlr-lispended     . LM:layerdirector:reset)
                    (:vlr-lispcancelled . LM:layerdirector:reset)
                )
            )
            (princ "\nLayer Director enabled.")
        )
        (princ "\nLayer Director disabled.")
    )
    (princ)
)
 
;;----------------------------------------------------------------------;;
 
(defun LM:layerdirector:lispcommand ( str )
    (if (wcmatch str "(C:*)") (substr str 4 (- (strlen str) 4)) str)
)
 
;;----------------------------------------------------------------------;;
 
(defun LM:layerdirector:set ( obj arg / lst tmp )
    (if
        (and
            (setq arg (car arg))
            (setq arg (LM:layerdirector:lispcommand (strcase 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)
                  layerdirector:oldvars  (mapcar 'getvar (car layerdirector:sysvars))
            )
            (if layerdirector:sysvars
                (apply 'mapcar (cons 'setvar layerdirector:sysvars))
            )
            (setvar 'clayer (car lst))
        )
    )
    (if layerdirector:printcommand (print arg))
    (princ)
)
 
;;----------------------------------------------------------------------;;
 
(defun LM:layerdirector:reset ( obj arg / tmp )
    (if (or (null (car arg)) (not (wcmatch (strcase (car arg)) "U,UNDO")))
        (progn
            (if (and (= '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)
                )
            )
            (mapcar 'setvar (car layerdirector:sysvars) layerdirector:oldvars)
            (setq layerdirector:oldvars nil)
            (if (and (car arg) (wcmatch (strcase (car arg)) "XATTACH,CLASSICXREF"))
                (LM:layerdirector:xreflayer)
            )
        )
    )
    (princ)
)
 
;;----------------------------------------------------------------------;;
 
(defun LM:layerdirector:xreflayer ( / ent enx lay obj xrf )
    (if
        (and
            (= 'list  (type layerdirector:xreflayer))
            (setq ent (entlast))
            (setq enx (entget ent))
            (= "INSERT" (cdr (assoc 0 enx)))
            (setq xrf   (cdr (assoc 2 enx))
                  lay   (strcat (car layerdirector:xreflayer) xrf (cadr layerdirector:xreflayer))
            )
            (= 4 (logand 4 (cdr (assoc 70 (tblsearch "block" xrf)))))
            (LM:layerdirector:createlayer (cons lay (cddr layerdirector:xreflayer)))
            (setq obj (vlax-ename->vla-object ent))
            (vlax-write-enabled-p obj)
        )
        (vla-put-layer obj lay)
    )
)
 
;;----------------------------------------------------------------------;;
 
(defun LM:layerdirector:createlayer ( lst / def )
    (if (or layerdirector:forcelayprops (not (setq def (tblsearch "layer" (car lst)))))
        (apply
           '(lambda ( lay des col ltp lwt plt pst / dic )
                (   (lambda ( def / ent )
                        (if (setq ent (tblobjname "layer" (car lst)))
                            (entmod (cons (cons -1 ent) def))
                            (entmake def)
                        )
                    )
                    (vl-list*
                       '(000 . "LAYER")
                       '(100 . "AcDbSymbolTableRecord")
                       '(100 . "AcDbLayerTableRecord")
                       '(070 . 0)
                        (cons 002 lay)
                        (cons 062 (if (< 0 col 256) col 7))
                        (cons 006 (if (LM:layerdirector:loadlinetype ltp) ltp "Continuous"))
                        (cons 370 (if (or (= -3 lwt) (<= 0 lwt 211)) lwt -3))
                        (cons 290 plt)
                        (append
                            (if (and (= 'str (type pst))
                                     (zerop (getvar 'pstylemode))
                                     (setq dic (dictsearch (namedobjdict) "acad_plotstylename"))
                                     (setq dic (dictsearch (cdr (assoc -1 dic)) pst))
                                )
                                (list (cons 390 (cdr (assoc -1 dic))))
                            )
                            (if (and des (/= "" des))
                                (progn (regapp "AcAecLayerStandard")
                                    (list
                                        (list -3
                                            (list
                                                "AcAecLayerStandard"
                                               '(1000 . "")
                                                (cons 1000 des)
                                            )
                                        )
                                    )
                                )
                            )
                        )
                    )
                )
            )
            lst
        )
        def
    )
)
 
;;----------------------------------------------------------------------;;
 
(defun LM:layerdirector:loadlinetype ( ltp )
    (eval
        (list 'defun 'LM:layerdirector:loadlinetype '( ltp )
            (list 'cond
               '(   (tblsearch "ltype" ltp) ltp)
                (list
                    (list 'vl-some
                        (list 'quote
                            (list 'lambda '( lin )
                                (list 'vl-catch-all-apply ''vla-load
                                    (list 'list (vla-get-linetypes (vla-get-activedocument (vlax-get-acad-object))) 'ltp 'lin)
                                )
                               '(tblsearch "ltype" ltp)
                            )
                        )
                        (list 'quote
                            (vl-remove-if
                               '(lambda ( x )
                                    (member (strcase x t)
                                        (if (zerop (getvar 'measurement))
                                           '("acadiso.lin"  "iso.lin") ;; Known metric   .lin files
                                           '("acad.lin" "default.lin") ;; Known imperial .lin files
                                        )
                                    )
                                )
                                (apply 'append
                                    (mapcar
                                       '(lambda ( dir ) (vl-directory-files dir "*.lin" 1))
                                        (vl-remove "" (LM:layerdirector:str->lst (getenv "ACAD") ";"))
                                    )
                                )
                            )
                        )
                    )
                    'ltp
                )
            )
        )
    )
    (LM:layerdirector:loadlinetype ltp)
)
 
;;----------------------------------------------------------------------;;
 
(defun LM:layerdirector:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:layerdirector: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                              ;;
;;----------------------------------------------------------------------;;
 
 
(   (lambda nil (vl-load-com)
        (defun c:mteditreactoron nil
            (mtedit-reactor-remove)
            (vlr-set-notification
                (vlr-command-reactor "mtedit-reactor"
                   '((:vlr-commandwillstart . mtedit-reactor-callback))
                )
                'active-document-only
            )
            (vlr-set-notification
                (vlr-editor-reactor "mtedit-reactor"
                   '((:vlr-beginclose . mtedit-reactor-clean))
                )
                'active-document-only
            )
            (princ "\nMTEdit Reactor enabled.")
            (princ)
        )
        (defun c:mteditreactoroff nil
            (mtedit-reactor-remove)
            (mtedit-reactor-clean nil nil)
            (princ "\nMTEdit Reactor disabled.")
            (princ)
        )
        (defun mtedit-reactor-callback ( a b )
            (if (wcmatch (strcase (car b) t) "mtedit,mleadercontentedit")
                (if (or mtedit-reactor-wsh (setq mtedit-reactor-wsh (vlax-create-object "wscript.shell")))
                    (vl-catch-all-apply 'vlax-invoke (list mtedit-reactor-wsh 'sendkeys "^{HOME}(^+{END})"))
                )
            )
            (princ)
        )
        (defun mtedit-reactor-clean ( a b )
            (if (= 'vla-object (type mtedit-reactor-wsh))
                (vl-catch-all-apply 'vlax-release-object (list mtedit-reactor-wsh))
            )
            (setq mtedit-reactor-wsh nil)
            (princ)
        )
        (defun mtedit-reactor-remove nil
            (foreach grp (vlr-reactors :vlr-command-reactor :vlr-editor-reactor)
                (foreach obj (cdr grp)
                    (if (= "mtedit-reactor" (vlr-data obj))
                        (vlr-remove obj)
                    )
                )
            )
        )
        (c:mteditreactoron)
        (princ)
    )
)

[Tot77 508]

Vẫn "tác dụng" bình thường mà bạn. Chắc tại bạn không down file gốc :

http://www.cadviet.com/upfiles/6/127168_layerdirectorv16.lsp

[dieptp 8]

Vẫn "tác dụng" bình thường mà bạn. Chắc tại bạn không down file gốc :

http://www.cadviet.com/upfiles/6/127168_layerdirectorv16.lsp

Với cad 2017 x64 thì không có tác dụng bác ạ! Với cả windows7 hay windows10