Auto numbering in block referentce

[Trai]

Hi all, 

Recently, I have done many Isometric Drawings with many balloon numbers in Block Reference. Is there any way to Auto Numbering of text for that? Its same Tcount command.

My idea is:

1. Using BURST command

2. Using Tcount. However it only allow user numbering via X, Y direction

I have attached a example draiwng for test.

So someone have way to resolve this issue.

Thanks for the help.

 

 

Test.dwg

[marko_ribar]

You need to add + 4 to each number ?

If so, that's very easy...

Retrieve attributes and just use :

(vla-put-textstring (vlax-ename->vla-object attrib-ename) (itoa (+ 4 (atoi (vla-get-textstring (vlax-ename->vla-object attrib-ename))))))

[Trai]

as you can see this snap shot:

number 1 (in left picture) will replace into 5 (right pictrure)

number 2 (in left picture) will replace into 6 (right pictrure)

number 3  (in left picture) will replace into 7 (right pictrure)

etc...

i will using BURST then use Tconnt command. but if i use Tcount conmand , The numbers  only  sort X, Y Direction 

[BIGAL]

Like marko_ribar fairly simple to solve.

 

(defun c:wow ( / ss x att entname)
(setq numinc (Getint "\nEnter increment or minus to be used "))
(setq entname (cdr (assoc 2 (entget (car (entsel "Pick 1 block for block name "))))))
(prompt "Select blocks")
(setq ss (ssget (list (cons 0 "INSERT")(cons 2 entname))))
(repeat (setq x (sslength ss))
(setq att (car (vlax-invoke (vlax-ename->vla-object (ssname ss (setq x (1- x)))) 'Getattributes)))
(vla-put-textstring att (rtos (+ numinc (atoi (vla-get-textstring att))) 2 0))
)
(princ)
)
(c:wow)

 

 

[Trai]

@BIGAL yes, I have just test your lisp, it work, however all balloon replace with same number, you can see snap shot below. I wan to the balloon have number in ascending or descending.

[marko_ribar]

(defun c:wow ( / ss x ref entname numinc )

  (vl-load-com)

  (setq numinc (getint "\nEnter increment or minus to be used : "))
  (setq entname (cdr (assoc 2 (entget (car (entsel "\nPick 1 block for block name..."))))))
  (prompt "\nSelect blocks...")
  (setq ss (ssget "_:L" (list (cons 0 "INSERT") (cons 2 entname))))
  (repeat (setq x (sslength ss))
    (setq ref (ssname ss (setq x (1- x))))
    (foreach att (vlax-invoke (vlax-ename->vla-object ref) 'Getattributes)
      (vla-put-textstring att (rtos (+ numinc (atoi (vla-get-textstring att))) 2 0))
    )
  )
  (princ)
)

(c:wow)

 

Edited October 3, 2022 by marko_ribar

[BIGAL]

Thanks marko it was working will go back and double check why not.

 

Ok found out why, if you run in Bricscad it works OK so that is why I posted.

 

When you look at the textstring its "\\W0.8000;8" "\\W0.8000;7" "\\W0.8000;6" etc so the atoi returns zero 0. 

 

Got this in Autocad using your code and mine.

 

Will think some more about stripping mtext control, change number then add control back in.

Edited October 3, 2022 by BIGAL

[Trai]

@BIGALyou  can fixed code , I have just tested code that @marko_ribarrepaired. However the balloon still same number

[marko_ribar]

Note that my revision is simple so called default approach to iterate each of possible more than singe attribute bind to block definition... BIGAL's code does the same, but only checks this according to your given example - single block : single attribute... For further revision, use VLIDE either in AutoCAD, or BricsCAD (VLIDE=BLADE)... Set breakpoint, just under (foreach att ... <brk> (vla-put-textstring ... )), then double click at "att" variable to check it's carried data... Data should contain among other things and 'textstring value... Find relation between that value - original data, possible new syntax that would fall replacing it and write formula in ALISP form with which should all iterated attributes from each of iterated blocks be adequate satisfying your requested goal... BIGAL answered what is perhaps situation - search for - stripmtext routine on www... I think there are already coded examples - look at www.theswamp.org under "show your stuff" - I think author is Tim Willey (but you'll have to be logged to access that forum folder...). If not acceptable for your personality - for which I am not responsible person - see if you can make agreement with Administrator (John K., or Mark T.) and further ask for acceptance that you can freely use or download author's application (Tim W.)... If you stuck somewhere in your mission, report there or here or somewhere the most appropriate IYO on www...

 

Here is one that you can freely access - not under "show your stuff" folder, as just an inspiration (food for thoughts) :

https://www.theswamp.org/index.php?topic=14764.msg178357#msg178357

Edited October 3, 2022 by marko_ribar

[Steven P]

Seen this a couple of times and often just after a solution has been posted so I didn't make this comment. Your attribute text is multiline text, containing a width factor of 0.8 ? Just wondering if the solutions above would work better if your blocks contained single line attribute texts? Busy last couple of weeks else I would try this out for you, but single line text also removes formatting like BigAl and Marko_Ribar suggested SMT would do

[Steven P]

Finally got some peace to look at this for you.... 

I guessed right earlier, if you change the attribute style to a plan Attribute (no formatting and so on) then it all works as it should from above.

 

Leave the drawing as it is is trickier, the text you want to alter contains the formatting code and the text value - a mix of letters and numbers which needs a slightly different approach I think.

 

A similar question was posted a couple of weeks ago ( https://www.cadtutor.net/forum/topic/75994-lisp-to-increment-letters-with-prefix-or-suffix/ ), and I added this to the discussion - copy and pasted from what I use all the time. Its versatility was probably a bit too much for that discussion but it does the job I think - slightly modified version below.- but it is quite long.

 

You'll need to modify what BigAl suggested above to make it work - a suggestion is at the end.

 

See if it works, should do numbers or letters (or dates.. but I very much doubt you'll need that!) and in BricsCAD and AutoCAD

 

Noting that this was for revising revisions, we don't use 'I' or 'O' - these numbers are skipped but in the code it should be obvious what to remove. Z goes back to A and not AA, but 9 goes to 10.

 

 

 

(defun uprev (base increments / ent entlist currentrevision revlength revisionprefix anumber ones tens hundreds thousands leadingzero dday mmonth yyear yyyear daysinmonth monthlength revcode revletter increaseby sel endloop)
  (setq currentrevision base)
  (setq revlength (strlen currentrevision)) ;;length of selected revision
  (setq revisionprefix "")
  (setq anumber 0)

;;date processing
  (setq dday "")
  (if (and (or (= revlength 8)(= revlength 10))(or (if = (wcmatch currentrevision "??/??/*") t)(if = (wcmatch currentrevision "??.??.*") t)))
    (progn
      (setq dday (atoi (substr currentrevision 1 2)))
      (setq mmonth (atoi (substr currentrevision 4 2))) ;; as integer
      (setq yyear (atoi (substr currentrevision (- revlength 1) 2))) ;; last 2 digits as integer.
      (setq ddaysinmonth (list 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 1))
      (setq daysinmonth (list 31 28 31 30 31 30 31 31 30 31 30 31))
      (setq monthsinyear (list 1 2 3 4 5 6 7 8 9 10 11 12 1))
      (setq yyyear (atoi (substr currentrevision 7 2)))

      (if (= revlength 10)(setq yyyear (itoa yyyear)))(if (= revlength 8)(setq yyyear "")) ;; works out for 'nnxx' in date

      (setq monthlength (nth (- mmonth 1) daysinmonth)) ;;days in the month
      (if (and (= mmonth 2)(= (float (/ yyear 0.4)) (* (fix (/ yyear 4)) 10) ) )(setq monthlength 29)) ;; corrects for leap year
      (setq ddaysinmonth (subst 1 (+ monthlength 1) ddaysinmonth) ) ;; days in the month

      (setq acount increments)
      (while (< 0 acount) ;;if increase rev
        (setq dday (nth dday ddaysinmonth)) ;;increase day by 1
        (if (= dday 1) (setq mmonth (nth mmonth monthsinyear)) ) ;;if day went to 1st, increase month
        (if (and (= dday 1)(= mmonth 1)) (setq yyear (+ yyear 1)) )
        (if (= 100 yyear)(if (/= "" yyyear)(setq yyyear (itoa (+ 1 (atoi yyyear))))))
        (if (= 100 yyear)(setq yyear 00))
        (setq acount (- acount 1))
      ) ;end while

      (setq acount increments)
      (while (> 0 acount) ;;if decrease rev
        (setq dday (- dday 1)) ;;decrease day by 1
        (if (= 0 dday)
          (progn
            (setq mmonth (- mmonth 1))
            (if (= mmonth 0)
              (progn
                (if (= yyear 0)
                  (progn
                    (setq yyear 100)
                    (if (/= "" yyyear) (setq yyyear (itoa (- (atoi yyyear) 1))))
                  )
                )
                (setq yyear (- yyear 1))
                (setq mmonth 12)
              )
            )
            (setq dday (nth (- mmonth 1) daysinmonth))
          )
        )
        (setq acount (+ acount 1))
      ) ;end while

      (if (> 10 yyear)
        (progn
          (if (/= "" yyyear) (setq yyyear (itoa (* 10 (atoi yyyear))) ))
          (if (= "" yyyear) (setq yyyear "0"))
        )
      )

      (setq breaker "/")
      (if (= (vl-string-search "." currentrevision) 2) (setq breaker "." ) )
      (setq revletter (strcat (cond ((< dday 10) "0")(t "")) (itoa dday) breaker (cond ((< mmonth 10) "0")(t "")) (itoa mmonth) breaker yyyear (itoa yyear)       ))
    )
  )
;;;end of date processing

;;number processing
(if (= dday "")(progn
  (if (< 0 revlength)(progn
      (setq ones (substr currentrevision revlength))
      (if (numberp (read ones))(setq anumber 1))
  ))
  (if (< 1 revlength)(progn
      (setq tens (substr (substr currentrevision (- revlength 1) 2 ) 1 1))
      (if (and (= 1 anumber) (numberp (read tens))) (setq anumber 2))
  ))
  (if (< 2 revlength)(progn
      (setq hundreds (substr (substr currentrevision (- revlength 2) 2 ) 1 1))
      (if (and (= 2 anumber) (numberp (read hundreds))) (setq anumber 3))
  ))
  (if (< 3 revlength)(progn
      (setq thousands (substr (substr currentrevision (- revlength 3) 3 ) 1 1))
      (if (and (= 3 anumber) (numberp (read thousands))) (setq anumber 4))
  ))

;;work out numerical revision.
  (if (> anumber 0)
    (progn
      (setq revnumber (substr currentrevision (- revlength (- anumber 1)) anumber))
      (setq revnumber (itoa (+ increments (read revnumber)))) ;;increase rev number by 1
      (if (and (> revlength anumber)(/= revlength anumber))
        (setq revisionprefix (substr currentrevision 1 (- revlength anumber))) ;;first characters of revision
      )

      ;;fix leading zeros
      (setq leadingzeros (- anumber (strlen revnumber)))
      (if (= 3 leadingzeros)(setq leadingzero "000"))
      (if (= 2 leadingzeros)(setq leadingzero "00"))
      (if (= 1 leadingzeros)(setq leadingzero "0"))
      (if (> 1 leadingzeros)(setq leadingzero ""))

      (setq revletter (strcat revisionprefix leadingzero revnumber))
    )
  )

;;Work out letters revisions
  (if (= anumber 0)
    (progn
      (setq revcode (+ increments (ascii ones))) ;;increase rev letter by 1

      ;;set exceptions here
      (if (= 73 revcode)(setq revcode 74)) ;;I
      (if (= 79 revcode)(setq revcode 80)) ;;O
      (if (= 105 revcode)(setq revcode 106)) ;;i
      (if (= 111 revcode)(setq revcode 112)) ;;o.. its of to work we go.
      (if (= 91 revcode)(setq revcode 65)) ;;Z -> A. Won't increment 'tens' value
      (if (= 123 revcode)(setq revcode 97)) ;;z -> a Won't increment 'tens' value
      (setq revisionprefix (substr currentrevision 1 (- revlength 1))) ;;first characters of revision
      (setq revletter (strcat revisionprefix (chr revcode)))
    )
  )
));; end of number processing

revletter

)

 

 

Sugestion to BigAls code:

 

(defun c:wow ( / ss x ref entname numinc )
  (vl-load-com)
  (setq numinc (getint "\nEnter increment or minus to be used : "))
  (setq entname (cdr (assoc 2 (entget (car (entsel "\nPick 1 block for block name..."))))))
  (prompt "\nSelect blocks...")
  (setq ss (ssget "_:L" (list (cons 0 "INSERT") (cons 2 entname))))
  (repeat (setq x (sslength ss))
    (setq ref (ssname ss (setq x (1- x))))
    (foreach att (vlax-invoke (vlax-ename->vla-object ref) 'Getattributes)
      (vla-put-textstring att (uprev (vla-get-textstring att) numinc))
    )
  )
  (princ)
)

 

[Steven P]

Oh, and for anyone later following this thread, my code above if there are several attributes in a block it will increment them all

[BIGAL]

Possible sequence text or mtext like example

 

As string is "\\W0.8000;8" 1st step does ";" exist if yes split the string into 2 ("\\W0.8000" "8") then can change the 8 put back together and put new string while try to find time.

 

Try this, yes 1 attribute only but there is enough answers above to change. I can see lots of problems if other mtext code is used.

 

; parse string by lee-mac
; 58 is semicolon
(defun csv->lst ( str / pos )
(if (setq pos (vl-string-position  58 str))
    (cons (substr str 1 pos) (csv->lst (substr str (+ pos 2))))
    (list str)
    )
)

(defun c:wow ( / ss x att entname numinc newstr lst)
  (setq numinc (Getint "\nEnter increment or minus to be used "))
  (setq entname (cdr (assoc 2 (entget (car (entsel "Pick 1 block for block name "))))))
  (prompt "Select blocks")
  (setq ss (ssget (list (cons 0 "INSERT")(cons 2 entname))))
  (repeat (setq x (sslength ss))
    (setq att (car (vlax-invoke (vlax-ename->vla-object (ssname ss (setq x (1- x)))) 'Getattributes)))
    (setq str (vla-get-textstring att))
    (if (= (wcmatch str "*;*") nil)
      (setq newstr (rtos (+ numinc (atoi str)) 2 0))
      (progn
        (setq lst (csv->lst str))
        (setq newnum (rtos (+ numinc (atoi (cadr lst))) 2 0))
        (setq newstr (strcat (car lst) newnum))
       )
    )
  (vla-put-textstring att newstr)
  )
(princ)
)
(c:wow)

 

Edited October 4, 2022 by BIGAL

[Trai]

yes, i tried this code above, and this resolve in autocad command " bad argument type: stringp nil". Maybe this hard code

 

[Steven P]

57 minutes ago, Trai said:

yes, i tried this code above, and this resolve in autocad command " bad argument type: stringp nil". Maybe this hard code

 

 

That's unusual for BigAl - did you try the code above that ?

[Steven P]

BigAl, Nice idea, I would have gone for Lee Macs string to list, just because I know of that one and not the CSV to list

 

I get the same as the OP, bad argument type. In the csv-.lst, does the '58' need to be 59, 58 is '':' in AutoCAD [EDITED THIS LINE]

 

Oh, forgot to add, you need to put the ';' back in the text string as well - see below [EDITED THIS LINE]

 

 

Using String to List: http://lee-mac.com/stringtolist.html - but the rest is yours:

 

(defun LM:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)


(defun c:wow ( / ss x att entname numinc newstr lst)
  (setq numinc (Getint "\nEnter increment or minus to be used "))
  (setq entname (cdr (assoc 2 (entget (car (entsel "Pick 1 block for block name "))))))
  (prompt "Select blocks")
  (setq ss (ssget (list (cons 0 "INSERT")(cons 2 entname))))
  (repeat (setq x (sslength ss))
    (setq att (car (vlax-invoke (vlax-ename->vla-object (ssname ss (setq x (1- x)))) 'Getattributes)))
    (setq str (vla-get-textstring att))
    (if (= (wcmatch str "*;*") nil)
      (setq newstr (rtos (+ numinc (atoi str)) 2 0))
      (progn
        (setq lst (LM:str->lst str ";"))  ;; Slight change here
        (setq newnum (rtos (+ numinc (atoi (cadr lst))) 2 0))
        (setq newstr (strcat (car lst) ";" newnum))  ;; ADD BACK IN THE SEMICOLON HERE
       )
    )
  (vla-put-textstring att newstr)
  )
(princ)
)

 

Edited October 4, 2022 by Steven P

[BIGAL]

I use (ascii (getstring)) and I must have pressed colon ":"  instead of semi colon ";" yes  should be 59 I should have tested in Acad also thanks for correction changed code above.

[Trai]

Code working for me, Thank again for all help