Sequential numbering a single attribute value in multiple attribute block

[ASMI]

This routine can to number attributes one oby one http://www.asmitools.com/Files/Lisps/Renum.html.

 

There is MNUM version with selection of numbering direction:

 

(defun c:mnum(/ stStr stNum nLen cAtr dLst blName
      fLst blLst blSet aName sLst lZer aStr
      pt1 pt2 xSrt ySrt)
 (vl-load-com)
 (if
   (and
     (setq stStr(getstring "\nSpecify start number: "))
     (setq stNum(atoi stStr))
     (setq nLen(strlen stStr))
     ); end and
   (progn
     (if
(and
   (setq cAtr(nentsel "\nPick attribute > "))
   (= "ATTRIB"(cdr(assoc 0(setq dLst(entget(car cAtr))))))
  ); end and
(if
  (and
    (setq pt1(getpoint "\nSpecify numbering direction "))
    (setq pt2(getpoint pt1 "\nSpecify numbering direction "))
    ); end and
(progn
  (if(<=(car pt1)(car pt2))(setq xSrt '<)(setq xSrt '>))
  (if(<=(cadr pt1)(cadr pt2))(setq ySrt '<)(setq ySrt '>))
  (setq blName
    (vla-get-Name
       (vla-ObjectIDToObject
	  (vla-get-ActiveDocument
	     (vlax-get-acad-object))
	        (vla-get-OwnerID
	           (vlax-ename->vla-object(car cAtr)))))
	fLst(list '(0 . "INSERT")(cons 2 blName))
	aName(cdr(assoc 2 dLst))
	); end setq
  (princ "\n<<< Select blocks to number >>> ")
  (if
    (setq blSet(ssget fLst))
    (progn
     (setq sLst
                   (mapcar 'vlax-ename->vla-object
	      (mapcar 'car
	       (vl-sort
	        (vl-sort
	          (mapcar '(lambda(x)(list x
		   (trans(cdr(assoc 10(entget x)))0 1)))
	            (vl-remove-if 'listp 
                             (mapcar 'cadr(ssnamex blSet))))
	                '(lambda(a b)((eval xSrt)(caadr a)(caadr b))))
		          '(lambda(a b)((eval ySrt)(cadadr a)(cadadr b)))))))
     (foreach i sLst
       (setq lZer "")
       (repeat(- nLen(strlen(itoa stNum)))
	 (setq lZer(strcat lZer "0"))
	 ); end repeat
       (setq atLst
	      (vlax-safearray->list
		 (vlax-variant-value
		   (vla-GetAttributes i))))
       (foreach a atLst
	 (if
	   (= aName(vla-get-TagString a))
	      (vla-put-TextString a
		(strcat lZer(itoa stNum)))
	   ); end if
	 ); end foreach
	 (setq stNum(1+ stNum))
       ); end foreach
      ); end progn
    (princ "\nEmpty selection! Quit. ")
    ); end if
    ); end progn
   (princ "\nDirection not spaecified! Quit. ")
  ); end if
(princ "\nThis isn't attribute! Quit. ")
); end if
     ); end progn
   (princ "\nInvalid start number! Quit. ")
   ); end if
 (princ)
 ); end of c:mnum

[Trebuchet]

This script worked great for me. Thank you so much. Saved me lots of time clicking, typing, and hitting escape.

[dusko]

love it (didn't know for this lsp)!

thank you!

[TheyCallMeJohn]

ASMI,

Is there a way to make a modification to so that you can put a prefix into it. i.e (PL-1000, PL-1001, & PL-1002).

 

Second part is that occasionally I have to add blocks and I can't have the old blocks change there number but the new blocks denoted by "XXXX" need to be numbered sequentially from where the last block left off.

 

I would appreciate help with one or both of these. If not the lisp you already wrote will save me lots of time!

 

(Trying to learn lisp but its a slow process... tips and tutorials are always appreciated.)

 

J

 

PS: This block can select one portion of the block and not change the others right? (Haven't finished building the block for this yet!)

[The Buzzard]

ASMI,

Is there a way to make a modification to so that you can put a prefix into it. i.e (PL-1000, PL-1001, & PL-1002).

 

Second part is that occasionally I have to add blocks and I can't have the old blocks change there number but the new blocks denoted by "XXXX" need to be numbered sequentially from where the last block left off.

 

I would appreciate help with one or both of these. If not the lisp you already wrote will save me lots of time!

 

(Trying to learn lisp but its a slow process... tips and tutorials are always appreciated.)

 

J

 

PS: This block can select one portion of the block and not change the others right? (Haven't finished building the block for this yet!)

 

 

This is an old thread and ASMI is no longer is involved in CAD to my recent knowledge.

[The Buzzard]

TheyCallMeJohn,

 

Not to steer you away from this thread, But I made a program that does something similar to what you want to do. it is on this thread:http://www.cadtutor.net/forum/showthread.php?53207-Cable-Id-Number-Tag-Lisp Give it a look.

[TheyCallMeJohn]

Buzzard, Thanks for the advice and the recommendation but unfortunately that wont work for my application.

 

But i have questions that you hopefully you will be able to help with... When I use the lisp above with blocks I have inserted using the "insert" command it works fine but when try and run it on blocks that I have copy and pasted or inserted within another block than exploded (i.e. so it then back to original block) the lisp does not detect the objects. I get the following response "Select objects: 0 found"

I am attaching the lisp as I am using it.

 

Once again any help would be appreciated.

 

mnum.lsp

[The Buzzard]

TheyCallMeJohn,

 

I wish I could answer that for you, But I do not work with Visual Lisp. You should start a new thread with your topic or problem. You will get more answers that way.

 

Good Luck.

[Badwolf]

mnum is just what the doctor ordered! a request? I am using circles with 1 attribute value, they are being placed around a building perimeter and on a footing grid, sometimes turning angled directions it would be Awsome to choose them in a selection set or even one by one in order to be labeled then implement the command? maybe possible???

[jva]

This routine can to number attributes one oby one http://www.asmitools.com/Files/Lisps/Renum.html.

 

There is MNUM version with selection of numbering direction:

 

(defun c:mnum(/ stStr stNum nLen cAtr dLst blName
         fLst blLst blSet aName sLst lZer aStr
         pt1 pt2 xSrt ySrt)
 (vl-load-com)
 (if
   (and
     (setq stStr(getstring "\nSpecify start number: "))
     (setq stNum(atoi stStr))
     (setq nLen(strlen stStr))
     ); end and
   (progn
     (if
   (and
      (setq cAtr(nentsel "\nPick attribute > "))
      (= "ATTRIB"(cdr(assoc 0(setq dLst(entget(car cAtr))))))
     ); end and
   (if
     (and
       (setq pt1(getpoint "\nSpecify numbering direction "))
       (setq pt2(getpoint pt1 "\nSpecify numbering direction "))
       ); end and
   (progn
     (if(<=(car pt1)(car pt2))(setq xSrt '<)(setq xSrt '>))
     (if(<=(cadr pt1)(cadr pt2))(setq ySrt '<)(setq ySrt '>))
     (setq blName
       (vla-get-Name
          (vla-ObjectIDToObject
         (vla-get-ActiveDocument
            (vlax-get-acad-object))
               (vla-get-OwnerID
                  (vlax-ename->vla-object(car cAtr)))))
       fLst(list '(0 . "INSERT")(cons 2 blName))
       aName(cdr(assoc 2 dLst))
       ); end setq
     (princ "\n<<< Select blocks to number >>> ")
     (if
       (setq blSet(ssget fLst))
       (progn
        (setq sLst
                   (mapcar 'vlax-ename->vla-object
             (mapcar 'car
              (vl-sort
               (vl-sort
                 (mapcar '(lambda(x)(list x
              (trans(cdr(assoc 10(entget x)))0 1)))
                   (vl-remove-if 'listp 
                             (mapcar 'cadr(ssnamex blSet))))
                       '(lambda(a b)((eval xSrt)(caadr a)(caadr b))))
                     '(lambda(a b)((eval ySrt)(cadadr a)(cadadr b)))))))
        (foreach i sLst
          (setq lZer "")
          (repeat(- nLen(strlen(itoa stNum)))
        (setq lZer(strcat lZer "0"))
        ); end repeat
          (setq atLst
             (vlax-safearray->list
            (vlax-variant-value
              (vla-GetAttributes i))))
          (foreach a atLst
        (if
          (= aName(vla-get-TagString a))
             (vla-put-TextString a
           (strcat lZer(itoa stNum)))
          ); end if
        ); end foreach
        (setq stNum(1+ stNum))
          ); end foreach
         ); end progn
       (princ "\nEmpty selection! Quit. ")
       ); end if
       ); end progn
      (princ "\nDirection not spaecified! Quit. ")
     ); end if
   (princ "\nThis isn't attribute! Quit. ")
   ); end if
     ); end progn
   (princ "\nInvalid start number! Quit. ")
   ); end if
 (princ)
 ); end of c:mnum

 

Sorry for bringing up this ancient post, but I found out this extremely useful routine only now and I'm wondering if it could be modified to work with dynamic blocks also. Unfortunately I don't speak lisp (yet) so I don't have any clues where to start..

[fixo]

I think best way without good book is here:

www.afralisp.net

where I've started from many years ago, btw...

we need more detail about your task. The image or a copy

of the drawing with this block would be interesting to see.

Click on "Go Advanced" on lower right of reply box,

then click on "Manage Attachments",

browse to the file and select "Upload"

and also show what is before and after

 

~'J'~

[jva]

Thx for the reply and the link, I'll check it out.

 

The problem is I have an array of dynamic blocks with a multiple visibility state and when using the code from my previous post the selection of blocks doesn't work. AutoCAD just says "Select objects: 0 found" when I click on a dynamic block.

 

I've attached an example drawing. Code works with block EXAMPLE2, but not with EXAMPLE1.

Example.dwg

[fixo]

Try this code, I've changed just three line in there

(defun c:mnum(/ stStr stNum nLen cAtr dLst blName
         fLst blLst blSet aName sLst lZer aStr
         pt1 pt2 xSrt ySrt)
 (vl-load-com)
 (if
   (and
     (setq stStr(getstring "\nSpecify start number: "))
     (setq stNum(atoi stStr))
     (setq nLen(strlen stStr))
     ); end and
   (progn
     (if
   (and
      (setq cAtr(nentsel "\nPick attribute > "))
      (= "ATTRIB"(cdr(assoc 0(setq dLst(entget(car cAtr))))))
     ); end and
   (if
     (and
       (setq pt1(getpoint "\nSpecify numbering direction start"))
       (setq pt2(getpoint pt1 "\nSpecify numbering direction end"))
       ); end and
   (progn
     (if(<=(car pt1)(car pt2))(setq xSrt '<)(setq xSrt '>))
     (if(<=(cadr pt1)(cadr pt2))(setq ySrt '<)(setq ySrt '>))
     (setq blName
       (vla-get-effectiveName ;<-- changed
          (vla-ObjectIDToObject
         (vla-get-ActiveDocument
            (vlax-get-acad-object))
               (vla-get-OwnerID
                  (vlax-ename->vla-object(car cAtr)))))
      ; fLst(list '(0 . "INSERT")(cons 2 blName))
  fLst  (list(cons 0  "INSERT")(cons 2 (strcat "`*U*,"blName)));<-- changed
       aName(cdr(assoc 2 dLst))
       ); end setq
     (princ "\n<<< Select blocks to number >>> ")
     (if
       (setq blSet(ssget "F" (list pt1 pt2) fLst));<-- changed
       (progn
        (setq sLst
                   (mapcar 'vlax-ename->vla-object
             (mapcar 'car
              (vl-sort
               (vl-sort
                 (mapcar '(lambda(x)(list x
              (trans(cdr(assoc 10(entget x)))0 1)))
                   (vl-remove-if 'listp 
                             (mapcar 'cadr(ssnamex blSet))))
                       '(lambda(a b)((eval xSrt)(caadr a)(caadr b))))
                     '(lambda(a b)((eval ySrt)(cadadr a)(cadadr b)))))))
        (foreach i sLst
          (setq lZer "")
          (repeat(- nLen(strlen(itoa stNum)))
        (setq lZer(strcat lZer "0"))
        ); end repeat
          (setq atLst
             (vlax-safearray->list
            (vlax-variant-value
              (vla-GetAttributes i))))
          (foreach a atLst
        (if
          (= aName(vla-get-TagString a))
             (vla-put-TextString a
           (strcat lZer(itoa stNum)))
          ); end if
        ); end foreach
        (setq stNum(1+ stNum))
          ); end foreach
         ); end progn
       (princ "\nEmpty selection! Quit. ")
       ); end if
       ); end progn
      (princ "\nDirection not spaecified! Quit. ")
     ); end if
   (princ "\nThis isn't attribute! Quit. ")
   ); end if
     ); end progn
   (princ "\nInvalid start number! Quit. ")
   ); end if
 (princ)
 ); end of c:mnum

 

Thanks to ASMI, it's a good job

 

~'J'~

[jva]

Big thanks to you (and ASMI), it works!

[fixo]

You're welcome

Cheers

 

~'J'~

[jva]

I've one more question (read: modification job). Is it easy to change the code to support also text strings or letters? Like numbering A1.1, A1.2, A1.3 and so on.. Or A1, A2, A3 and so on.. Only the last number(s) would change.

[fixo]

Try this code

;;---------------------------------------- Code start ---------------------------------------;;
;; private function
(defun inc-digit  (st / alpha dig num prec)
 (setq alpha (vl-list->string
 (vl-remove-if-not
   '(lambda (a) (< 64 a 91))
   (vl-string->list st))))
 (setq num (vl-list->string
      (vl-remove-if
 '(lambda (a) (< 64 a 91))
 (vl-string->list st))))
 (if (vl-string-position (ascii ".") num)
   (progn
     (setq prec (- (strlen num) (1+ (vl-string-position (ascii ".") num))))
     (setq dig (vl-princ-to-string
   (+ (atof num) (* 1 (expt 10. (- prec))))))
     (if (< (strlen dig) (strlen num))
(setq dig (strcat dig "0")))
     (setq alpha (strcat alpha dig)))
   (progn
     (setq prec (strlen num))
     (setq dig (vl-princ-to-string (+ (atoi num) 1)))
     (setq alpha (strcat alpha dig))))
 alpha
 )
;;------------------------------ Main program ----------------------------;;
;; completely based on mnum.lsp by ASMI
(defun c:anum(/ stStr stNum nLen cAtr dLst blName
         fLst blLst blSet aName sLst lZer aStr
         pt1 pt2 xSrt ySrt)
 (vl-load-com)
 (if
   (and
     (setq stStr(getstring "\nSpecify initial alpha-numeric value: "))
     (setq stNum(atoi stStr))
     
     (setq nLen(strlen stStr))
     ); end and
   (progn
     (if
   (and
      (setq cAtr(nentsel "\nPick attribute > "))
      (= "ATTRIB"(cdr(assoc 0(setq dLst(entget(car cAtr))))))
      
     ); end and
   (if
     (and
       (setq pt1(getpoint "\nSpecify numbering direction start"))
       (setq pt2(getpoint pt1 "\nSpecify numbering direction end"))
       ); end and
   (progn
     (if(<=(car pt1)(car pt2))(setq xSrt '<)(setq xSrt '>))
     (if(<=(cadr pt1)(cadr pt2))(setq ySrt '<)(setq ySrt '>))
     (setq blName
       (vla-get-effectiveName ;<-- changed
          (vla-ObjectIDToObject
         (vla-get-ActiveDocument
            (vlax-get-acad-object))
               (vla-get-OwnerID
                  (vlax-ename->vla-object(car cAtr)))))
      
  fLst  (list(cons 0  "INSERT")(cons 2 (strcat "`*U*,"blName)));<-- changed
       aName(cdr(assoc 2 dLst))
       ); end setq
     (princ "\n<<< Select blocks to number >>> ")
     (if
       (setq blSet(ssget "F" (list pt1 pt2) fLst));<-- changed
       (progn
        (setq sLst
                   (mapcar 'vlax-ename->vla-object
             (mapcar 'car
              (vl-sort
               (vl-sort
                 (mapcar '(lambda(x)(list x
              (trans(cdr(assoc 10(entget x)))0 1)))
                   (vl-remove-if 'listp 
                             (mapcar 'cadr(ssnamex blSet))))
                       '(lambda(a b)((eval xSrt)(caadr a)(caadr b))))
                     '(lambda(a b)((eval ySrt)(cadadr a)(cadadr b)))))))

        (foreach i sLst
          (setq atLst
             (vlax-safearray->list
            (vlax-variant-value
              (vla-GetAttributes i))))
          (foreach a atLst
        (if
          (= aName(vla-get-TagString a))
   (progn
             (vla-put-TextString a
stStr
 )
     (setq stStr(inc-digit stStr))
          )
   ); end if
        ); end foreach
        (setq stNum(1+ stNum))
          ); end foreach
         ); end progn
       (princ "\nEmpty selection! Exit. ")
       ); end if
       ); end progn
      (princ "\nDirection not specified! Exit. ")
     ); end if
   (princ "\nThis isn't attribute! Exit. ")
   ); end if
     ); end progn
   (princ "\nInvalid start number! Exit. ")
   ); end if
 (princ)
 ); end of c:anum
(princ "\nStart command with \"ANUM\"")
(prin1)
;;---------------------------------------- End of code ---------------------------------------;;

 

~'J'~

Edited May 8, 2012 by fixo
code added

[ANTIADDICT]

Find line:

(setq stNum(1+ stNum))

and change to

(setq stNum(+ 2 stNum))

 

how could I change the code to prompt me to ask what I would like the increments to be, similar to how 'tcount' asks, rather than change the code each time I want to change the increments?

 

Thank you.

[Artek]

1. Specify start number

2. Pick to wanted attribute

3. Select blocks and press Spacebar

 

Enjoy...

 

(defun c:mnum(/ stStr stNum nLen cAtr dLst blName
         fLst blLst blSet aName sLst lZer aStr)
 (vl-load-com)
 (if
   (and
     (setq stStr(getstring "\nSpecify start number: "))
     (setq stNum(atoi stStr))
     (setq nLen(strlen stStr))
     ); end and
   (progn
     (if
   (and
      (setq cAtr(nentsel "\nPick attribute > "))
      (= "ATTRIB"(cdr(assoc 0(setq dLst(entget(car cAtr))))))
     ); end and
   (progn
     (setq blName
       (vla-get-Name
          (vla-ObjectIDToObject
         (vla-get-ActiveDocument
            (vlax-get-acad-object))
               (vla-get-OwnerID
                  (vlax-ename->vla-object(car cAtr)))))
       fLst(list '(0 . "INSERT")(cons 2 blName))
       aName(cdr(assoc 2 dLst))
       ); end setq
     (princ "\n<<< Select blocks to number >>> ")
     (if
       (setq blSet(ssget fLst))
       (progn
        (setq sLst
                   (mapcar 'vlax-ename->vla-object
             (mapcar 'car
              (vl-sort
               (vl-sort
                 (mapcar '(lambda(x)(list x(cdr(assoc 10(entget x)))))
                   (vl-remove-if 'listp 
                             (mapcar 'cadr(ssnamex blSet))))
                       '(lambda(a b)(<(caadr a)(caadr b))))
                     '(lambda(a b)(>(cadadr a)(cadadr b)))))))
        (foreach i sLst
          (setq lZer "")
          (repeat(- nLen(strlen(itoa stNum)))
        (setq lZer(strcat lZer "0"))
        ); end repeat
          (setq atLst
             (vlax-safearray->list
            (vlax-variant-value
              (vla-GetAttributes i))))
          (foreach a atLst
        (if
          (= aName(vla-get-TagString a))
             (vla-put-TextString a
           (strcat lZer(itoa stNum)))
          ); end if
        ); end foreach
        (setq stNum(1+ stNum))
          ); end foreach
         ); end progn
       (princ "\nEmpty selection! Quit. ")
       ); end if
     ); end progn
   (princ "\nThis isn't attribute! Quit. ")
   ); end if
     ); end progn
   (princ "\nInvalid start number! Quit. ")
   ); end if
 (princ)
 ); end of c:mnum

 

Hi ASMI,

 

Any chance of tweaking your brilliant code to work on a fixed attribute/tag name instead selecting one? Thanks.

[Suraj Bhunje]

Hi! ASMI..

 

Tht was really a great code u provided here. It worked just like a butter-spread in first attempt. But it only allows the program to update numbers of Attributes in +ve X-Axis direction, irrespective of how you select the Attributes.

 

Can you suggest a modification for numbering of the Attributes I selected in the sequence of their selection instead of X-Axis direction please??