Edit attributes for all blocks in Drawing

[E.deJong]

Hi, i have some experience wilh VBA within Excel but for Autocad is new for me.

I am looking for a macro that can edit the default value off the attriburte for each block in the drawing. The new value must be empty.

But there is one exception. When the length of the current value is equal to 8 then the macro's has to do nothing and the macro must continu to the next block.

Does anyone have an macro like this or something simular. Or do I have to write one by myself.

Greets Eric

[3wood]

You can easily achieve this by using FIND command.

Select all blocks first, then use FIND.

Find text string: ~????????

Replace with: (Do not enter anything here)

Then press "Replace all"

All block attributes value will be cleared except the attributes with 8 characters.

3wood

CAD KITS

[E.deJong]

The solution you give dont work for me.

The idea was good but i think the problem is that the attribute is invisible.

I have attached an example drawing with this post to give you a better idea of the problem.

Greets Eric

[arcticad]

Dim item As Variant
For Each item In ThisDrawing.ModelSpace
    If TypeOf item Is AcadBlockReference Then
        Dim att As Variant
  
        For Each att In item.GetAttributes
            If att.Visible = False Then
                If att.TagString = "My_String" Then
                    att.TextString = "New Text"
                End If
            End If
            
        Next
    End If
Nex

[E.deJong]

The code start really promising.

With putting some message-boxes i have tried to follow the code.

But when i get to item.GetAttributes i got stuck. It looks like that the attribute we are using in the blocks are different. Because with another block we use as a titleblock for each drawing it works.

Autocad dos recognize it as an attribute. I have tested it if the item has an attribute and the result was true.

But thanks for the start. I will give a try next week when i have more time available. When you have got another solution to work with i am interested.

[Hallex]

Try this code as well

Option Explicit

Public Sub TitleUpdate()
Const blkName As String = "TitleBlock" '<--- any block name
Dim tags As Variant
Dim atts As Variant
'' change all tags (case-sensitive), remove extras
tags = Array("CUSTOMER", "TITLE", "DATA", "REVISION", "DRAWN", "CHECKED", "DRAWNUM")
'' change all values (case-sensitive), remove extras
atts = Array("Obalokwande Makumbu", "Sando Stadium Project", "15.03.2012", "2", "fixo", "Big Boss", "777")
On Error GoTo Err_Control
If UBound(tags) <> UBound(atts) Then
MsgBox "Check given arrays on equal number of strings"
Exit Sub
Else
Dim i As Integer
Dim attColl As New Collection
For i = LBound(tags) To UBound(tags)
Dim tmp(0 To 1) As String
tmp(0) = tags(i): tmp(1) = atts(i)
attColl.Add Item:=tmp, key:=tags(i)
Next i
End If
Dim fType(0 To 2) As Integer
Dim fData(0 To 2) As Variant
Dim dxfCode, dxfValue
fType(0) = 0: fData(0) = "INSERT"
fType(1) = 66: fData(1) = 1

fType(2) = 2: fData(2) = blkName
dxfCode = fType: dxfValue = fData
     Dim oSset As AcadSelectionSet
          With ThisDrawing.SelectionSets
               While .Count > 0
                    .Item(0).Delete
               Wend
          Set oSset = .Add("MySset")
          End With

oSset.Select acSelectionSetAll, , , dxfCode, dxfValue
If oSset.Count = 0 Then
MsgBox "Nothing selected"
Exit Sub
Else
MsgBox "Selected " & oSset.Count & " blocks"
End If
Dim oEnt As AcadEntity
Dim oBlkRef As AcadBlockReference
Dim oBlock As AcadBlock
Dim bName As String

For Each oEnt In oSset
  Set oBlkRef = oEnt
  Dim attArray As Variant
    attArray = oBlkRef.GetAttributes
 
Dim k As Integer
  For i = LBound(attArray) To UBound(attArray)
   Dim oAttRef As AcadAttributeReference
    Set oAttRef = attArray(i)
     For k = 1 To attColl.Count
        If StrComp(oAttRef.TagString, CStr(attColl.Item(k)(0)), vbTextCompare) = 0 Then
        oAttRef.TextString = CStr(attColl.Item(k)(1))
        Exit For
      End If
    Next k
Next i
Next oEnt
Err_Control:
If Err.Number <> 0 Then
MsgBox Err.Description
End If
End Sub

~'J'~