Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
various

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

Các bài được khuyến nghị

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)
    )
)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×