Sequential numbering block attributes

[Trebuchet]

I've searched and found several lisps, but none of them work with my block. I've tried to use the following:

 

(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

I can select the attribute, but when it prompts for me to select the blocks, I can't select anything. I'm assuming it's my block which is causing the problem. See attached. TENDONGROUP.dwg I need to renumber the GROUPID attribute. I have several hundred of these in each drawing, and would like to renumber them by a window selection, and the ability to select which direction to renumber is necessary.

 

I can renumber the attributes with a lisp I found called renum.lsp written by ASMI, but I have to do them one at a time.

 

Any ideas? Thanks everyone!

[btraemoore]

have you tried using vba?

 

type vbaide in to command prompt

 

new module and paste this in, edit the stuff in red

 

Sub [color="red"]NameOfYourChoice[/color]()
   ' We create our group codes and data values for our selection set.
   Dim gpCode(1) As Integer
   Dim dataValue(1) As Variant
   Dim SS_Blk As AcadSelectionSet
   Dim i As Integer, n As Integer
  
   SS_delete 1
  
   ' This is our filter. 
   ' We set the group codes and data values for what we want to find.
   Set SS_blk = ThisDrawing.SelectionSets.Add("SS_blk")
       gpCode(0) = 0: dataValue(0) = "INSERT"
       gpCode(1) = 8: dataValue(1) = "[color="red"]layer entities are on[/color]"
      
   SS_blk.Select acSelectionSetAll, , , gpCode, dataValue
       ' because VBA is object oriented, we have to create the references for our blocks
       ' We create our blocks and the attributes in our blocks.
       Dim Cur_Blk As AcadBlockReference
       Dim Blk_Atts() As AcadAttributeReference
       Dim Cur_Att As AcadAttributeReference
      
       ' This is where we make our loop
       ' " For i ". " i " is equal to the item number in the selection set
       ' until we get to the count of how many entities in SS_blk -1,
       ' because our item count in a selection set starts at 0 not at 1
       ' like in a collection.
       For i = 0 To SS_blk.Count - 1
           Set Cur_Blk = SS_Example.Item(i)
           Blk_Atts = Cur_Blk.GetAttributes
          
           ' " For n ", " n ' is equal to the attribute number in the current block. 
           For n = 0 To UBound(Blk_Atts)
               Set Cur_Att = Blk_Atts(n)
              
               If Cur_Att.TagString = "GROUPID" Then
                   CurAtt.textstring = CurAtt.textstring + [color="red"]100[/color]
' if the attribute text string = 7 then +2 would put it at 9
               End If
           Next n
       Next i
      
   Application.Update


End Sub


'-------------------

Sub SS_delete(x As Byte)
   If ThisDrawing.SelectionSets.Count > 0 Then
   Dim i As Integer
       On Error Resume Next
       For i = 0 To ThisDrawing.SelectionSets.Count - 1
           ThisDrawing.SelectionSets.Item(i).Delete
       Next i
       On Error GoTo 0
   End If
End Sub

Edited July 25, 2012 by btraemoore

[Trebuchet]

I've done some vb programming, but not much. Using the code above, I get a runtime error. "Object required"

 

Debug highlights this line:

For i = 0 To SS_Example.Count - 1

 

I'm not familiar enough to figure that out.

[btraemoore]

I've done some vb programming, but not much. Using the code above, I get a runtime error. "Object required"

 

Debug highlights this line:

For i = 0 To SS_Example.Count - 1

 

should read:

For i = 0 To SS_blk.Count - 1

 

I'm not familiar enough to figure that out.

 

im sorry, i missed something. recopy the code. i changed SS_Example to SS_blk.

[BIGAL]

Just a way to debug problems I dont use the If And progn method but rather do a step by step approach and defuns, others will shoot me down, but it makes it much easier to pinpoint the spot where code is not working as its not lots of code contained in a IF. What I often do is (princ "1") etc and look at numbers 1 2 3 stopped before 4 this may help to see where it is actually stopping. Else try VLIDE with on error set on.

[pBe]

.....
(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 

 

 

There lies your problem: The code is looking for a particular block name......

 

I can select the attribute, but when it prompts for me to select the blocks, I can't select anything.

I'm assuming it's my block which is causing the problem.

 

Any ideas? Thanks everyone!

 

Partly true, its not limited to your block but because you're using a Dynamic Block where block name changes to anonymous name upon parameter modification.

 

In this case (vla-get-Name... ) will give you someting like "*U2" and (list '(0 . "INSERT")(cons 2 blName)) will give you

((0 . "INSERT") (2 . "*U2")) as value for fLst.

 

Better to use (vla-get-EffectiveName ...) and (list '(0 . "INSERT")(cons 2 (strcat blName ",`*U*"))'(66 . 1))

 

putting it all together

 

(defun c:mnum(/ stStr stNum nLen cAtr dLst blName
         fLst blLst blSet aName sLst lZer aStr)
 (vl-load-com)
 [color=blue](defun _effname (ssobj bn / e selfil)
 (setq selfil (ssadd))
 (repeat (sslength ssobj)
   (if    (eq (vla-get-effectivename
         (vlax-ename->vla-object (setq e (ssname ssobj 0)))
       ) bn
   )  (ssadd e selfil)
   )  (ssdel e ssobj)
 )  (if (zerop (sslength selfil)) nil selfil)
)[/color]
 (if
   (and
     (setq stStr (getstring "\nSpecify start number: "))
     [color=blue](setq stNum (numberp (read  stStr)))[/color]
     (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
       ([color=blue]vla-get-EffectiveName[/color]
          (vla-ObjectIDToObject
         (vla-get-ActiveDocument
            (vlax-get-acad-object))
               (vla-get-OwnerID
                  (vlax-ename->vla-object(car cAtr)))))
       fLst(list '(0 . "INSERT")[color=blue](cons 2 (strcat blName ",`*U*"))'(66 . 1)[/color])
       aName(cdr(assoc 2 dLst))
       ); end setq
     (princ "\n<<< Select blocks to number >>> ")
     (if
      [color=blue] (and [/color](setq blSet (ssget fLst))
        [color=blue](setq blSet (_effname  blSet blName)))[/color]
       (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)
 )

BTW: what constitutes an "Invalid start number"? I notice you used GetString. I suggest you use GetInt instead.

Also be aware that the code sorts the selected block from top to bottom.

 

The code you posted still needs a lot of work. But i'll leave that for you to work on.