Acad VBA to Edit Attr Def Tag not Assoc to Block

[mantaka37]

Hi – I’m a newbie here. I am trying to find examples of how to edit the Tag of an Attribute that is not associated to a block. My Acad files appear to have had the block exploded and all I’m left with are individual entities that are Attribute Definitions. I want to use VBA to match and replace the text in the Tag property. All the examples of Attribute modification in VBA that I've seen seem to require getting the block first, which I don’t have. Can anyone help?
Thanks!

[Tommy]

Can you post a drawing? So I can have what you are dealing with.

[mantaka37]

Thanks for the reply. Attached is a file with the text I want to change. It is the initials and date in the revision block. Ideally, I would love to be able to read the text at that certain position (via xy coord), then replace it (the dates change from dwg to dwg). For now - quick and dirty would be just to do global replaces (and do multiple replaces for different dates)

Thank you very much for any help.........

[Tommy]

OK What I have done is get the attribute defintion in this drawing and I am sending them to an input box for input. You can change them then.

Now with that said, this drawing is ment to be inserted into another drawing and filled out on the insertion. I don't know how it is supposed to do multiple entries though.

Let me kow if you need more or need some changes.


[VBA]
Sub GetTitleBlockInfo()
Dim intCode(0) As Integer
Dim varData(0) As Variant
Dim txtset As AcadSelectionSet
Dim mI As Long
intCode(0) = 0: varData(0) = "ATTDEF"
Set txtset = Aset("AtSet")
txtset.Select acSelectionSetAll, , , intCode, varData
'txtset.SelectOnScreen
If txtset.Count > 0 Then
For mI = 0 To txtset.Count - 1
If txtset(mI).TextString = "" Then
txtset(mI).TextString = InputBox(txtset(mI).PromptString)
txtset(mI).TagString = txtset(mI).TextString
End If
Next
txtset.Update
End If
txtset.Delete
End Sub

Public Function Aset(iSSetName As String) As AcadSelectionSet
Dim ssetA As AcadSelectionSet
On Error Resume Next
Set ssetA = ThisDrawing.SelectionSets.Add(iSSetName)
If Err.Number <> 0 Then
Set ssetA = ThisDrawing.SelectionSets(iSSetName)
ssetA.Delete
Set ssetA = ThisDrawing.SelectionSets.Add(iSSetName)
Err.Clear
End If
On Error GoTo 0
Set Aset = ssetA
End Function
[/VBA]

[mantaka37]

Thanks Tommy,
that did the trick. I appreciate your efforts.
The file I had posted was the actual drawing file stripped out of everything except those elements I was trying to edit. I stripped out all the graphics etc for "proprietary" reasons.
Again, thanks for the help!