CAD Forums > Dynamic Blocks
Match State
ribarm:
--- Quote from: RolandOrzabal on March 31, 2022, 10:39:11 PM ---Sorry for reviving this thread...
can it be updated so that the attributes in the source dynamic block also matches with the destination?
--- End quote ---
Untested, but you get an idea...
--- Code: ---;; 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)
)
--- End code ---
HTH., M.R.
RolandOrzabal:
--- Quote from: ribarm on April 02, 2022, 02:30:37 AM ---
--- Quote from: RolandOrzabal on March 31, 2022, 10:39:11 PM ---Sorry for reviving this thread...
can it be updated so that the attributes in the source dynamic block also matches with the destination?
--- End quote ---
Untested, but you get an idea...
--- Code: ---;; 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)
)
--- End code ---
HTH., M.R.
--- End quote ---
Thanks will try this out later as i am not in front of the pc currently
Navigation
[0] Message Index
[*] Previous page
Go to full version