TheSwamp
CAD Forums => CAD General => Dynamic Blocks => Topic started by: M-dub on April 19, 2013, 11:17:16 AM
-
I'm wondering if there's some kind of function similar to MATCHPROP where it would allow you to match the state of dynamic blocks. Select a source block and then, the destination blocks. As long as the blocks are all the same name, it would... match the state.
-
Here is a quick hack, but should work as required:
;; Match Dynamic Block Properties - Lee Mac
;; Matches all dynamic block properties from a selected source dynamic block
;; to all selected destination dynamic blocks of the same name.
(defun c:dynmatch ( / blk des inc obj prp src )
(while
(progn (setvar 'errno 0) (setq src (car (entsel "\nSelect Source Dynamic Block: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type src))
(cond
( (/= "INSERT" (cdr (assoc 0 (entget src))))
(princ "\nObject is not a block.")
)
( (= :vlax-false (vla-get-isdynamicblock (setq src (vlax-ename->vla-object src))))
(princ "\nBlock is not dynamic.")
)
)
)
)
)
)
(if
(and (= 'vla-object (type src))
(setq des
(LM:ssget "\nSelect Destination Dynamic Blocks: "
(list "_:L"
(list '(0 . "INSERT")
(cons 2
(strcat "`*U*,"
(setq blk (strcase (vla-get-effectivename src)))
)
)
)
)
)
)
(setq prp
(mapcar 'vla-get-value
(vlax-invoke src 'getdynamicblockproperties)
)
)
)
(repeat (setq inc (sslength des))
(setq obj (vlax-ename->vla-object (ssname des (setq inc (1- inc)))))
(if (= (strcase (vla-get-effectivename obj)) blk)
(mapcar
(function
(lambda ( a b )
(if (/= "ORIGIN" (strcase (vla-get-propertyname a)))
(vla-put-value a b)
)
)
)
(vlax-invoke obj 'getdynamicblockproperties)
prp
)
)
)
)
(princ)
)
;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;;
;; Arguments:
;; msg - selection prompt
;; params - list of ssget arguments
(defun LM:ssget ( msg params / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget params))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
(vl-load-com) (princ)
-
Nice-Lee Done! (yes, I said that...) That's fantastic! :)
I have some people who often forget to set certain properties and this makes it quick and easy to fix their work.
Thanks!
-
Select the block
<right click> / Select Similar
Properties
Change the state
?
-
Select the block
<right click> / Select Similar
Properties
Change the state
?
Way to make me feel like an idiot, Tim. :P
Kidding! Well, half kidding, anyway.
I should've thought to try that. Duh...
-
Select the block
<right click> / Select Similar
Properties
Change the state
?
Way to make me feel like an idiot, Tim. :P
Kidding! Well, half kidding, anyway.
I should've thought to try that. Duh...
Don't feel bad Mike, I spent an entire day looking into this only to come to this realization........<facepalm>
-
Well, thank-you!
(I forgot to say that)
-
You're welcome
-
Nice-Lee Done! (yes, I said that...) That's fantastic! :)
I have some people who often forget to set certain properties and this makes it quick and easy to fix their work.
Thanks!
:D
You're very welcome Mike :-)
-
Sorry for reviving this thread...
can it be updated so that the attributes in the source dynamic block also matches with the destination?
-
Sorry for reviving this thread...
can it be updated so that the attributes in the source dynamic block also matches with the destination?
Untested, but you get an idea...
;; Match Dynamic Block Properties - Lee Mac
;; Matches all dynamic block properties from a selected source dynamic block
;; to all selected destination dynamic blocks of the same name.
;;
;; Mod. by M.R., @ribarm, DATE : 02.April.2022. - included matching attribute values
(defun c:dynmatch ( / *error* LM:ssget adoc blk des inc obj prp atp att src )
(vl-load-com)
(defun *error* ( m )
(vla-endundomark adoc)
(if m (prompt m))
(princ)
)
;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;;
;; Arguments:
;; msg - selection prompt
;; params - list of ssget arguments
(defun LM:ssget ( msg params / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget params))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark adoc)
)
(vla-startundomark adoc)
(while
(progn (setvar 'errno 0) (setq src (car (entsel "\nSelect Source Dynamic Block: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type src))
(cond
( (/= "INSERT" (cdr (assoc 0 (entget src))))
(princ "\nObject is not a block.")
)
( (= :vlax-false (vla-get-isdynamicblock (setq src (vlax-ename->vla-object src))))
(princ "\nBlock is not dynamic.")
)
)
)
)
)
)
(if
(and (= 'vla-object (type src))
(setq des
(LM:ssget "\nSelect Destination Dynamic Blocks: "
(list "_:L"
(list '(0 . "INSERT")
(cons 2
(strcat "`*U*,"
(setq blk (strcase (vla-get-effectivename src)))
)
)
)
)
)
)
(setq prp
(mapcar 'vla-get-value
(vlax-invoke src 'getdynamicblockproperties)
)
)
(if (= (vla-get-hasattributes src) :vlax-true)
(setq atp
(mapcar 'vla-get-textstring
(setq att (vlax-invoke src 'getattributes))
)
)
)
)
(repeat (setq inc (sslength des))
(setq obj (vlax-ename->vla-object (ssname des (setq inc (1- inc)))))
(if (= (strcase (vla-get-effectivename obj)) blk)
(progn
(mapcar
(function
(lambda ( a b )
(if (/= "ORIGIN" (strcase (vla-get-propertyname a)))
(vla-put-value a b)
)
)
)
(vlax-invoke obj 'getdynamicblockproperties)
prp
)
(if atp
(mapcar
(function
(lambda ( a b c )
(if (= (strcase (vla-get-tagstring a)) (strcase (vla-get-tagstring b)))
(vla-put-textstring b c)
)
)
)
att
(vlax-invoke obj 'getattributes)
atp
)
)
)
)
)
)
(*error* nil)
)
HTH., M.R.
-
Sorry for reviving this thread...
can it be updated so that the attributes in the source dynamic block also matches with the destination?
Untested, but you get an idea...
;; Match Dynamic Block Properties - Lee Mac
;; Matches all dynamic block properties from a selected source dynamic block
;; to all selected destination dynamic blocks of the same name.
;;
;; Mod. by M.R., @ribarm, DATE : 02.April.2022. - included matching attribute values
(defun c:dynmatch ( / *error* LM:ssget adoc blk des inc obj prp atp att src )
(vl-load-com)
(defun *error* ( m )
(vla-endundomark adoc)
(if m (prompt m))
(princ)
)
;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;;
;; Arguments:
;; msg - selection prompt
;; params - list of ssget arguments
(defun LM:ssget ( msg params / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget params))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark adoc)
)
(vla-startundomark adoc)
(while
(progn (setvar 'errno 0) (setq src (car (entsel "\nSelect Source Dynamic Block: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type src))
(cond
( (/= "INSERT" (cdr (assoc 0 (entget src))))
(princ "\nObject is not a block.")
)
( (= :vlax-false (vla-get-isdynamicblock (setq src (vlax-ename->vla-object src))))
(princ "\nBlock is not dynamic.")
)
)
)
)
)
)
(if
(and (= 'vla-object (type src))
(setq des
(LM:ssget "\nSelect Destination Dynamic Blocks: "
(list "_:L"
(list '(0 . "INSERT")
(cons 2
(strcat "`*U*,"
(setq blk (strcase (vla-get-effectivename src)))
)
)
)
)
)
)
(setq prp
(mapcar 'vla-get-value
(vlax-invoke src 'getdynamicblockproperties)
)
)
(if (= (vla-get-hasattributes src) :vlax-true)
(setq atp
(mapcar 'vla-get-textstring
(setq att (vlax-invoke src 'getattributes))
)
)
)
)
(repeat (setq inc (sslength des))
(setq obj (vlax-ename->vla-object (ssname des (setq inc (1- inc)))))
(if (= (strcase (vla-get-effectivename obj)) blk)
(progn
(mapcar
(function
(lambda ( a b )
(if (/= "ORIGIN" (strcase (vla-get-propertyname a)))
(vla-put-value a b)
)
)
)
(vlax-invoke obj 'getdynamicblockproperties)
prp
)
(if atp
(mapcar
(function
(lambda ( a b c )
(if (= (strcase (vla-get-tagstring a)) (strcase (vla-get-tagstring b)))
(vla-put-textstring b c)
)
)
)
att
(vlax-invoke obj 'getattributes)
atp
)
)
)
)
)
)
(*error* nil)
)
HTH., M.R.
Thanks will try this out later as i am not in front of the pc currently