MatchProp(刷子）

marting · 发表于 2017-7-20 22:46:34

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

; My Match Properties - Grrr
(defun C:MyMatchProps ( / tgassoc tgswitch *error* dcl des dch dcf tmp L SS tmpL i o )
; Toggle associator - connect toggle value (0 or 1) with symbol value (nil or T):
(defun tgassoc ( keyorval ) (cadr (assoc keyorval '((nil "0")(T "1")("0" nil)("1" T)))) ) ; Grrr
; Toggle switcher - switch toggle's value
(defun tgswitch ( key ) (set_tile key (cadr (assoc (get_tile key) '(("0" "1") ("1" "0")))))) ; Grrr
(defun *error* ( msg )
(and (< 0 dch) (unload_dialog dch))
(and (eq 'FILE (type des)) (close des))
(and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
(and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) ))
(princ)
); defun *error*
(cond
( (progn (and (setq SS (cadr (ssgetfirst))) (sssetfirst nil nil)) nil) ) ; I'm using implied SS, because I often work with SS filters
(
(progn
(while (not (member dcf '(0 1)))
(*error* nil)
(cond
(
(not ; Rewrite and Reload the dialog continiously
(and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
(vl-every (function (lambda (x) (princ (strcat "\n" x) des)))
(list
"MyMatchProps : dialog"
"{ label = \"Match Properties\";"
" spacer; : column "
" { : row "
" { : text { label = \"Source object\"; }"
" : button { key = \"sb\"; label = \">>\"; fixed_width = true; width = 2; }"
" }"
" : row "
" { : text { label = \"Destination objects\"; }"
" : button { key = \"db\"; label = \">>\"; fixed_width = true; width = 2; }"
" }"
" }"
" : spacer { height = 1; }"
(if L
(strcat
" : column"
" { children_fixed_width = true; children_alignment = left;"
" : text { label = \"Properties To Match\"; } spacer;"
(apply 'strcat (mapcar (function (lambda (x) (strcat ": toggle { label = \"" (car x) "\"; key = \"" (car x) "\"; value = 1; }"))) L))
" spacer;"
" : button { label = \"Switch Toggles\"; key = \"Switch\"; mnemonic = \"t\"; }"
" spacer;"
" }"
); strcat
" : text { label = \"Source object not specified!\"; alignment = centered; }"
); if L
" : spacer { height = 1; }"
" ok_cancel; : text { key = \"error\"; }"
"}"
); list
); vl-every
(not (setq des (close des))) (< 0 (setq dch (load_dialog dcl)))
); and
); not
(princ "\nUnable to write or load the DCL file.") (setq dcf 0)
)
( (not (new_dialog "MyMatchProps" dch)) (princ "\nUnable to display the dialog") (setq dcf 0) )
(T
(if tmpL (mapcar (function (lambda (x) (set_tile (car x) (cdr x)))) tmpL)) ; remember (restore) chosen toggles between sessions.
(vl-every (function (lambda (x) (action_tile (car x) (strcat "(done_dialog " (itoa (cadr x)) ")")))) '(("sb" 2) ("db" 3))) ; button actions
(action_tile "Switch"
(vl-prin1-to-string
'(progn
(mapcar (function (lambda (x) (tgswitch x))) (mapcar 'car L))
(setq tmpL (mapcar (function (lambda (x) (cons x (get_tile x)))) (mapcar 'car L)))
); progn
); vl-prin1-to-string
); action_tile
(if L
(vl-every ; toggle actions
(function
(lambda (x)
(action_tile (car x)
(vl-prin1-to-string
'(cond
( (assoc $key tmpL) (setq tmpL (subst (cons $key $value) (assoc $key tmpL) tmpL)) )
( (setq tmpL (cons (cons $key $value) tmpL)) )
); cond
); vl-prin1-to-string
); action_tile
); lambda
); function
L
); vl-every
); if L
(action_tile "accept"
(vl-prin1-to-string
'(cond
( (not L) (set_tile "error" "Check the above message - Grrr.") )
( (not SS) (set_tile "error" "Destination objects not specified!") )
( (setq L (mapcar (function (lambda (x) (append x (list (get_tile (car x)))))) L)) ; end result of L
(done_dialog 1)
)
); cond
); vl-prin1-to-string
); action_tile
(setq dcf (start_dialog))
); T
); cond
(cond
( (= 2 dcf)
(and
(setq tmp
(
(lambda (x / p)
(setvar 'errno 0)
(while (/= 52 (getvar 'errno)) (setq p (car (entsel "\nSelect Source Object <exit>: ")))
(cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again!") (setvar 'errno 0) )
(p (setq p (vlax-ename->vla-object p)) (setvar 'errno 52) )
); cond
); while
p
); lambda
nil
)
); setq tmp
(setq L ; I care about only this list here
(apply 'append
(mapcar (function (lambda (x) (if (vlax-property-available-p tmp x) (list (list x (vlax-get tmp x))))))
'("Color" "Layer" "LineType" "LinetypeScale" "Lineweight"
"EntityTransparency" "Material" "Rotation" "TextString" "StyleName" "Width" "Height"
"AttachmentPoint" "BackgroundFill" "LineSpacingDistance" "LineSpacingFactor" "LineSpacingStyle"
"XEffectiveScaleFactor" "XScaleFactor" "YEffectiveScaleFactor" "YScaleFactor" "ZEffectiveScaleFactor" "ZScaleFactor"
); list
); mapcar
); apply 'append
); setq L
); and
); (= 2 dcf)
( (= 3 dcf) (and (princ "\nSelect Destination Objects: ") (setq tmp (ssget "_:L")) (setq SS tmp) ) ); (= 3 dcf)
); cond
); while
(/= 1 dcf)
); progn
(princ "\nUser cancelled the dialog.")
)
( (and L SS)
(setq L (vl-remove-if (function (lambda (x) (not (tgassoc (caddr x))))) L))
(repeat (setq i (sslength SS))
(and (setq o (vlax-ename->vla-object (ssname SS (setq i (1- i))))) (vlax-write-enabled-p o)
(mapcar
(function
(lambda (x)
(and (vlax-property-available-p o (car x)) (vl-catch-all-apply 'vlax-put (list o (car x) (cadr x))))
); lambda
); function
L
); mapcar
); and
); repeat
; (alert (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (vl-prin1-to-string x))) L))) ; check
; (alert (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (vl-prin1-to-string x))) tmpL))) ; check
); T
); cond
(*error* nil) (princ)
); defun

; My Match Properties - Grrr 
(defun C:MyMatchProps ( / tgassoc tgswitch *error* dcl des dch dcf tmp L SS tmpL i o ) 
 
  ; Toggle associator - connect toggle value (0 or 1) with symbol value (nil or T): 
  (defun tgassoc ( keyorval ) (cadr (assoc keyorval '((nil "0")(T "1")("0" nil)("1" T)))) ) ; Grrr 
 
  ; Toggle switcher - switch toggle's value 
  (defun tgswitch ( key ) (set_tile key (cadr (assoc (get_tile key) '(("0" "1") ("1" "0")))))) ; Grrr 
 
  (defun *error* ( msg ) 
    (and (< 0 dch) (unload_dialog dch)) 
    (and (eq 'FILE (type des)) (close des)) 
    (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl)) 
    (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) )) 
    (princ) 
  ); defun *error* 
 
  (cond 
    ( (progn (and (setq SS (cadr (ssgetfirst))) (sssetfirst nil nil)) nil) ) ; I'm using implied SS, because I often work with SS filters 
    ( 
      (progn 
        (while (not (member dcf '(0 1))) 
          (*error* nil) 
          (cond 
            ( 
              (not ; Rewrite and Reload the dialog continiously 
                (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w")) 
                  (vl-every (function (lambda (x) (princ (strcat "\n" x) des))) 
                    (list 
                      "MyMatchProps : dialog" 
                      "{ label = \"Match Properties\";" 
                      "  spacer; : column " 
                      "  { : row " 
                      "    { : text { label = \"Source object\"; }" 
                      "      : button { key = \"sb\"; label = \">>\"; fixed_width = true; width = 2; }" 
                      "    }" 
                      "    : row " 
                      "    { : text { label = \"Destination objects\"; }" 
                      "      : button { key = \"db\"; label = \">>\"; fixed_width = true; width = 2; }" 
                      "    }" 
                      "  }" 
                      "  : spacer { height = 1; }" 
                      (if L 
                        (strcat 
                          "  : column" 
                          "  { children_fixed_width = true; children_alignment = left;" 
                          "    : text { label = \"Properties To Match\"; }  spacer;" 
                          (apply 'strcat (mapcar (function (lambda (x) (strcat ": toggle { label = \"" (car x) "\"; key = \"" (car x) "\"; value = 1; }"))) L)) 
                          "    spacer;" 
                          "    : button { label = \"Switch Toggles\"; key = \"Switch\"; mnemonic = \"t\"; }" 
                          "    spacer;" 
                          "  }" 
                        ); strcat 
                        "  : text { label = \"Source object not specified!\"; alignment = centered; }" 
                      ); if L 
                      "  : spacer { height = 1; }" 
                      "  ok_cancel; : text { key = \"error\"; }" 
                      "}" 
                    ); list 
                  ); vl-every 
                  (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl))) 
                ); and 
              ); not 
              (princ "\nUnable to write or load the DCL file.") (setq dcf 0) 
            ) 
            ( (not (new_dialog "MyMatchProps" dch)) (princ "\nUnable to display the dialog") (setq dcf 0) ) 
            (T 
              (if tmpL (mapcar (function (lambda (x) (set_tile (car x) (cdr x)))) tmpL)) ; remember (restore) chosen toggles between sessions. 
              (vl-every (function (lambda (x) (action_tile (car x) (strcat "(done_dialog " (itoa (cadr x)) ")")))) '(("sb" 2) ("db" 3))) ; button actions 
              (action_tile "Switch" 
                (vl-prin1-to-string 
                  '(progn 
                    (mapcar (function (lambda (x) (tgswitch x))) (mapcar 'car L)) 
                    (setq tmpL (mapcar (function (lambda (x) (cons x (get_tile x)))) (mapcar 'car L))) 
                  ); progn 
                ); vl-prin1-to-string 
              ); action_tile 
              (if L 
                (vl-every ; toggle actions 
                  (function 
                    (lambda (x) 
                      (action_tile (car x) 
                        (vl-prin1-to-string 
                          '(cond 
                            ( (assoc $key tmpL) (setq tmpL (subst (cons $key $value) (assoc $key tmpL) tmpL)) ) 
                            ( (setq tmpL (cons (cons $key $value) tmpL)) ) 
                          ); cond 
                        ); vl-prin1-to-string 
                      ); action_tile 
                    ); lambda 
                  ); function 
                  L 
                ); vl-every 
              ); if L 
              (action_tile "accept" 
                (vl-prin1-to-string 
                  '(cond 
                    ( (not L) (set_tile "error" "Check the above message - Grrr.") ) 
                    ( (not SS) (set_tile "error" "Destination objects not specified!") ) 
                    ( (setq L (mapcar (function (lambda (x) (append x (list (get_tile (car x)))))) L)) ; end result of L 
                      (done_dialog 1) 
                    ) 
                  ); cond 
                ); vl-prin1-to-string 
              ); action_tile 
              (setq dcf (start_dialog)) 
            ); T 
          ); cond 
          (cond 
            ( (= 2 dcf) 
              (and   
                (setq tmp 
                  ( 
                    (lambda (x / p) 
                      (setvar 'errno 0) 
                      (while (/= 52 (getvar 'errno)) (setq p (car (entsel "\nSelect Source Object <exit>: "))) 
                        (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again!") (setvar 'errno 0) ) 
                          (p (setq p (vlax-ename->vla-object p)) (setvar 'errno 52) ) 
                        ); cond 
                      ); while 
                      p 
                    ); lambda 
                    nil 
                  ) 
                ); setq tmp 
                (setq L ; I care about only this list here 
                  (apply 'append 
                    (mapcar (function (lambda (x) (if (vlax-property-available-p tmp x) (list (list x (vlax-get tmp x)))))) 
                      '("Color" "Layer" "LineType" "LinetypeScale" "Lineweight" 
                        "EntityTransparency" "Material" "Rotation" "TextString" "StyleName" "Width" "Height" 
                        "AttachmentPoint" "BackgroundFill" "LineSpacingDistance" "LineSpacingFactor" "LineSpacingStyle" 
                        "XEffectiveScaleFactor" "XScaleFactor" "YEffectiveScaleFactor" "YScaleFactor" "ZEffectiveScaleFactor" "ZScaleFactor" 
                      ); list 
                    ); mapcar 
                  ); apply 'append 
                ); setq L 
              ); and 
            ); (= 2 dcf) 
            ( (= 3 dcf) (and (princ "\nSelect Destination Objects: ") (setq tmp (ssget "_:L")) (setq SS tmp) ) ); (= 3 dcf) 
          ); cond 
        ); while 
        (/= 1 dcf) 
      ); progn 
      (princ "\nUser cancelled the dialog.") 
    ) 
    ( (and L SS) 
      (setq L (vl-remove-if (function (lambda (x) (not (tgassoc (caddr x))))) L)) 
      (repeat (setq i (sslength SS)) 
        (and (setq o (vlax-ename->vla-object (ssname SS (setq i (1- i))))) (vlax-write-enabled-p o) 
          (mapcar 
            (function 
              (lambda (x) 
                (and (vlax-property-available-p o (car x)) (vl-catch-all-apply 'vlax-put (list o (car x) (cadr x)))) 
              ); lambda 
            ); function 
            L 
          ); mapcar 
        ); and 
      ); repeat 
      ; (alert (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (vl-prin1-to-string x))) L))) ; check 
      ; (alert (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (vl-prin1-to-string x))) tmpL))) ; check 
    ); T 
  ); cond 
  (*error* nil) (princ) 
); defun

longer1000 · 发表于 2017-7-21 01:43:15

高手不凡，感谢

yoyoho · 发表于 2017-7-21 07:17:11

谢谢分享程序！！！

fangmin723 · 发表于 2017-7-21 08:20:24

支持一下，要是有中文版的就好了！

jxwfz19740724 · 发表于 2017-7-21 08:35:25

看不懂，也不清楚是什么用的，要是写个介绍就好了。新手什么都不懂。

zjy2999 · 发表于 2017-7-21 11:36:40

谢谢分享程序！！！

asdttkjn · 发表于 2017-7-21 15:02:38

谢谢你的分享

sh_h · 发表于 2017-7-22 13:57:23

大师的作品都是精品，谢谢大师分享！！！

liutong1997 · 发表于 2017-8-7 08:00:11

非常不错的插件谢谢

alnhny · 发表于 2018-11-15 06:33:50

这个刷子不错和隔壁的刷子类似，但多了对话框。

香远益清 · 发表于 2019-11-28 09:18:29

程序测试成功，但感觉还是没有CAD自带的格式刷方便

猪八戒悟能 · 发表于 2019-11-28 09:34:52

谢谢分享程序！！！

至尊宝宝 · 发表于 2019-11-28 09:43:30

谢谢分享程序！！！

九天揽月亮 · 发表于 2019-11-28 09:59:38

感谢分享程序！

qqp741005 · 发表于 2019-11-29 12:38:08

非常不错的插件谢谢收藏了!

账号		自动登录	找回密码
密码			立即注册

[工具] MatchProp(刷子）

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。