Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 11/14/2021 in all areas

  1. I have this My Match Properties, its not reversing the properties but still might be helpful. More than 4 years old (I feel like I wrote it yesterday) time flies.... ; 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
    2 points
  2. i have a number of objects that I have to keep moving over 20". In my head I justify laziness into efficiency.
    1 point
×
×
  • Create New...