match properties of custom parameter of dynamic block to another blocks

[kamo]

hi there  
I have this code from the king lee mac (may god bless him)
but i want to modify it to choose from a list a specific parameters to apply on other blocks 
thanks in advance my brothers

 

;; 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:dmi ( / *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)
)

[BIGAL]

Maybe some thing like this, save multi radio buttons.lsp to a support path as its auto loaded. Yes uses the great program by Lee. This is what I saved his programs as, "Lee-mac Dynamic block get-put.lsp"

 

; Change dynamic block properties when inserting look at properties available.
; By Alan H June 2022

;; Get Dynamic Block Property Allowed Values  -  Lee Mac
;; Returns the allowed values for a specific Dynamic Block property.
;; Set Dynamic Block Visibility State  -  Lee Mac
;; Sets the Visibility Parameter of a Dynamic Block (if present) to a specific value (if allowed)
;; Get Visibility Parameter Name  -  Lee Mac
;; Returns the name of the Visibility Parameter of a Dynamic Block (if present)

(defun insdynv (blkname / pt obj lst ans)
(if (not LM:setdynpropvalue )(load "Lee-mac Dynamic block get-put"))
(setq pt (getpoint "\nPick a pt for block "))
(command "-insert" blkname "s" 1.0  pt 0)
(setq obj (vlax-ename->vla-object (entlast)))
(setq visval (LM:getvisibilityparametername obj))
(setq lst (LM:getdynpropallowedvalues obj visval))
(setq lst (cons "Please choose" lst))
(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
(if (not AHbut)(setq AHbut 1))
(setq ans (ah:butts 1 "v"  lst))
(LM:SetVisibilityState obj ans)
(princ)
)

; set existing block visibilty

(defun insdyne (blkname / pt obj lst ans)
(if (not LM:setdynpropvalue )(load "Lee-mac Dynamic block get-put"))
(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
(setq obj (vlax-ename->vla-object (car (entsel "\nPick a dynamic block "))))
(setq visval (LM:getvisibilityparametername obj))
(setq lst (LM:getdynpropallowedvalues obj visval))
(setq lst (cons "Please choose" lst))
(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
(if (not AHbut)(setq AHbut 1))
(setq ans (ah:butts 1 "v"  lst))
(LM:SetVisibilityState obj ans)
(princ)
)