Match Specific Attribute from one block to many

[tmhpoole]

I have searched here and cadalyst's site and can't quite find the exact info I need...

In lisp, how would I copy the value for an attribute tag called WIDGET by selecting the block that has the value I want to paste to other multiple block who have the attribute tag WIDGET defined in them, as well. 
I am guessing that I have to select the block whose value I want to copy, query the value then assign that to a variable.   Then select the blocks to paste to, and apply the tag value to their instance of the WIDGET tag... But that's about all I know....  Please help, anyone who can help me through this- Thanks!!

[bart.oostdam]

This would require a rather significant amount of code, cerntanly if you would make a little 'fool' proof.

I wrote several subroutines to handle retrieving vlaues from atrributes etc. but is is to much to post here as hte code as been filled with checks and warnings for error-handling.

[tmhpoole]

Yeah -- it's going to be a doozy lol...

I found this great utility on Cadalyst's site, but it incorporates a dialog box, asking the user to specify an attribute to copy to other blocks... and I just want one that will be hardcoded to know the attribute tag name ahead of time....

;;;---------------------------------------------------------------------;;;
;;;  MatchAtts.lsp                                                      ;;;
;;;  Created by Will DeLoach                                            ;;;
;;;  Copyright 2005                                                     ;;;
;;;                                                                     ;;;
;;;FUNCTION                                                             ;;;
;;;Creates a variable sized dialog box with attribute tagstrings from the;;
;;;the Source Attribute.  The user selects the values they want to match;;;
;;;and then selects blocks withe same name as the source block and the  ;;;
;;;selected attributes will be changed to match the source attribute.   ;;;
;;;                                                                     ;;;
;;;USAGE                                                                ;;;
;;;(load "matchatts)                                                    ;;;
;;;matchatts                                                            ;;;
;;;                                                                     ;;;
;;;PLATFORMS                                                            ;;;
;;;Tested on 2006; but could work for earlier versions.                 ;;;
;;;                                                                     ;;;
;;;VERSION                                                              ;;;
;;; 1.0   October 3, 2005                                               ;;;
;;; 1.01  October 4, 2005   Fixed Att Selection for Attributes only.    ;;;
;;; 1.02  October 5, 2005   Fixed bug in cond statement                 ;;;
;;; 1.03  November 15, 2005   Replaced get_att SUBR (recmd by T. Willey);;;
;;; 1.1   April 6, 2006   Modifications made by CAB from theSwamp.org   ;;;
;;;                       Fixed duplicate tagname bug.                  ;;;
;;; 1.11  Added the write_line function.                                ;;;
;;; 1.2   Fixed block selection to work with Dynamic Blocks.            ;;;
;;; 1.21  Corrected an error with 'EffectiveName' assumption.           ;;;
;;;                                                                     ;;;
;;;                                                                     ;;;
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED      ;;;
;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR   ;;;
;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.             ;;;
;;;                                                                     ;;;
;;;  You are hereby granted permission to use, copy and modify this     ;;;
;;;  software without charge, provided you do so exclusively for        ;;;
;;;  your own use or for use by others in your organization in the      ;;;
;;;  performance of their normal duties, and provided further that      ;;;
;;;  the above copyright notice appears in all copies and both that     ;;;
;;;  copyright notice and the limited warranty and restricted rights    ;;;
;;;  notice below appear in all supporting documentation.               ;;;
;;;                                                                     ;;;
;;;---------------------------------------------------------------------;;;
(vl-load-com)
(defun c:matchatts (/	   blk
 ;The entity name for the Reference Attribute
		    eblk ;Entity list of blk
		    atts ;List of attributes for 'blk'
		    tags ;List of 'tagstrings' for atts
		    keys ;List of 'handle' for atts
		    vals ;List of 'textstring' for atts
		    dcl_id ;Id number for the dialog box
		    dcl_name ;Name for the dialog box
		    strt ;Id from the done_dialog call
		    lst ;List of values for the toggles
		    ssa ;List of attributes the user selects
		    morder ;flag to chack att order, for future use
		    ename ;entity name
		    lst ;List of Keys
		    rname ;Reference Block Name
		    i ;Increment
		   )
;;;---------------------------------------------------------------------;;;
;;;A rewrite of the entsel function.                                    ;;;
;;;---------------------------------------------------------------------;;;
  (defun ent_sel (msg / ent)
    (while (not ent)
      (cond ((setq ent (entsel msg)))
	    ((= (getvar "ErrNo") 7)
	     (princ "\nSelection missed.  Please try again.")
	    )
	    ((= (getvar "ErrNo") 52) (exit))
      )
    )
    ent
  )
;;;---------------------------------------------------------------------;;;
;;;This is a utility function to return Attribute References for the    ;;;
;;;supplied object or entity name.                                      ;;;
;;;---------------------------------------------------------------------;;;
  (defun get_atts (obj)
    (vlax-invoke (vlax-ename->vla-object obj) 'getattributes)
  )
;;;---------------------------------------------------------------------;;;
;;;This creates a variable dialog box that changes size based on how    ;;;
;;;many attributes are passed to it.  The dialog box is temporary and is;;;
;;;created on the fly.  It is stored in your Acad Temp path location.   ;;;
;;;---------------------------------------------------------------------;;;
  (defun createdialog (lst keys / num tfn fn wid cnt str)
    (defun write_line (lst file) (foreach x lst (write-line x file)))
    (setq num (length tags))
    (cond ((> num 24) (setq wid 4))
	  ((> num 12) (setq wid 3))
	  ((> num 6) (setq wid 2))
	  (T (setq wid 1))
    )
    (setq tfn (vl-filename-mktemp "match_attribute_value.dcl"))
    (setq fn (open tfn "w"))
    (write_line
      (list
	"temp : dialog { label = \"Match Attributes\";"
	": boxed_column { label = \"Select Attributes Values to Match: \";"
	": row {"
      )
      fn
    )
    (setq cnt 0)
    (repeat (1+ wid)
      (write-line ": column {" fn)
      (repeat (/ num wid)
	(if (setq str (nth cnt lst))
	  (progn (write-line
		   (strcat ": toggle { label = "
			   "\""
			   str
			   "\""
			   "; key = "
			   "\""
			   (nth cnt keys)
			   "\""
			   ";}"
		   )
		   fn
		 )
		 (setq cnt (1+ cnt))
	  )
	)
      )
      (write-line "}" fn)
    )
    (write_line
      (list
	"}"
	"spacer_1;"
	" : toggle { key = \"All\"; label = \"Select All\";}"
	"}"
	"ok_cancel;"
	"}"
       )
      fn
    )
    (close fn)
    tfn
  )
;;;---------------------------------------------------------------------;;;
;;;This is the action for 'Select All' Check Box.                       ;;;
;;;---------------------------------------------------------------------;;;
  (defun on_all_pick (lst / str)
    (if	(eq (get_tile "All") "0")
      (setq str "0")
      (setq str "1")
    )
    (mapcar '(lambda (x) (set_tile x str)) lst)
  )
;;;---------------------------------------------------------------------;;;
;;;This takes two lists and compares the two.  Every item in vals that  ;;;
;;;equals "1" is replace with the corresponding item in objs.           ;;;
;;;---------------------------------------------------------------------;;;
;;; CAB modified, create a list of pairs (tagname flag)  where flag 1 0 t/nil
  (defun create_list (vals objs)
    (vl-remove nil
	       (mapcar '(lambda	(x y)
			  (cons	y
				(if (eq x "1")
				  1
				  0
				)
			  )
			)
		       vals
		       objs
	       )
    )
  )
;;;---------------------------------------------------------------------;;;
;;;Receives a Selection Set and returns Entity Names                    ;;;
;;;---------------------------------------------------------------------;;;
  (defun ssnames (selection_set / num lst)
    (repeat (setq num (sslength selection_set))
      (setq num	(1- num)
	    lst	(cons (ssname selection_set num) lst)
      )
    )
    lst
  )
;;;---------------------------------------------------------------------;;;
;;;Accepts a Group code and an Entity List and returns the value.       ;;;
;;;---------------------------------------------------------------------;;;
  (defun dxf (gcode elist) (cdr (assoc gcode elist)))
;;;---------------------------------------------------------------------;;;
;;;---------------------------------------------------------------------;;;
;;;---------------------------------------------------------------------;;;
;;;Main program starts here.
  (while (not blk)
    (setq blk (car (ent_sel "\nSelect Source Object:  ")))
    (cond ((not (setq eblk (entget blk))))
	  ((not (eq (dxf 0 eblk) "INSERT"))
	   (setq blk nil)
	   (princ "\nPlease select a block with attributes. ")
	  )
	  ((not (eq (dxf 66 eblk) 1))
	   (setq blk nil)
	   (princ "\nPlease select a block with attributes. ")
	  )
	  (T blk)
    )
  )
  (setq	atts (get_atts blk)
	tags (mapcar 'vla-get-tagstring atts)
	keys (mapcar 'vla-get-handle atts)
	vals (mapcar 'vla-get-textstring atts)
  )
  (setvar "ErrNo" 0)
  (and ; Creates a temporary dialog box with toggles for each
 ; of the tagstrings in tags.  This is a variable dialog
 ; box that changes size based on the number of attributes.
    (setq dcl_name (createdialog tags keys)) ; Loads the dialog box
    (> (setq dcl_id (load_dialog dcl_name)) 0)
    (new_dialog "temp" dcl_id)
 ; If any toggle other than 'Select All' is pressed then
 ; this will turn off the 'Select All' toggle.
    (mapcar '(lambda (x) (action_tile x "(set_tile \"All\" \"0\")"))
	    keys
    )
    (action_tile "All" "(on_all_pick keys)")
    (action_tile "cancel" "(done_dialog 0)")
    (action_tile
      "accept"
      "(setq lst (mapcar '(lambda (x)(get_tile x)) keys))(done_dialog 1)"
      ;;  CAB removed morder code
      ;; "(setq morder (= (get_tile \"morder\") \"1\")lst (mapcar '(lambda (x)(get_tile x)) keys))(done_dialog 1)"
    )
    ;;  (set_tile "morder" "1")
    (setq strt (start_dialog))
    (not (unload_dialog dcl_id))
    (vl-file-delete dcl_name)
    (setq morder t) ; overridefor now, keep for future use
    (if	(eq strt 1)
      (and ; creates a list of attribute objects from the
 ; reference object that were selected in the dialog box.
	;;  CAB start =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
	;;  replace the attriburtes in one insert
	;;  if morder is true the tag and the order in the list must match
	;;  else the first matching tag will get the new value
	(defun replaceatts (ent atlst tags vals / blkobj cnt idx)
	  (setq	blkobj (vlax-ename->vla-object ent)
		cnt    0
	  )
	  (foreach atto	(vlax-invoke blkobj 'getattributes)
	    (cond
	      ((and morder ; order must match
		    (= 1 (cdr (nth cnt atlst))) ; flag, ok to replace
		    (eq (vla-get-tagstring atto) (nth cnt tags))
	       )
	       (vla-put-textstring atto (nth cnt vals))
	      )
	      ((and
		 (not morder) ; ignore order
		 (= 1 (cdr (nth cnt atlst))) ; flag, ok to replace
		 (setq idx (vl-position (vla-get-tagstring atto) tags))
	       )
	       (vla-put-textstring atto (nth idx vals))
	      )
	    )
	    (setq cnt (1+ cnt))
	  )
	  (vla-update blkobj)
	)
	;; CAB - a list of pairs (tagname flag)  where flag 1 0 t/nil
	(setq atts (create_list lst atts))
	(not
	  (prompt
	    "\nSelect blocks to update or enter ALL for all matching blocks."
	  )
	)
	(if
	  (and
	    (setq ssa (ssget (list '(0 . "INSERT") '(66 . 1))))
	    (setq rname (vlax-ename->vla-object blk))
	    (if	(vlax-property-available-p rname 'effectivename)
	      (progn (setq rname (vla-get-effectivename rname))
		     (mapcar '(lambda (x)
				(if (/=	rname
					(vla-get-effectivename
					  (vlax-ename->vla-object x)
					)
				    )
				  (ssdel x ssa)
				)
			      )
			     (ssnames ssa)
		     )
	      )
	      (progn
		(setq rname (vla-get-name rname))
		(mapcar
		  '(lambda (x)
		     (if (/= rname
			     (vla-get-name (vlax-ename->vla-object x))
			 )
		       (ssdel x ssa)
		     )
		   )
		  (ssnames ssa)
		)
	      )
	    )
	  )
	   (progn ;  itterate through the selected inserts
	     (setq i -1)
	     (while (setq ename (ssname ssa (setq i (1+ i))))
	       (if (not (eq ename blk)) ; ignore doner block
		 (replaceatts ename atts tags vals)
	       )
	     )
	     (if (= 0 (sslength ssa)) ;(not ssa);(null ssa)
	       (princ "\nInvalid blocks selected.  Please start over. ")
	     )
	   )
	)
	;;  CAB end =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
      ) ; This is returned if the user hits Cancel.
      (princ "\nFunction Terminated by User!")
    )
  )
  (princ)
)

[Anonymous]

As you can see this is not simple to do, you should start with just getting attributes and learn from there, however I had some time to put some simpler stuff together for you and thought I should help, hopefully you know a little about loading and changing lisp programs to fit your needs.

This is the simplest I could think of to give you a very good start, they work well and should work on just about any version without errors, I also added two commands at bottom  that allow for user input using the two main functions.

;; These two do all the work, make sure they are loaded.
;; this is all you should need to get and apply attributes to block
;; entitites , but you will need to build more around them to fit your needs.
--------------------------------------------------------

; This returns a list of tags and thier values that are in the desired block
(defun gettaglist ( ent / eg taglist )
(while (and
       (setq ent (entnext ent) eg (entget ent))
       (not (= "SEQEND" (CDR (ASSOC 0 EG))))
	   )
 (if (= "ATTRIB" (cdr (assoc 0 eg)))(setq taglist (cons (cons (cdr (assoc 2 eg)) (cdr (assoc 1 eg))) taglist)))
)
taglist
);d


; this will apply a list of tag values to a desired block.
(defun applytaglist (taglist ent / eg origent)
(while (and
       (setq ent (entnext ent) eg (entget ent))
       (not (= "SEQEND" (CDR (ASSOC 0 EG))))
	   )
 (if (and
     (= "ATTRIB" (cdr (assoc 0 eg)))
	 (assoc (cdr (assoc 2 eg)) taglist)
	 )
(entmod (subst (cons 1 (cdr (assoc (cdr (assoc 2 eg)) taglist))) (assoc 1 eg) eg))
)
)
(princ));d



















;;--------------------------------------------------------------
;; Here are defined commands that use the functions above and allow for user ;; input, name them what you like
;;--------------------------------------------------------------
(defun c:CopyAttributetoblocks ( / taglist kwordstring answer)
(setq kwordstring "")
(initget 1 (foreach n (setq taglist (gettaglist (car (entsel "\nSelect block of source Attribute" ))))
            (setq kwordstring (strcat kwordstring " " (car n)))
			)
)
(setq kwordstring "[")
(if (setq answer (getkword (strcat (foreach n taglist (setq kwordstring (strcat kwordstring (car n) "   \"" (cdr n) "\"" "/"))) "]:")))
 (progn
 (setq taglist (vl-remove-if-not '(lambda (x) (= answer (car x))) taglist))
 (princ "\nSelect blocks to copy attribute to:")(princ)
 (foreach ent (mapcar 'cadr (ssnamex (ssget)))
 (applytaglist taglist ent)
 )
 )
)
(princ))


(defun c:CopyAllAttributestoblocks ( / taglist )
(princ "\nSelect blocks to apply attributes to")(princ)
(setq taglist (gettaglist (car (entsel "\nSelect Source Entity for attributes"))))
(foreach ent (mapcar 'cadr (ssnamex (ssget)))
(applytaglist taglist ent)
)
(princ))

[scot-65]

Today is your lucky day!

With the help of this forum I was able to rewrite a snippet of code to do exactly as you want

as I, too, had the same situation.

UPA.fas - Update Attribute (11-6-2008). Sorry, no help facilities.

First update the attribute to the desired value.

Next, run this program and select that same attribute.

All copies of the block that contain the attribute will be matched.

We had a block that contained a seal with an attributed date along the bottom.

We needed to update all the dates for all the copies of this block.

Woo Hoooooooo!!!!

[greg_battin]

Here is one that I use often. 

[pbejse · Accepted solution]

Similar

(defun RepAtt (Tag / SourceBlk ValueToCopy SelSet)
  (vl-load-com)
  (if (setq SourceBlk (car (entsel "\nSelect Source Block:")))
    (progn
      (mapcar
        '(lambda (p)
           (if (equal (vla-get-tagstring p) Tag)
             (setq ValueToCopy (vla-get-textstring p))
             )
           )
        (vlax-invoke
          (vlax-ename->vla-object SourceBlk)
          'GetAttributes
          )
        )
      (ssget ":L" '((0 . "INSERT") (66 . 1)))
      (vlax-for
         DesBlock (setq
                    SelSet
                     (vla-get-activeselectionset
                       (vla-get-activedocument (vlax-get-acad-object))
                       )
                    )
        (foreach
           att (vlax-invoke DesBlock 'GetAttributes)
          (if (equal (vla-get-tagstring att) Tag)
            (vla-put-textstring att ValueToCopy)
            )
          )
        )
      (vla-delete SelSet)
      )
    )
  )

 (RepAtt "WIDGET");<-- Tag Name

Note: No error handler

[Anonymous]

---

@scot-65 wrote:

Today is your lucky day!

With the help of this forum I was able to rewrite a snippet of code to do exactly as you want

as I, too, had the same situation.

UPA.fas - Update Attribute (11-6-2008). Sorry, no help facilities.

First update the attribute to the desired value.

Next, run this program and select that same attribute.

All copies of the block that contain the attribute will be matched.

We had a block that contained a seal with an attributed date along the bottom.

We needed to update all the dates for all the copies of this block.

Woo Hoooooooo!!!!

---

Why not attach a .lsp file instead of .fas : (

[tmhpoole]

The UPA.fas file is helpful if I had wanted to globally change all occurrences of a specific attribute in a drawing, but I only want to match selected blocks to have their attribute value update to another block's existing value... my bad for not making that situation more clear in my original post ....

But thanks so much, I'm sure that it will come in very handy some day! 🙂

[tmhpoole]

Thank you, pbejse!

This worked very well! I think I will add a basic error handler to validate the existence of attributes in the source and paste blocks as well as checking for the existence of the tag name defined as the one to match from the source block and to change in the selected block(s). Thanks for your guidance, a very elegant solution! 🙂

[contact]

I tried to use your lisp...it loaded successfully and the command was recognized...I selected source block, but the rest of those blocks remained the same (no updated attribute value). Any ideas? Sorry, I know it has been a while since posted. Thanks.

[tmhpoole]

Hi Nate!

Was this the LISP you were trying to use?

(defun RepAtt (Tag / SourceBlk ValueToCopy SelSet) (vl-load-com) (if (setq SourceBlk (car (entsel "\nSelect Source Block:"))) (progn (mapcar '(lambda (p) (if (equal (vla-get-tagstring p) Tag) (setq ValueToCopy (vla-get-textstring p)) ) ) (vlax-invoke (vlax-ename->vla-object SourceBlk) 'GetAttributes ) ) (ssget ":L" '((0 . "INSERT") (66 . 1))) (vlax-for DesBlock (setq SelSet (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)) ) ) (foreach att (vlax-invoke DesBlock 'GetAttributes) (if (equal (vla-get-tagstring att) Tag) (vla-put-textstring att ValueToCopy) ) ) ) (vla-delete SelSet) ) ) )
 (RepAtt "WIDGET");<-- Tag Name

If it was, notice at the very end, the line:

(RepAtt "WIDGET");<-- Tag Name

well, the attribute tag (for testing purposes) is named WIDGET. It will only match the atttribute value between blocks if the attribute tag is named WIDGET.

If your block's attribute tag name is something different (which it probably is) then you have to change the line in the LISP to be whatever your block's attribute name is (not WIDGET).

Good luck!

Holler if you need anything else!

🙂

[contact]

Silly me! Thanks much! To clarify...I have to create a new lisp for each block I want to have matched? Thanks again

[tmhpoole]

Well -- this LISP was created because I have a specific attribute tag name that exists in all my blocks --- so I wanted the user to be able to pick anywhere on the block and the LISP would know it was only supposed to work with one specific attribute tag (WIDGET in the example)

However, if you want a more versatile LISP to match attributes between blocks, and their attribute tag name is going to be different, there are other LISPS out there that require you to select the actual value of the attribute and then the LISP knows the attribute tag that was just selected is the one it is supposed to match among the blocks you select.

You can use THIS LISP (it's called MATCHATTS.LSP - you can find it by searching on Cadalyst's website -- under the Tips n Tricks section)

;;;---------------------------------------------------------------------;;; ;;; MatchAtts.lsp ;;; ;;; Created by Will DeLoach ;;; ;;; Copyright 2005 ;;; ;;; ;;; ;;;FUNCTION ;;; ;;;Creates a variable sized dialog box with attribute tagstrings from the;; ;;;the Source Attribute. The user selects the values they want to match;;; ;;;and then selects blocks withe same name as the source block and the ;;; ;;;selected attributes will be changed to match the source attribute. ;;; ;;; ;;; ;;;USAGE ;;; ;;;(load "matchatts) ;;; ;;;matchatts ;;; ;;; ;;; ;;;PLATFORMS ;;; ;;;Tested on 2006; but could work for earlier versions. ;;; ;;; ;;; ;;;VERSION ;;; ;;; 1.0 October 3, 2005 ;;; ;;; 1.01 October 4, 2005 Fixed Att Selection for Attributes only. ;;; ;;; 1.02 October 5, 2005 Fixed bug in cond statement ;;; ;;; 1.03 November 15, 2005 Replaced get_att SUBR (recmd by T. Willey);;; ;;; 1.1 April 6, 2006 Modifications made by CAB from theSwamp.org ;;; ;;; Fixed duplicate tagname bug. ;;; ;;; 1.11 Added the write_line function. ;;; ;;; 1.2 Fixed block selection to work with Dynamic Blocks. ;;; ;;; 1.21 Corrected an error with 'EffectiveName' assumption. ;;; ;;; ;;; ;;; ;;; ;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED ;;; ;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR ;;; ;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. ;;; ;;; ;;; ;;; You are hereby granted permission to use, copy and modify this ;;; ;;; software without charge, provided you do so exclusively for ;;; ;;; your own use or for use by others in your organization in the ;;; ;;; performance of their normal duties, and provided further that ;;; ;;; the above copyright notice appears in all copies and both that ;;; ;;; copyright notice and the limited warranty and restricted rights ;;; ;;; notice below appear in all supporting documentation. ;;; ;;; ;;; ;;;---------------------------------------------------------------------;;; (vl-load-com) (defun c:matchatts (/ blk ;The entity name for the Reference Attribute eblk ;Entity list of blk atts ;List of attributes for 'blk' tags ;List of 'tagstrings' for atts keys ;List of 'handle' for atts vals ;List of 'textstring' for atts dcl_id ;Id number for the dialog box dcl_name ;Name for the dialog box strt ;Id from the done_dialog call lst ;List of values for the toggles ssa ;List of attributes the user selects morder ;flag to chack att order, for future use ename ;entity name lst ;List of Keys rname ;Reference Block Name i ;Increment ) ;;;---------------------------------------------------------------------;;; ;;;A rewrite of the entsel function. ;;; ;;;---------------------------------------------------------------------;;; (defun ent_sel (msg / ent) (while (not ent) (cond ((setq ent (entsel msg))) ((= (getvar "ErrNo") 7) (princ "\nSelection missed. Please try again.") ) ((= (getvar "ErrNo") 52) (exit)) ) ) ent ) ;;;---------------------------------------------------------------------;;; ;;;This is a utility function to return Attribute References for the ;;; ;;;supplied object or entity name. ;;; ;;;---------------------------------------------------------------------;;; (defun get_atts (obj) (vlax-invoke (vlax-ename->vla-object obj) 'getattributes) ) ;;;---------------------------------------------------------------------;;; ;;;This creates a variable dialog box that changes size based on how ;;; ;;;many attributes are passed to it. The dialog box is temporary and is;;; ;;;created on the fly. It is stored in your Acad Temp path location. ;;; ;;;---------------------------------------------------------------------;;; (defun createdialog (lst keys / num tfn fn wid cnt str) (defun write_line (lst file) (foreach x lst (write-line x file))) (setq num (length tags)) (cond ((> num 24) (setq wid 4)) ((> num 12) (setq wid 3)) ((> num 6) (setq wid 2)) (T (setq wid 1)) ) (setq tfn (vl-filename-mktemp "match_attribute_value.dcl")) (setq fn (open tfn "w")) (write_line (list "temp : dialog { label = \"Match Attributes\";" ": boxed_column { label = \"Select Attributes Values to Match: \";" ": row {" ) fn ) (setq cnt 0) (repeat (1+ wid) (write-line ": column {" fn) (repeat (/ num wid) (if (setq str (nth cnt lst)) (progn (write-line (strcat ": toggle { label = " "\"" str "\"" "; key = " "\"" (nth cnt keys) "\"" ";}" ) fn ) (setq cnt (1+ cnt)) ) ) ) (write-line "}" fn) ) (write_line (list "}" "spacer_1;" " : toggle { key = \"All\"; label = \"Select All\";}" "}" "ok_cancel;" "}" ) fn ) (close fn) tfn ) ;;;---------------------------------------------------------------------;;; ;;;This is the action for 'Select All' Check Box. ;;; ;;;---------------------------------------------------------------------;;; (defun on_all_pick (lst / str) (if (eq (get_tile "All") "0") (setq str "0") (setq str "1") ) (mapcar '(lambda (x) (set_tile x str)) lst) ) ;;;---------------------------------------------------------------------;;; ;;;This takes two lists and compares the two. Every item in vals that ;;; ;;;equals "1" is replace with the corresponding item in objs. ;;; ;;;---------------------------------------------------------------------;;; ;;; CAB modified, create a list of pairs (tagname flag) where flag 1 0 t/nil (defun create_list (vals objs) (vl-remove nil (mapcar '(lambda (x y) (cons y (if (eq x "1") 1 0 ) ) ) vals objs ) ) ) ;;;---------------------------------------------------------------------;;; ;;;Receives a Selection Set and returns Entity Names ;;; ;;;---------------------------------------------------------------------;;; (defun ssnames (selection_set / num lst) (repeat (setq num (sslength selection_set)) (setq num (1- num) lst (cons (ssname selection_set num) lst) ) ) lst ) ;;;---------------------------------------------------------------------;;; ;;;Accepts a Group code and an Entity List and returns the value. ;;; ;;;---------------------------------------------------------------------;;; (defun dxf (gcode elist) (cdr (assoc gcode elist))) ;;;---------------------------------------------------------------------;;; ;;;---------------------------------------------------------------------;;; ;;;---------------------------------------------------------------------;;; ;;;Main program starts here. (while (not blk) (setq blk (car (ent_sel "\nSelect Source Object: "))) (cond ((not (setq eblk (entget blk)))) ((not (eq (dxf 0 eblk) "INSERT")) (setq blk nil) (princ "\nPlease select a block with attributes. ") ) ((not (eq (dxf 66 eblk) 1)) (setq blk nil) (princ "\nPlease select a block with attributes. ") ) (T blk) ) ) (setq atts (get_atts blk) tags (mapcar 'vla-get-tagstring atts) keys (mapcar 'vla-get-handle atts) vals (mapcar 'vla-get-textstring atts) ) (setvar "ErrNo" 0) (and ; Creates a temporary dialog box with toggles for each ; of the tagstrings in tags. This is a variable dialog ; box that changes size based on the number of attributes. (setq dcl_name (createdialog tags keys)) ; Loads the dialog box (> (setq dcl_id (load_dialog dcl_name)) 0) (new_dialog "temp" dcl_id) ; If any toggle other than 'Select All' is pressed then ; this will turn off the 'Select All' toggle. (mapcar '(lambda (x) (action_tile x "(set_tile \"All\" \"0\")")) keys ) (action_tile "All" "(on_all_pick keys)") (action_tile "cancel" "(done_dialog 0)") (action_tile "accept" "(setq lst (mapcar '(lambda (x)(get_tile x)) keys))(done_dialog 1)" ;; CAB removed morder code ;; "(setq morder (= (get_tile \"morder\") \"1\")lst (mapcar '(lambda (x)(get_tile x)) keys))(done_dialog 1)" ) ;; (set_tile "morder" "1") (setq strt (start_dialog)) (not (unload_dialog dcl_id)) (vl-file-delete dcl_name) (setq morder t) ; overridefor now, keep for future use (if (eq strt 1) (and ; creates a list of attribute objects from the ; reference object that were selected in the dialog box. ;; CAB start =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;; replace the attriburtes in one insert ;; if morder is true the tag and the order in the list must match ;; else the first matching tag will get the new value (defun replaceatts (ent atlst tags vals / blkobj cnt idx) (setq blkobj (vlax-ename->vla-object ent) cnt 0 ) (foreach atto (vlax-invoke blkobj 'getattributes) (cond ((and morder ; order must match (= 1 (cdr (nth cnt atlst))) ; flag, ok to replace (eq (vla-get-tagstring atto) (nth cnt tags)) ) (vla-put-textstring atto (nth cnt vals)) ) ((and (not morder) ; ignore order (= 1 (cdr (nth cnt atlst))) ; flag, ok to replace (setq idx (vl-position (vla-get-tagstring atto) tags)) ) (vla-put-textstring atto (nth idx vals)) ) ) (setq cnt (1+ cnt)) ) (vla-update blkobj) ) ;; CAB - a list of pairs (tagname flag) where flag 1 0 t/nil (setq atts (create_list lst atts)) (not (prompt "\nSelect blocks to update or enter ALL for all matching blocks." ) ) (if (and (setq ssa (ssget (list '(0 . "INSERT") '(66 . 1)))) (setq rname (vlax-ename->vla-object blk)) (if (vlax-property-available-p rname 'effectivename) (progn (setq rname (vla-get-effectivename rname)) (mapcar '(lambda (x) (if (/= rname (vla-get-effectivename (vlax-ename->vla-object x) ) ) (ssdel x ssa) ) ) (ssnames ssa) ) ) (progn (setq rname (vla-get-name rname)) (mapcar '(lambda (x) (if (/= rname (vla-get-name (vlax-ename->vla-object x)) ) (ssdel x ssa) ) ) (ssnames ssa) ) ) ) ) (progn ; itterate through the selected inserts (setq i -1) (while (setq ename (ssname ssa (setq i (1+ i)))) (if (not (eq ename blk)) ; ignore doner block (replaceatts ename atts tags vals) ) ) (if (= 0 (sslength ssa)) ;(not ssa);(null ssa) (princ "\nInvalid blocks selected. Please start over. ") ) ) ) ;; CAB end =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ) ; This is returned if the user hits Cancel. (princ "\nFunction Terminated by User!") ) ) (princ) )

[contact]

I am still having trouble getting this to work. I wrote the lisp exactly as below and titled it RefAtt_aac.lsp  (aac is my block with attributes)

(defun RepAtt (Tag / SourceBlk ValueToCopy SelSet) (vl-load-com) (if (setq SourceBlk (car (entsel "\nSelect Source Block:"))) (progn (mapcar '(lambda (p) (if (equal (vla-get-tagstring p) Tag) (setq ValueToCopy (vla-get-textstring p)) ) ) (vlax-invoke (vlax-ename->vla-object SourceBlk) 'GetAttributes ) ) (ssget ":L" '((0 . "INSERT") (66 . 1))) (vlax-for DesBlock (setq SelSet (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)) ) ) (foreach att (vlax-invoke DesBlock 'GetAttributes) (if (equal (vla-get-tagstring att) Tag) (vla-put-textstring att ValueToCopy) ) ) ) (vla-delete SelSet) ) ) )
 (RepAtt "aac");<-- Tag Name

Then I load RepAtt_aac.lsp

Then enter (RepAtt"aac")

It asks for a source block (for some reason the first click does not work, the second click finishes the command , yet the command line reads :

Select objects: 1 found

Select objects: nil

No attributes are matched

Any ideas? I am very new to lisp commands if you haven't noticed. I very much appreciate your help!

[tmhpoole]

Hi Nate-

From what I gathered in your last post, you are passing the block's name to your REPATT_AAC.LSP ... but the thing in quotes after RepATT should be the TAG name that you want to be matched across blocks, not the BLOCK name...

In your routine, if you are passing

(Repatt "aac") to AutoCAD, then you are telling AutoCAD to look for the Attribute Tag named "AAC"  - not the block named AAC... it doesn't care what the blocks' names are ...that's why you select the blocks you want to change in order to provide a selection set to the LISP routine...

There can be a variety of block names that you want to match attribute tags to, but the actual TAG name of the attribute is what the REPATT Lisp needs to know in order to match every occurence of that tag name in the blocks you select.

If you have an example of the AAC block, that would be useful for me to look at to guide you what needs to go in the quotes when you call REPATT...

But the good news is that we're almost there to solving your problem! 🙂

  - Theresa

[contact]

OK. Perhaps this is not the lisp I am searching for...

I have a bunch of blocks that represent plants. Each block will have a couple invisible attributes, such as size of plant, water requirements and some other designations. I am attempting to create a system where I can use EATTEXt to create a table from a block count of all my plant blocks. Their attributes will end up in the table. But if it turns out that I want the size to change or any of the other attribute values to change for a plant, I want it to be reflected in all of the blocks with the same name.

Perhaps I don't need a lisp for this. Any thoughts?

[tmhpoole]

Hi Nate--

I see.... yeah, the RepATT LISP routine really isn't appropriate....

I have attached an updated MatchAtts.lsp routine ...this is just an interim solution ... but I think I can hunt down something a little more automated...

If you first create a selection set of the blocks that you want to update with QSELECT ( filter by Block Name) - then invoke the MATCHATTS command (load the attached .LSP  into your session first) - after typing MATCHATTS, you are prompted to pick the source block that you want to match all the other blocks in the selection set to.

I tested it out and it works nicely... but I'll still keep looking...

 - T

[contact]

I LOVE IT. Cheers!

[tmhpoole]

Glad it worked for you, Nate!

  oh, BTW, I noticed that you DO NOT HAVE TO FIRST FILTER THE BLOCKS YOU WANT TO CHANGE USING QSELECT!! 🙂

The MATCHATTS lisp routine asks you to type "ALL" at the command prompt if you want to update all the blocks with that matching name of the one you selected to copy the attributes from....  I don't know how I missed that in the first pass?!

 - T