Block attributes

I would like to keep the value for the first attribute of every block in a
drawing and remove the value for all other attributes. THe problem is that
not all the blocks have the same number of attributes. I am not doing much
in ACAD anymore so my VBA is a little rusty.

Any help would be greatly appreciated.

--
What once brought fright
Now seems oh so trite
And I'm scared

To reply directly to me use DEODORANT

 

Public Sub ClearAllAttributesExceptFirst()
  Dim AttributeRefs As Variant
  Dim BlockRef As AcadBlockReference
  Dim Entity As AcadEntity
  Dim I As Integer

For Each Entity In ThisDrawing.ModelSpace
    If TypeOf Entity Is AcadBlockReference Then
      Set BlockRef = Entity
      AttributeRefs = BlockRef.GetAttributes
      For I = LBound(AttributeRefs) To UBound(AttributeRefs)
        If Not I = LBound(AttributeRefs) Then
          AttributeRefs(I).TextString = ""
        End If
      Next I
    End If
  Next Entity

For Each Entity In ThisDrawing.PaperSpace
    If TypeOf Entity Is AcadBlockReference Then
      Set BlockRef = Entity
      AttributeRefs = BlockRef.GetAttributes
      For I = LBound(AttributeRefs) To UBound(AttributeRefs)
        If Not I = LBound(AttributeRefs) Then
          AttributeRefs(I).TextString = ""
        End If
      Next I
    End If
  Next Entity
End Sub

 

Public Sub ClearAllAttributesExceptFirst()   Dim AttributeRefs As Variant   Dim BlockRef As AcadBlockReference   Dim Entity As AcadEntity   Dim I As Integer

For Each Entity In ThisDrawing.ModelSpace     If TypeOf Entity Is AcadBlockReference Then       Set BlockRef = Entity       AttributeRefs = BlockRef.GetAttributes       For I = LBound(AttributeRefs) To UBound(AttributeRefs)         If Not I = LBound(AttributeRefs) Then           AttributeRefs(I).TextString = ""         End If       Next I     End If   Next Entity

For Each Entity In ThisDrawing.PaperSpace     If TypeOf Entity Is AcadBlockReference Then       Set BlockRef = Entity       AttributeRefs = BlockRef.GetAttributes       For I = LBound(AttributeRefs) To UBound(AttributeRefs)         If Not I = LBound(AttributeRefs) Then           AttributeRefs(I).TextString = ""         End If       Next I     End If   Next Entity End Sub

 

When you grab the attributes from a block using 'getattributes', you
save them to an array. You can then use 'ubound' to determine the number
of elements, save the textstring of element(0), then iterate the array
removing the other textstring values,,,,,

arry = blkref.getattributes
for i = 0 to ubound(arry)
if i = 0 then
'save info
else
array(i).textstring = ""
end if
next i

 

minor simplification : )

For I = LBound(AttributeRefs)+1 To UBound(AttributeRefs)
AttributeRefs(I).TextString = ""
Next I

James

 

The loop should be skipped over if the first index is > the second...

Sub test_for()
For i = 1 To 0
MsgBox "you won't see this msg box"
Next 'i
End Sub

James

 

Thanks for the help