[编程交流] 顺序编号块att

(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

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