Matching Attributes

[stusic]

Hello everyone!

I've got what I hope to be an easy problem. We use a lisp routine that can match attributes from one block to another (below). If you change the attributes of a block, it matches those attributes to other blocks through the entsel function. It works well, but I was hoping I could streamline it a bit.

Anytime we change a block, the other blocks we want to match all have the same tag (ITEM_NUM). So, if we change the part/model numbers, etc. of a block with the ITEM_NUM of "5", then the blocks we need to match will also have the same ITEM_NUM attribute of "5".

I trying to modify the code to simply look for all the other blocks with the same attribute in the ITEM_NUM tag and change the rest of the attributes to match, without having to individually select each block.

Any guidance/direction would be great!

Thanks!

Here's the code I'm working with:

; 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


(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:MatchAtts ( / 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))

[Lee Mac]

Here is an old program of mine:

http://lee-mac.com/matchattribs.html

You can change the properties that are copied at the top of the code - add 'textstring' to this list to match the attribute content.

[stusic]

That's very similar to what I have posted. Yet it doesn't fetch the other blocks for me, still prompts to select the blocks. I need to search the blocks, then select the blocks that have the same attribute tag (ITEM_NUM)...

[pbejse]

Generic Lisp code

(defun c:MatchAttV (/ aDoc TagSource curT curV atb)
  (vl-load-com)
  (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if (and (setq TagSource (car (nentselp "\nSelect Attribute: ")))
	   (eq (cdr (assoc 0 (setq ent (entget TagSource)))) "ATTRIB")
	   (setq curT (cdr (assoc 2 ent))
		 curV (cdr (assoc 1 ent))
		 )
	   (ssget "_X" '((0 . "INSERT") (66 . 1)))
	   )
    (progn
      (vlax-for	itm (setq ss (vla-get-ActiveSelectionSet aDoc))
	(if (setq
	      atb (assoc
		    curT
		    (mapcar (function (lambda (j)
					(list (vla-get-tagstring j)
					      (vla-get-textstring j)
					      j
					      )
					)
				      )
			    (vlax-invoke itm 'GetAttributes)
			    )
		    )
	      )
	  (vla-put-textstring (last atb) curV)
	  )
	)
      (vla-delete ss)
      )
    )(princ)
  )

command: MatchAttV
select attribute: <------ the attribute text to capture tag name and string

[stusic]

Nice. Thanks!