Dynamic Block / Match Properties

Hey everyone !! ... I have a questions...

is there a lisp function that will match dynamic properties if the block is named the same.

Example: If i have a distance set in one block and want 3 other blocks to match that distance is there a function that will do this.

Thanks for the help

Joey G

How did I missed this!

I thought about writing myself one, but It already existed... (maybe I'm a bad googler). Nice one, Lee!

Thanks!

OMG !! ... LEE MAC !! you are amazing !! Thank you , Worked perfect

You're welcome!

Hello all,

How can I adjust the lisp routine of Lee Mac so that only the custom property Angle1 is matched and that it is possible to match this properties between blocks with different names?

;; 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)

Try the following untested code - change the pattern parameter to suit which parameters should be matched:

;; Match Dynamic Block Properties  -  Lee Mac
;; Matches all dynamic block properties from a selected source dynamic block
;; to all selected destination dynamic blocks holding matching parameters

(defun c:dynmatch ( / blk des inc obj pat prp src val )

    (setq pat "Angle1") ;; Change to "*" to match all
    
    (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.")
                        )
                        (   (not
                                (setq prp
                                    (vl-remove-if '(lambda ( p ) (or (= "ORIGIN" (car p)) (not (wcmatch (car p) (strcase pat)))))
                                        (mapcar
                                           '(lambda ( x ) (cons (strcase (vla-get-propertyname x)) (vlax-get x 'value)))
                                            (vlax-invoke src 'getdynamicblockproperties)
                                        )
                                    )
                                )
                            )
                            (princ "\nBlock has no dynamic parameters to match.")
                        )
                    )
                )
            )
        )
    )
    (if (and (= 'vla-object (type src))
             (setq des (LM:ssget "\nSelect Destination Dynamic Blocks: " '("_:L" ((0 . "INSERT")))))
        )
        (repeat (setq inc (sslength des))
            (setq inc (1- inc)
                  obj (vlax-ename->vla-object (ssname des inc))
            )
            (if (= :vlax-true (vla-get-isdynamicblock obj))
                (foreach p (vlax-invoke obj 'getdynamicblockproperties)
                    (if (setq val (cdr (assoc (strcase (vla-get-propertyname a)) prp)))
                        (vla-put-value p val)
                    )
                )
            )
        )
    )
    (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)