Jump to content

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


pmxcad

Recommended Posts

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

Link to comment
Share on other sites

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 by ronjonp
Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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)

 

  • Like 2
Link to comment
Share on other sites

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 by ronjonp
Link to comment
Share on other sites

  • 1 year later...
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 by Lee Mac
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...