Multiple find and replace in Block attributes

[Chandru]

Hello

 

I am trying to make multiple find and replace all the texts (text, mtext, and texts in blocks etc) in model space through excel vba (and not through Autocad vba).

I got the basic code from here and trying to modify for my requirements.

http://forums.autodesk.com/t5/Visual-Basic-Customization/VBA-Find-Replace-Quick-Fix-for-Someone-not-me-Please-Help/td-p/1829444/page/2

 

I am able to do find and replace for text, but getting an error when trying to replace the text in blocks. Have checked some threads in this forum but yet to debug.

--------------------

With oModel.Utility

 

End with

--------------------

I have attached the excel file in which the glossary is available in Sheet1 and macro in Module1. Have attached a sample drawing.

 

Any help is appreciated.

 

Thanks

Chandru

Drawing1.dwg

Multiple Find and Replace in all Autocad drawings.xls

[ska67can]

The code you are using is to replace block attribute text. Your block doesn't have attributes, your block IS the text.

[BlackBox]

 

Batch Find and Replace Text

[Chandru]

ska67can - The text with a leader is in fact a block (Block name: BLK1) (that is how I received the drawing from the client). Others are text and mtext. The vba macro works well for the text, mtext and layer name. I am not able to debug the find and replace for block reference. I have made another drawing and this contains additional blocks. Still this vba is not able to find the attributes in the block.

 

This is the code snippet where I am getting the error. I am not sure how to access the Utility. (Think that is where the block definitions can be accessed)

With oAcad.ActiveDocument.Utility or With oModel.Utility

I am able to manually open the Block editor, edit each block, find the text and replace it with the text in "replace text" column. But the number of drawings demand automation.

 

 Case "AcDbBlockReference"
   Set bRefObj = objEnt(intI)
   'With oAcad.ActiveDocument.Utility
   'With oModel.Utility
       If bRefObj.HasAttributes Then
           bRefVar = bRefObj.GetAttributes
           For intIBlk = LBound(bRefVar) To UBound(bRefVar)
               wksGlossary.Cells(1, 4) = bRefVar(intIBlk).TextString  'Temporarily Copy Text to Excel
               For intO = 0 To intRowCount - 1
                   strFind = wksGlossary.Cells(1 + intO, 1).Value     'Set Find text value
                   textLen = Len(strFind)                             'Determine the length of Find text
                   C = wksGlossary.Cells(1 + intO, 1).Row             'Determine the location of Find text on Spreadsheet
                   strRepl = wksGlossary.Cells(C, 2)                  'Determine the Replace text based on location
                   textPos = InStr(1, wksGlossary.Cells(1, 4).Value, strFind, 1)       
                   If textPos > 0 Then                                         'Match Found
                       wksGlossary.Cells(1, 4).Value = WorksheetFunction.Replace(wksGlossary.Cells(1, 4).Value, textPos, textLen, strRepl) 'Replace Text
                       bRefVar(intIBlk).TextString = wksGlossary.Cells(1, 4).Value
                       intReplaced = intReplaced + 1
                   End If
               Next
           Next
       End If
   'End With

RenderMan - Thanks for the suggestion. I have searched this forum fully, have checked the Batch Find and Replace by Lee mac.

Lee mac's lisp routine does not handle unicode characters. What I get from client is unicode characters in the text and block, and need to change that.

I have made a detailed reply in that thread last year, found some bugs, and have made few suggestions. Here is the link.

www.cadtutor.net/forum/showthread.php?46135-Batch-Find-amp-Replace-Text/page19

 

Thank you for your detailed feedback Chandru, it is greatly appreciated, I now have many ideas and bug fixes to implement in the next version.

Thanks

Lee

Since Lee mac's lisp routine is no going to support unicode characters, and also to save in previous format, I decided to develop the vba routine.

 

Thanks, Chandru

 

Drawing2.dwg

[ska67can]

Yes, the text is a block but it is not a block attribute which is what your code is looking for. You need to edit the block itself, not the block reference. Try this:

 

Dim oEnt As AcadEntity
Dim oBlock As AcadBlock
Dim i As Long, j As Long

On Error Resume Next
For Each oBlock In oAcad.ActiveDocument.Blocks
   For i = 0 To oBlock.Count
       If oBlock.Item(i).ObjectName = "AcDbText" Then
           For j = 1 To wksGlossary.Cells(65536, 1).End(xlUp).Row              'Sets the Search Range
               If oBlock.Item(i).TextString = wksGlossary.Cells(j, 1) Then     'Search for Original Text
                   oBlock.Item(i).TextString = wksGlossary.Cells(j, 2)         'Replace Text
                   oBlock.Update                                               'Save Block Definition
               End If
           Next j
       End If
   Next i
Next oBlock
On Error GoTo 0

 

BTW

With ThisDrawing.Utility

is completely unnecessary and isn't actually doing anything. I don't know why I put it in there in the first place.

[Chandru]

ska67can - Many thanks for the code. It works perfectly.

I got the point, that we need to open the block and replace the text, and not the block reference.

Appreciate for your code on find and replace. It is very simple and neat. I have used it for find and replace in text and mtext.

Now working on find and replace in the 'text override' in all type of dimensions.

Will update the macro for the community use once it is over.

 

Thanks, Chandru

[BlackBox]

RenderMan - Thanks for the suggestion. I have searched this forum fully, have checked the Batch Find and Replace by Lee mac.

Lee mac's lisp routine does not handle unicode characters. What I get from client is unicode characters in the text and block, and need to change that.

I have made a detailed reply in that thread last year, found some bugs, and have made few suggestions. Here is the link.

www.cadtutor.net/forum/showthread.php?46135-Batch-Find-amp-Replace-Text/page19

 

Since Lee mac's lisp routine is no going to support unicode characters, and also to save in previous format, I decided to develop the vba routine.

 

I must have overlooked that requirement in the OP; glad you got it sorted.