Author Topic: Match State  (Read 15625 times)

0 Members and 1 Guest are viewing this topic.

M-dub

  • Guest
Match State
« 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.

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Match State
« Reply #1 on: April 19, 2013, 12:26:44 PM »
Here is a quick hack, but should work as required:
Code: [Select]
;; 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)

M-dub

  • Guest
Re: Match State
« Reply #2 on: April 19, 2013, 12:44:26 PM »
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!

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Re: Match State
« Reply #3 on: April 19, 2013, 12:45:20 PM »
Select the block
<right click> / Select Similar
Properties
Change the state

?
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

M-dub

  • Guest
Re: Match State
« Reply #4 on: April 19, 2013, 12:51:41 PM »
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...

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Re: Match State
« Reply #5 on: April 19, 2013, 12:54:56 PM »
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>
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

M-dub

  • Guest
Re: Match State
« Reply #6 on: April 19, 2013, 01:08:48 PM »
Well, thank-you!

(I forgot to say that)

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Re: Match State
« Reply #7 on: April 19, 2013, 01:10:24 PM »
You're welcome
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Match State
« Reply #8 on: April 19, 2013, 01:46:23 PM »
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 :-)

RolandOrzabal

  • Newt
  • Posts: 86
  • "memories fade but the scars still linger"
Re: Match State
« Reply #9 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?
"memories fade but the scars still linger"

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Match State
« Reply #10 on: April 02, 2022, 02:30:37 AM »
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...

Code: [Select]
;; 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.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

RolandOrzabal

  • Newt
  • Posts: 86
  • "memories fade but the scars still linger"
Re: Match State
« Reply #11 on: April 12, 2022, 12:57:37 AM »
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...

Code: [Select]
;; 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
"memories fade but the scars still linger"