Search and Replace Drawing VBA routine?

[muck]

Can search/replace feature be made in VBA for a full drawing?

 

Can search/replace feature be made in VBA for a drawing model space?

 

Can search/replace feature be made in VBA for a specific drawing layout in paper space

for multi space drawing?

 

Thank you,

[muck]

How would you deal with block text and attributes. Is there a way to use the

autocad find function in VBA?

[dbroada]

I can't remember how I use this but here is an old VBA routine I wrote. Most of our drawings are purely in model space but I am sure the code can be modified to suit your use, probably at the selection set stage.

 

Option Explicit
Public Sub FandR(OldText As String, NewText As String, Optional WhatType As Byte)

If (WhatType And 1) = 0 Then Call SelSet("TEXT", OldText, NewText)
If (WhatType And 2) = 0 Then Call SelSet("MTEXT", OldText, NewText)
If (WhatType And 4) = 0 Then Call SelBlocks(OldText, NewText)
End Sub
Public Sub SelSet(ObjType As String, OldText As String, NewText As String)
Dim myObject As Object
Dim mySelectionSet As AcadSelectionSet
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
Dim groupCode As Variant
Dim dataCode As Variant
Dim i As Integer, j As Integer
Dim TempString As String
gpCode(0) = 0 'item
groupCode = gpCode
dataValue(0) = ObjType 'item type
dataCode = dataValue
Set mySelectionSet = ThisDrawing.SelectionSets.Add("FandR")
mySelectionSet.Select acSelectionSetAll, , , groupCode, dataCode
For i = 0 To mySelectionSet.Count - 1
If InStr(1, mySelectionSet.Item(i).TextString, OldText) <> 0 Then
   j = InStr(1, mySelectionSet.Item(i).TextString, OldText)
   TempString = Left$(mySelectionSet.Item(i).TextString, j - 1) & NewText
   TempString = TempString & Mid$(mySelectionSet.Item(i).TextString, Len(TempString) + 1)
   mySelectionSet.Item(i).TextString = TempString
   End If
Next
ThisDrawing.SelectionSets.Item("FandR").Delete
End Sub
Public Sub SelBlocks(OldText As String, NewText As String)
Dim myEntity As AcadEntity
Dim mySelSet As AcadSelectionSet
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
Dim groupCode As Variant
Dim dataCode As Variant
Dim myAttrib As Variant
Dim myCurrentAtt As Variant
Dim TempString As String
Dim j As Integer
gpCode(0) = 0 'item
groupCode = gpCode
dataValue(0) = "INSERT" 'item type
dataCode = dataValue
Set mySelSet = ThisDrawing.SelectionSets.Add("Blocks")
mySelSet.Select acSelectionSetAll, , , groupCode, dataCode
For Each myEntity In mySelSet
   myAttrib = myEntity.GetAttributes
   For Each myCurrentAtt In myAttrib
       If InStr(1, myCurrentAtt.TextString, OldText) <> 0 Then
           j = InStr(1, myCurrentAtt.TextString, OldText)
           TempString = Left$(myCurrentAtt.TextString, j - 1) & NewText
           TempString = TempString & Mid$(myCurrentAtt.TextString, Len(TempString) + 1)
           myCurrentAtt.TextString = TempString
       End If
   Next myCurrentAtt
Next myEntity
ThisDrawing.SelectionSets.Item("Blocks").Delete
End Sub

 

All I can say is that it did what I needed it to. Whether you can use it or modify it is up to you to decide.

[BIGAL]

If you want to change block attributes in a drawing its prety easy in VBA a search for a block name will find all in a drawing, model or paper (if you dont specify say model only) and then changing is easy.

 

Search here to change attributes VBA (BIGAL) Changing text in a block I am sure also has been done here, search some more. I am sure lee mac had a vlisp to do this convert code to VBA.

 

Sometimes the search can be difficult trying to look for the right words think outside the square.