; My Match Properties - Created by Grrr
; Saved from: https://www.theswamp.org/index.php?topic=52951.0

(defun C:MMP ( / 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 (>\"; 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 : ")))
(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)
);
(c:mmp)

Advertisements