Add sequential number as suffix to a specific attribute?

[StankEnStein]

Hi -

I currently have a LISP routine that will replace the value of a specific attribute name with sequential numbers in the order that the blocks are selected. Like TCOUNT for attributes - and it only looks for a specific attribute Tag Name called "ID".

However, what I want it to do now, instead of just putting the number into the attribute value, I want the number to be a suffix to the existing default tag value of the tag named "ID" which is "ADDRESS:" for some blocks and "ELEVATION:" for other blocks.... but the tag name that the routine always has to filter for is "ID". That way the user can pick anywhere on the block - not being forced to pick the tag we want to add numbers to.

What I need the new LISP to do is append a space and then a number to the existing tag value in the block, so that the result would look like "ADDRESS: 1", "ADDRESS: 2", "ADDRESS 3" or "ELEVATION: 1", ELEVATION: 2", etc. depending on whatever the default value for the tag "ID" is.

If it helps - know that there are several hundred different block names - but they all have a Tag Name of "ID" - whose default value is sometimes "ADDRESS:" and sometimes "ELEVATION:".

Am I shooting for the moon?

Please advise -- thanks!

[EricStiles]

If you want people to write your code for you, you might get more help if you post the lisp code that you have now and let someone edit it.

[pbejse]

(strcat "current Value" " " (itoa (setq i (1+ i))))

What if the default/current value is ohter that "ELEVATION" or "ADDRESS" ? what then?

Also i assume you will be selecting the block ny order otherwise the program will assign it for you depending on the sequence the blocks are created

[pbejse]

Two versions:

First Code:

If and only if  the  string value for Tag "ID" remains as the default value (unedited)  i.e. "ADDRESS" or "ELEVATION"

(defun c:TagID (/ aDoc mlst ss TarTag curVal num)
  (setq	aDoc (vla-get-ActiveDocument (vlax-get-acad-object))
	mlst
	     (list '("ADDRESS" . 1) '("ELEVATION" . 1))
  )
  (if
    (ssget ":L" '((0 . "INSERT") (66 . 1)))
     (progn (vlax-for itm (setq ss (vla-get-ActiveSelectionSet aDoc))
	      (if (and (setq TargTag
			      (assoc "ID"
				     (mapcar (function (lambda (j)
							 (list (vla-get-tagstring j) j)
						       )
					     )
					     (vlax-invoke itm 'GetAttributes)
				     )
			      )
		       )
		       (setq mbr (assoc	(setq curVal
					       (strcase	(vla-get-textstring (cadr TargTag))
					       )
					)
					mlst
				 )
		       )
		  )
		(progn
		  (vla-put-textstring
		    (cadr TargTag)
		    (strcat curVal " " (itoa (setq num (cdr mbr))))
		  )
		  (setq	mlst (subst (cons (car mbr) (1+ num))
				    (assoc (car mbr) mlst)
				    mlst
			     )
		  )
		)
	      )
	    )
	    (vla-delete ss)
     )
  )
)

2nd Code:

Regardless of the string value of Tag "ID"

(defun c:TAgID2	(/ _BlkLst aDoc blk mlst)
  (setq	aDoc (vla-get-ActiveDocument (vlax-get-acad-object))
	blk  (vla-get-blocks aDoc)
	mlst
	     (list '("ADDRESS" . 1) '("ELEVATION" . 1))
  )
  (defun _BlkLst (/ a Atlst)
    (while (setq a (tblnext "BLOCK" (null a)))
      (if (= (cdr (assoc 70 a)) 2)
	(vlax-for itm (vla-item blk (cdr (assoc 2 a)))
	  (if
	    (and (eq (vla-get-ObjectName itm) "AcDbAttributeDefinition")
		 (eq (vla-get-TagString itm) "ID")
	    )
	     (setq Atlst
		    (cons (list (cdr (assoc 2 a)) (vla-get-textstring itm))
			  Atlst
		    )
	     )
	  )
	)
      )
    )
    Atlst
  )
  (if (and
	(setq BlkLst (_BlkLst))
	(ssget
	  ":L"
	  (list
	    '(0 . "INSERT")
	    (cons
	      2
	      (strcat
		"`*U*"
		(apply 'strcat
		       (mapcar '(lambda (l) (strcat "," (car l)))
			       BlkLst
		       )
		)
	      )
	    )
	  )
	)
      )
    (progn
      (setq BlkLst (apply 'append BlkLst))
      (vlax-for	itm (setq ss (vla-get-ActiveSelectionSet aDoc))
	(if (and (setq TargTag
			(assoc "ID"
			       (mapcar (function (lambda (j)
						   (list (vla-get-tagstring j) j)
						 )
				       )
				       (vlax-invoke itm 'GetAttributes)
			       )
			)
		 )
		 (setq mbr (member (vla-get-effectivename itm) BlkLst))
	    )

	  (progn
	    (vla-put-textstring
	      (cadr TargTag)
	      (strcat (cadr mbr)
		      " "
		      (itoa (setq num (cdr (assoc (cadr mbr) mlst))))
	      )
	    )
	    (setq mlst (subst (cons (cadr mbr) (1+ num))
			      (assoc (cadr mbr) mlst)
			      mlst
		       )
	    )
	  )
	)
      )
      (vla-delete ss)
    )
  )(princ)
)

Hope this helps

[3wood]

If the attribute with tag ID is always at the same position in different blocks, for example, it is the second attribute of all blocks, then you can try ALTEXT.vlx to get it done in two steps.

1. Select blocks in order and add a suffix " 1" to the second attribute of all blocks.

2. Use ALTEXT again, select "p", then add 1 to previous selection with "Relative" option on.

3wood

CAD KITS

[StankEnStein]

I do apologize - I had attempted to attach the original LSP as a file - but I see that never worked (my SmartPhone isn't that smart, after all).

Here is the source code I'm working with:

(defun c:UPNUMBER	(/ tagname addno ss en an ad ch)

  (setq tagname "ID")

  (or def_addno (setq def_addno 1))
  (initget 6)
  (setq	addno (getint (strcat "\nStarting Number <"
			      
			      (itoa def_addno)
			      ">:   "
		      )
	      )
  )
  (or addno (setq addno def_addno))

  (and (setq ss (ssget '((0 . "INSERT") (66 . 1))))
       (while (setq en (ssname ss 0))
	 (setq an (entnext en)
	       ad (entget an)
	       ch nil
	 )
	 (while	(and (= "ATTRIB" (cdr (assoc 0 ad)))
		     (not ch)
		)
	   (and	(= (strcase tagname)
		   (strcase (cdr (assoc 2 ad)))
		)
		(setq ch T)
		(entmod	(subst (cons 1 (itoa addno))
			       (assoc 1 ad)
			       ad
			)
		)
		(setq addno (1+ addno))
	   )
	   (setq an (entnext an)
		 ad (entget an)
	   )
	 )
	 (if ch
	   (entupd en)
	   (progn
	     (redraw en 3)
	     (alert "ID Tag Not Found In This Block")
	     (redraw en 1)
	   )
	 )
	 (ssdel en ss)
       )
  )
  (setq def_addno addno)
  (prin1)
)

[StankEnStein]

Hi!

Yes- it is likely that the blocks will be selected in a random order - not the order they were created in the drawing.

Also, it is very likely that they will need to be renumbered seval times throughout the life of the drawing, so they need to be able to be reassigned a new value after the default value has been changed.

Also, I set up my original LISP to prompt the user fora starting number every time the LISP is inboked, and if is invoked multiole times in the same drawing session, its default starting number is the next one up from the last number that the LISP assigned the last time it was used.

I have included a sample of each of the kinds of blocks that I would typically work with --- note that there are MANY actual block names -- but they will always have the ID tag.

[devitg]

Could you , please , upload the DWG with , at least, a few of such blocks? In 2008 or less , please.

[pbejse]

---

@StankEnStein wrote:

Hi!

Yes- it is likely that the blocks will be selected in a random order - not the order they were created in the drawing.

Also, it is very likely that they will need to be renumbered seval times throughout the life of the drawing, so they need to be able to be reassigned a new value after the default value has been changed.

Also, I set up my original LISP to prompt the user fora starting number every time the LISP is inboked, and if is invoked multiole times in the same drawing session, its default starting number is the next one up from the last number that the LISP assigned the last time it was used.

I have included a sample of each of the kinds of blocks that I would typically work with --- note that there are MANY actual block names -- but they will always have the ID tag.

---

(defun c:TAgID	(/ _BlkLst aDoc blk )
  (setq	aDoc (vla-get-ActiveDocument (vlax-get-acad-object))
	blk  (vla-get-blocks aDoc)
  )
  (if (not num)
            (setq num 0))
  (setq num (cond
                       ((getint
                              (strcat "\nNext Number <"
                                      (itoa (setq num ( 1+ num)))
                                      ">: ")))
                       (1+ num)))
  (setq  mlst
	     (list (cons "ADDRESS:" num) (cons "ELEVATION:" num)))
  (defun _BlkLst (/ a Atlst)
    (while (setq a (tblnext "BLOCK" (null a)))
      (if (= (cdr (assoc 70 a)) 2)
	(vlax-for itm (vla-item blk (cdr (assoc 2 a)))
	  (if
	    (and (eq (vla-get-ObjectName itm) "AcDbAttributeDefinition")
		 (eq (vla-get-TagString itm) "ID")
	    )
	     (setq Atlst
		    (cons (list (cdr (assoc 2 a)) (vla-get-textstring itm))
			  Atlst
		    )
	     )
	  )
	)
      )
    )
    Atlst
  )
  (if (and
	(setq BlkLst (_BlkLst))
	(ssget
	  ":L"
	  (list
	    '(0 . "INSERT")
	    (cons
	      2
	      (strcat
		"`*U*"
		(apply 'strcat
		       (mapcar '(lambda (l) (strcat "," (car l)))
			       BlkLst
		       )
		)
	      )
	    )
	  )
	)
      )
    (progn
      (setq BlkLst (apply 'append BlkLst))
      (vlax-for	itm (setq ss (vla-get-ActiveSelectionSet aDoc))
	(if (and (setq TargTag
			(assoc "ID"
			       (mapcar (function (lambda (j)
						   (list (vla-get-tagstring j) j)
						 )
				       )
				       (vlax-invoke itm 'GetAttributes)
			       )
			)
		 )
		 (setq mbr (member (vla-get-effectivename itm) BlkLst))
	    )
	  (progn
	    (vla-put-textstring
	      (cadr TargTag)
	      (strcat (cadr mbr)
		      " "
		      (itoa (setq num (cdr (assoc (cadr mbr) mlst))))
	      )
	    )
	    (setq mlst (subst (cons (cadr mbr) (1+ num))
			      (assoc (cadr mbr) mlst)
			      mlst
		       )
	    )
	  )
	)
      )
      (vla-delete ss)
    )
  )(princ)
)

You may wonder why the code is  unusually long
What it does is:

Search all blocks with attribute TAG "ID"
Check attributes DEFAULT value
Create  a list with 2 elements: ("BLOCK NAME" "DEFAULT VALUE")

Pass the valid blocknames as arguments for SSGET filter , I also include Anonymous Blocks "`*U*" in case you came across one of those.

Within the selected blocks, it will then sort between "ELEVATION" and "ADDRESS" based on the block name

Hope this helps

I also converted your samples for the benefit of others (version 2004)

HTH