Copy all attributes and visualstate from one selected source block to other selected blocks

[pmxcad]

Hello,

Ik am looking for  a Lisp that Copy all attributes values and visualstate from one selected source block to other selected blocks.

Who can help me?

 

Regards

JM

[ronjonp]

Here's a quick one:

(defun c:foo (/ _dxf e o p s)
  ;; RJP » 2019-01-15
  (defun _dxf (c e) (cdr (assoc c (entget e))))
  (cond	((and (setq e (car (entsel "\nPick source block: ")))
	      (= "INSERT" (_dxf 0 e))
	      (setq s (ssget ":L" '((0 . "insert"))))
	 )
	 (ssdel e s)
	 (setq p (_dxf 10 e))
	 (setq e (vlax-ename->vla-object e))
	 (foreach b (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (setq o (vla-copy e))
	   (vlax-invoke o 'move p (_dxf 10 b))
	   (entdel b)
	 )
	)
  )
  (princ)
)

 

Edited January 15, 2019 by ronjonp

[pmxcad]

Thanks ronjonp, works perfect.....

 

JM

[ronjonp]

Glad to help

[pmxcad]

Ronjonp 1 question:

The Lisp does not only the visability but also the rotation and the flip of the dynamic block.

Can it be made that only the visability is copied tot the blocks (and attributes).

 

JM

 

[Lee Mac]

Try the following code:

(defun c:matchblock ( / att blk ent idx lst obj par sel vis )
    (while
        (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect source block <exit>: ")))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null ent) nil)
                (   (/= "AcDbBlockReference" (vla-get-objectname (setq obj (vlax-ename->vla-object ent))))
                    (princ "\nThe selected object is not a block.")
                )
                (   (= :vlax-false (vla-get-hasattributes obj) (vla-get-isdynamicblock obj))
                    (princ "\nThe selected block is neither attributed nor dynamic.")
                )
            )
        )
    )
    (if (and ent (setq sel (LM:ssget "\nSelect target blocks <exit>: " '("_:L" ((0 . "INSERT"))))))
        (progn
            (setq obj (vlax-ename->vla-object ent)
                  att (LM:vl-getattributevalues obj)
                  vis (LM:getvisibilitystate obj)
            )
            (repeat (setq idx (sslength sel))
                (setq idx (1- idx)
                      obj (vlax-ename->vla-object (ssname sel idx))
                )
                (if att (LM:vl-setattributevalues obj att))
                (if
                    (and vis
                        (= :vlax-true (vla-get-isdynamicblock obj))
                        (or (setq blk (strcase (LM:effectivename obj))
                                  par (cdr (assoc blk lst))
                            )
                            (and (setq par (LM:getvisibilityparametername obj))
                                 (setq lst (cons (cons blk par) lst))
                            )
                        )
                    )
                    (vl-some
                       '(lambda ( prp )
                            (if
                                (and
                                    (= par (vla-get-propertyname prp))
                                    (member vis (vlax-get prp 'allowedvalues))
                                )
                                (vla-put-value prp (vlax-make-variant vis (vlax-variant-type (vla-get-value prp))))
                            )
                        )
                        (vlax-invoke obj 'getdynamicblockproperties)
                    )
                )
            )
        )
    )
    (princ)
)
                            
;; Effective Block Name  -  Lee Mac
;; obj - [vla] VLA Block Reference object

(defun LM:effectivename ( obj )
    (vlax-get-property obj
        (if (vlax-property-available-p obj 'effectivename)
            'effectivename
            'name
        )
    )
)

;; Get Attribute Values  -  Lee Mac
;; Returns an association list of attributes present in the supplied block.
;; blk - [vla] VLA Block Reference Object
;; Returns: [lst] Association list of ((<tag> . <value>) ... )

(defun LM:vl-getattributevalues ( blk )
    (mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)

;; Set Attribute Values  -  Lee Mac
;; Sets attributes with tags found in the association list to their associated values.
;; blk - [vla] VLA Block Reference Object
;; lst - [lst] Association list of ((<tag> . <value>) ... )
;; Returns: nil

(defun LM:vl-setattributevalues ( blk lst / itm )
    (foreach att (vlax-invoke blk 'getattributes)
        (if (setq itm (assoc (vla-get-tagstring att) lst))
            (vla-put-textstring att (cdr itm))
        )
    )
)

;; Get Dynamic Block Visibility State  -  Lee Mac
;; Returns the value of the Visibility Parameter of a Dynamic Block (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; Returns: [str] Value of Visibility Parameter, else nil

(defun LM:getvisibilitystate ( blk / vis )
    (if (setq vis (LM:getvisibilityparametername blk))
        (LM:getdynpropvalue blk vis)
    )
)

;; Get Dynamic Block Property Value  -  Lee Mac
;; Returns the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)

(defun LM:getdynpropvalue ( blk prp )
    (setq prp (strcase prp))
    (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value)))
        (vlax-invoke blk 'getdynamicblockproperties)
    )
)

;; Get Visibility Parameter Name  -  Lee Mac
;; Returns the name of the Visibility Parameter of a Dynamic Block (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; Returns: [str] Name of Visibility Parameter, else nil

(defun LM:getvisibilityparametername ( blk / vis )  
    (if
        (and
            (vlax-property-available-p blk 'effectivename)
            (setq blk
                (vla-item
                    (vla-get-blocks (vla-get-document blk))
                    (vla-get-effectivename blk)
                )
            )
            (= :vlax-true (vla-get-isdynamicblock blk))
            (= :vlax-true (vla-get-hasextensiondictionary blk))
            (setq vis
                (vl-some
                   '(lambda ( pair )
                        (if
                            (and
                                (= 360 (car pair))
                                (= "BLOCKVISIBILITYPARAMETER" (cdr (assoc 0 (entget (cdr pair)))))
                            )
                            (cdr pair)
                        )
                    )
                    (dictsearch
                        (vlax-vla-object->ename (vla-getextensiondictionary blk))
                        "ACAD_ENHANCEDBLOCK"
                    )
                )
            )
        )
        (cdr (assoc 301 (entget vis)))
    )
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)

(vl-load-com) (princ)

 

[ronjonp]

Here's another that matches some properties of the replaced block:

(defun c:foo (/ _dxf e o o2 p s)
  ;; RJP » 2019-01-16
  (defun _dxf (c e) (cdr (assoc c (entget e))))
  (cond	((and (setq e (car (entsel "\nPick source block: ")))
	      (= "INSERT" (_dxf 0 e))
	      (setq s (ssget ":L" '((0 . "insert"))))
	 )
	 (ssdel e s)
	 (setq p (_dxf 10 e))
	 (setq e (vlax-ename->vla-object e))
	 (foreach b (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (setq o (vla-copy e))
	   (vlax-invoke o 'move p (_dxf 10 b))
	   ;; Pick what properties you want to match
	   (setq o2 (vlax-ename->vla-object b))
	   (vla-put-rotation o (vla-get-rotation o2))
	   (vla-put-xscalefactor o (vla-get-xscalefactor o2))
	   (vla-put-yscalefactor o (vla-get-yscalefactor o2))
	   (vla-put-zscalefactor o (vla-get-zscalefactor o2))
	   (vla-put-layer o (vla-get-layer o2))
	   (vla-put-color o (vla-get-color o2))
	   (vla-put-linetype o (vla-get-linetype o2))
	   (vla-put-lineweight o (vla-get-lineweight o2))
	   (entdel b)
	 )
	)
  )
  (princ)
)

 

Edited January 16, 2019 by ronjonp

[pmxcad]

Lee, it works perfect.

Ronjonp also thanks for the second one. Could be very useful.

 

jm

[Lee Mac]

Good to hear - you're welcome @pmxcad

[bayu aji]

@Lee MacIs there any option without using vlax function,i use your code qith autocad electrical and get some error in "bad assosiatiin list ("xx/prografilesetx") ...

[Lee Mac]

7 hours ago, bayu aji said:

@Lee MacIs there any option without using vlax function,i use your code qith autocad electrical and get some error in "bad assosiatiin list ("xx/prografilesetx") ...

 

No - it is not possible to manipulate dynamic block properties without using ActiveX - from the error message you have described, I would suggest reinstalling your AutoCAD software, as there would appear to be a corruption with your installation.

Edited April 11, 2020 by Lee Mac