Increment Specific Attribute Tag value by selecting anywhere on block...

[MuddyRunnerGirl]

Hello--

 

I have a situation where I want to select a series of blocks (anywhere on the block) and then have a specific attribute tag named ADDRESS increment in number value based on a starting number provided by the user at the command line and a default prefix string of "ADDRESS: " is added before the new incremented number. It would also be great if it offered the default starting number as the next one where you left off from the last time you invoked the function.

 

Here is a sample that does what I want to do, EXCEPT that you have to zoom in and make sure you actually select the attribute tag within the block... you can't just select anywhere on the block.... so if anyone wants to try this out, you can use it with ANY attributed block.... but my attribute tag is called ADDRESS.

 

Any direction on how I can modify or restructure this code would be greatly appreciated -- thanks! :-)

 

 

 

 
(defun c:QS-ADD (/ oldPref oldSuf oldStart curText curStr vlaObj keepText)
 (setq *renum-debug t)
 (vl-load-com)
 (defun TTC_Paste (pasteStr keepText / nslLst vlaObj)
   (and *renum-debug (princ "\n")(princ pasteStr))
   (setvar "ErrNo" 0)        ; reset variable
   (while
     (cond
       ((and (null (setq nslLst (nentsel "\nSelect Address Tag to renumber >>")))
             (= 52 (getvar "ErrNo")))
        (Prompt "\nUser Quit")
       )

       ((and *renum-debug (prompt (strcat "\nnslLst = " (vl-princ-to-string nslLst)))))

       ((or (null nslLst) (= 1 (length nslLst))) (princ "\nMissed, Try Again."))

       ((and (= 4 (length nslLst))
             (= "DIMENSION" (cdr (assoc 0 (entget (car (last nslLst))))))
        )                    ; end and
        (setq vlaObj
               (vlax-ename->vla-object (cdr (assoc -1 (entget (car (last nslLst))))))
        )
        (setq oldStat (vla-get-Measurement vlaObj))
        (if keepText
          (if (= (vla-get-TextOverride vlaObj) "")
            (setq pasteStr (strcat pasteStr
                                   (rtos oldStat
                                         (vla-get-UnitsFormat vlaObj)
                                         (vla-get-PrimaryUnitsPrecision vlaObj)
                                   )
                           )
            )
            (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))
          )
        )
        (if (vl-catch-all-error-p
              (vl-catch-all-apply 'vla-put-TextOverride (list vlaObj pasteStr))
            )
          (princ "\n Can't paste. Object may be on locked layer. ")
        )
       )                     ; end condition #1
       ((and (= 4 (length nslLst))
             (= "ACAD_TABLE" (cdr (assoc 0 (entget (car (last nslLst))))))
        )                    ; end and
        (setq vlaObj (vlax-ename->vla-object (car nslLst)))
        (if keepText
          (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj)))
        )
        (if (vl-catch-all-error-p
              (vl-catch-all-apply 'vla-put-TextString (list vlaObj pasteStr))
            )
          (princ "\nError. Can't paste text. ")
          (not (entupd (car (last nslLst)))) ; force exit
        )
       )                     ; end condition # 2
       ((and (= 4 (length nslLst))
             (= "INSERT" (cdr (assoc 0 (entget (car (last nslLst))))))
        )                    ; end and
        (princ "\nCan't paste to block's DText or MText. ")
       )                     ; end condition #3
       ((and (= 2 (length nslLst))
             (member (cdr (assoc 0 (entget (car nslLst))))
                     '("TEXT" "MTEXT" "ATTRIB" "ATTDEF")
             )
        )                    ; end and
        (and *renum-debug (princ (cdr (assoc 0 (entget (car nslLst))))))
        (setq vlaObj (vlax-ename->vla-object (car nslLst)))
        ;;  Debug 
        (and *renum-debug (vl-catch-all-apply 'vlax-dump-object (list vlaobj t)))
        ;;  Debug 
        (if keepText
          (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj)))
        )
        (if (vl-catch-all-error-p
              (vl-catch-all-apply 'vla-put-TextString (list vlaObj pasteStr))
            )
          (princ "\nError. Can't paste text. ")
        )
       )                     ; end condition #4
       (T (princ "\nCan't paste. Invalid object. ")) ; end condition #5
     )                       ; end cond
   )                         ; end while
   nslLst
 ) ;_TTC_PASTE

 (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (vla-StartUndoMark aDoc)
 (or rnm:Pref (setq rnm:Pref "ADDRESS: "))
 (or rnm:Suf (setq rnm:Suf ""))
 (or rnm:Start (setq rnm:Start 1))
 (setq oldPref  rnm:Pref
       oldSuf   rnm:Suf
       oldStart rnm:Start
 )                           ; end setq
 (setq rnm:Pref "ADDRESS: ")
;(getstring T (strcat "\nType prefix: <" rnm:Pref ">: "))

 (and (= "" rnm:Pref) (setq rnm:Pref oldPref))
 (and (= " " rnm:Pref) (setq rnm:Pref ""))
 (setq rnm:Suf "")
 ;(getstring T (strcat "\nType suffix: <" rnm:Suf ">: "))

 (and (= "" rnm:Suf) (setq rnm:Suf oldSuf))
 (setq rnm:Start (getint (strcat "\nEnter Address start number <" (itoa rnm:Start) ">: ")))
 (or rnm:Start (setq rnm:Start oldStart))
 ; (initget "Yes No")
 (setq keepText "No")
;(/= "No" (getkword "\nKeep contents of the text [Yes/No] <Yes>:")))
 (setq rnm:Start (1- rnm:Start))
 (while
   (TTC_Paste (setq curStr (strcat rnm:Pref (itoa (setq rnm:Start (1+ rnm:Start))) rnm:Suf))
              ;keepText
pasteStr
   )
 )
 (vla-EndUndoMark aDoc)
 (princ)
)                             ; end of QS-ADD

[David Bethel]

Welcome to the forum.

 

I'd try a bit more of a concentrated approach as you have fairly specific criteria:

 

[b][color=BLACK]([/color][/b]defun c:incaddno [b][color=FUCHSIA]([/color][/b]/ tagname addno ss en an ad ch[b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]setq tagname [color=#2f4f4f]"ADDRESS"[/color][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]or def_addno [b][color=NAVY]([/color][/b]setq def_addno 1[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]initget 6[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq addno [b][color=NAVY]([/color][/b]getint [b][color=MAROON]([/color][/b]strcat [color=#2f4f4f]"\nStarting Address Number <"[/color]
                                [b][color=GREEN]([/color][/b]itoa def_addno[b][color=GREEN])[/color][/b]
                             [color=#2f4f4f]">:   "[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]or addno [b][color=NAVY]([/color][/b]setq addno def_addno[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"INSERT"[/color][b][color=BLUE])[/color][/b][b][color=BLUE]([/color][/b]66 . 1[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss 0[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq an [b][color=GREEN]([/color][/b]entnext en[b][color=GREEN])[/color][/b]
                   ad [b][color=GREEN]([/color][/b]entget an[b][color=GREEN])[/color][/b]
                   ch nil[b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]while [b][color=GREEN]([/color][/b]and [b][color=BLUE]([/color][/b]= [color=#2f4f4f]"ATTRIB"[/color] [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 0 ad[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                         [b][color=BLUE]([/color][/b]not ch[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                    [b][color=GREEN]([/color][/b]and [b][color=BLUE]([/color][/b]= [b][color=RED]([/color][/b]strcase tagname[b][color=RED])[/color][/b]
                            [b][color=RED]([/color][/b]strcase [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc 2 ad[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                         [b][color=BLUE]([/color][/b]setq ch T[b][color=BLUE])[/color][/b]
                         [b][color=BLUE]([/color][/b]entmod [b][color=RED]([/color][/b]subst [b][color=PURPLE]([/color][/b]cons 1 [b][color=TEAL]([/color][/b]strcat [color=#2f4f4f]"ADDRESS: "[/color] [b][color=OLIVE]([/color][/b]itoa addno[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b]
                                        [b][color=PURPLE]([/color][/b]assoc 1 ad[b][color=PURPLE])[/color][/b] ad[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                         [b][color=BLUE]([/color][/b]setq addno [b][color=RED]([/color][/b]1+ addno[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                    [b][color=GREEN]([/color][/b]setq an [b][color=BLUE]([/color][/b]entnext an[b][color=BLUE])[/color][/b]
                          ad [b][color=BLUE]([/color][/b]entget an[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]if ch [b][color=GREEN]([/color][/b]entupd en[b][color=GREEN])[/color][/b]
                    [b][color=GREEN]([/color][/b]progn
                      [b][color=BLUE]([/color][/b]redraw en 3[b][color=BLUE])[/color][/b]
                      [b][color=BLUE]([/color][/b]alert [color=#2f4f4f]"ADDRESS Tag Not Found In This Insert"[/color][b][color=BLUE])[/color][/b]
                      [b][color=BLUE]([/color][/b]redraw en 1[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]ssdel en ss[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq def_addno addno[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

This should work, but it has some limits:

 

• Integer numbers only
  
• You should select the INSERTs incrementally ( It allows multiple selections )
  
• The entire tagname is 'ADDRESS'
  
• It only changes the first instance of the Tag
  
• It does leave a global variable names def_addno
  
• The starting default value will not be remebered from 1 session to the next
  

 

Have fun -David

[Lee Mac]

Another using Visual LISP, same functionality as David's:

 

(defun c:incatt ( / tag pre ss1 ) (vl-load-com)

 (setq tag "ADDRESS" pre "ADDRESS: ")

 (if (setq *num* (cond ( (getint (strcat "\nSpecify Starting Number"  (if *num* (strcat " <" (itoa *num*) "> : ") ": ")))) ( *num* )))
   (while (setq ss1 (ssget "_+.:E:S:L" '((0 . "INSERT") (66 . 1))))
     (if
       (vl-some
         (function
           (lambda ( x )
             (if (eq tag (vla-get-tagstring x))
               (not (vla-put-textstring x (strcat pre (itoa *num*))))
             )
           )
         )
         (vlax-invoke (vlax-ename->vla-object (ssname ss1 0)) 'getattributes)
       )
       (setq *num* (1+ *num*))
       (princ (strcat tag " Attribute not found."))
     )
   )
 )
 (princ)
)

[BIGAL]

It would not be hard to add a bit more code at the start that if the addno is nil then search all blocks and find the highest number but allow it to be overidden.

[David Bethel]

It would not be hard to add a bit more code at the start that if the addno is nil then search all blocks and find the highest number but allow it to be overidden.

 

HMMMM... I was thinking more in the way of street addresses in say a subdivision. Maybe multiple streets having the same numbering system. It will be interesting to see if that is the case. -David

[BIGAL]

Further, yes would need two attributes stno and street name so pick say an existing block and then it knows the street name and can find last number, the street name would not need to be a visible value.

 

No pick object would indicate a new street all together, to complicate it a bit more here we have odd and even numbers two sides to a road, long rural roads are numbered as a distance regardless of which side.