Attribute Renumber

[Ohnoto]

I am trying to modify some code from the posting create an attribute autonumber retrospectively. The code being...

 

(defun c:AttNum ( / *error* _StartUndo _EndUndo doc ss lst ) (vl-load-com)
 ;; © Lee Mac 2010

 (defun *error* ( msg )
   (if doc (_EndUndo doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
 )

 (defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
     (vla-EndUndoMark doc)
   )
 )

 (setq doc  (vla-get-ActiveDocument (vlax-get-acad-object)))  

 (setq *tag (cond ( *tag ) ( "POLE_SEQUENCE" ))
       
 )

 (setq *tag
   (strcase
     (cond
       (
         (eq ""
           (setq tmp
             (getstring
               (strcat "\nSpecify Attribute Tag to be Numbered <"
                 (setq *tag
                   (cond ( *tag ) ( "POLE_SEQUENCE" ))
                 )
                 "> : "
               )
             )
           )
         )
         *tag
       )
       ( tmp )
     )
   )
 )

 (setq *num
   (1-
     (cond
       (
         (getint
           (strcat "\nSpecify Starting Number <"
             (itoa
               (setq *num
                 (1+
                   (cond ( *num ) ( 0 ))
                 )
               )
             )
             "> : "
           )
         )
       )
       ( *num )
     )
   )
 )

 (if (ssget "_:L" '((0 . "INSERT") (66 . 1)))
   (progn      
     (vlax-for o (setq ss (vla-get-ActiveSelectionSet doc))
       (setq lst
         (cons
           (cons (vlax-get o 'InsertionPoint) o) lst
         )
       )
     )
     (vla-delete ss)

     (_StartUndo doc)

     (mapcar
       (function
         (lambda ( block )
           (mapcar
             (function
               (lambda ( attrib )
                 (if (eq *tag (strcase (vla-get-TagString attrib)))
                   (vla-put-TextString attrib (setq *num (1+ *num)))
                 )
               )
             )
             (vlax-invoke (cdr block) 'GetAttributes)
           )
         )
       )
       (vl-sort lst
         (function
           (lambda ( a b ) (> (cadar a) (cadar b)))
         )
       )
     )

     (_EndUndo doc)
   )
 )

 (princ)
)

The attributes that we renumber this way are all in one block that we use for telephone poles. There isn't ever a consistent X or Y axis for fully running a recount program as these are posted via GPS and can be posted in any direction. We use stationing and for those that don't know civil that is shown as 1+50, being 150 feet. What I am hoping to figure out is if the "POLE_SEQUENCE" tag can be renumbered in order based on the value of the "STA" tag within the attached block.

Attribute Pole.dwg

[pBe]

Try this

 

Window Selection

 
(defun c:SortBySta  (/ adoc i SelSet StaList AttVal)
 (vl-load-com)
 (setq adoc (vla-get-activedocument (vlax-get-acad-object))
   i    0)
 (if (ssget ":L" '((0 . "INSERT") (66 . 1)))
   (cond
     ((vlax-for
         Sta  (setq SelSet (vla-get-activeselectionset adoc))
        (setq StaList
           (cons
             (list
               (vla-get-textstring
                 (car
                   (setq AttVal
                      (vlax-invoke
                        Sta
                        'GetAttributes))))
               (nth 26 AttVal))
             StaList)))
      (foreach
         Blk  (vl-sort
                StaList
                (function (lambda (p1 p2) (< (car p1) (car p2)))))
        (vla-put-textstring (cadr Blk) (itoa (setq i (1+ i)))))))
   (vla-delete SelSet))
(princ)
 )

 

Select by order

 
(defun c:ValbySel (/  txob)
(vl-load-com)
(setq i (cond
    ((getint
        (strcat "\nEnter Start Number <"
          (itoa
            (setq i
              (cond ( i ) ( 1 ))
            )
          )
          ">: "
        )
      )
    )
    ( i)
  )
i (1- i))
(while
   (setq txob (car (entsel "\nSelect Text Object: ")))
   (vla-put-textstring (nth 26 (vlax-invoke (vlax-ename->vla-object txob) 'GetAttributes))
          (itoa (setq i (1+ i)))
  )
 )
  (princ)
)

Edited April 18, 2011 by pBe

[Ohnoto]

The codes works perfectly, which I'd use the first one more. If I could ask for one other small thing with it. If the STA tag is blank (null) can it be skipped with the numbering?

[Ohnoto]

Ok... so I lied... One other thing I found. I tried to modify the code to get everything, using SSGET "_X" and then added a (2 . "pole-sta") in the SSGET function, that didn't work, got the error below. I also tried a mapcar function at the beginning to only run with that block and that didn't work either, again the error below.

 

The error below:

error: bad argument type: VLA-OBJECT nil

 

I'd like this to run automatically without having to select all of the blocks as we could have anywhere from 1 to 30+ miles worth of these blocks.

[pBe]

Ok... so I lied... One other thing I found. I tried to modify the code to get everything, using SSGET "_X" and then added a (2 . "pole-sta") in the SSGET function, that didn't work, got the error below. I also tried a mapcar function at the beginning to only run with that block and that didn't work either, again the error below.

 

The error below:

error: bad argument type: VLA-OBJECT nil

 

I'd like this to run automatically without having to select all of the blocks as we could have anywhere from 1 to 30+ miles worth of these blocks.

 

Reason why this did not work,

SSGET "_X" and then added a (2 . "pole-sta")

 

Dynamic blocks have the tendency of changing the names to "*U#" (anonymous) when modfified, it just behaves that way.

 

So

 (ssget "x" '((0 . "INSERT")(2 . "`*U*,POLE-STA")))

Will select all blocks named "POLE-STA" AND Anonymous blocks with attributtes.

 

Then check for Effectivename

 (equal (vla-get-effectivename sta) "pole-sta")

 

Try this, i even throw in the filter for blank STA value

 
(defun c:SortBySta  (/ adoc i SelSet StrValidate AttVal StaList)
 (vl-load-com)
 (setq adoc (vla-get-activedocument (vlax-get-acad-object))
   i    0)
 (if [color=blue](ssget "x" '((0 . "INSERT")(2 . "`*U*,POLE-STA")))[/color]
     (cond (
     (vlax-for Sta  (setq SelSet (vla-get-activeselectionset adoc))
([color=blue]if (and (equal (vla-get-effectivename sta) "pole-sta")[/color]
[color=blue]        (/= (setq StrValidate (vla-get-textstring (car (setq AttVal[/color]
[color=blue]                     (vlax-invoke[/color]
[color=blue]                       Sta[/color]
[color=blue]                       'GetAttributes))))) ""))[/color]
         (setq StaList
            (cons
              (list [color=blue]StrValidate[/color] (nth 26 AttVal))
              StaList))
                 )
        )

     (foreach
         Blk  (vl-sort
                StaList
                (function (lambda (p1 p2) (< (car p1) (car p2)))))
        (vla-put-textstring (cadr Blk) (itoa (setq i (1+ i)))))
     )
    )
   (vla-delete SelSet)
)
(princ)
 )

 

 

hope this helps

[Ohnoto]

Not sure why, the "x" isn't working, I switched it back to ":L" and it works, sorta. To test it, I grouped selected everything within our template and it wouldn't work, but when I group selected the pole block in smaller groups it works fine. It appears as if there was a limit on the amount of things it would be able to select which seems weird. Either way, I added at the beginning to type a number to start adjusting numbers with.

 

Thanks for the assistance, I appreciate it.

[pBe]

Most likely one or more of your blocks are on a locked layer.

I guess you need to include a test for objects on a locked layer then.

i'm sure you can figure that one out

 

Between these lines

 
    [color=slategray](vlax-for Sta  (setq SelSet (vla-get-activeselectionset adoc))[/color]
[color=slategray](if (and  [color=black]<---Here--->[/color]
[/color][color=slategray](equal (vla-get-effectivename sta) "pole-sta")[/color]
[color=slategray]     (/= (setq StrValidate (vla-get-textstring (car (setq AttVal[/color]
[color=slategray]                  (vlax-invoke[/color]
[color=slategray]                    Sta[/color]
[color=slategray]                    'GetAttributes))))) ""))...[/color]