using vba to find a text from excel in autocad drawing

[almaroun]

Hello,

I want to write a vba code in excel that picks up un text from a cell in an excel worksheet and finds it on an autocad drawing.

here is my code:

Sub FindTextOnAcad()
  Dim Acad As acadapplication
  Dim acadfile As String
  acadfile = myfile.dwg
ActiveWorkbook.FollowHyperlink acadfile
Set Acad = GetObject(, "autocad.application")
Acad.ActiveDocument.sendcommand("find" & vbCr)
End Sub

This works well and opens the "Find" dialogue box in the acad drawing so I can imput the text from excel manually.

But what I need is to have vba directly find the required text without opening the "find" dialogue box

I tried the following: Acad.ActiveDocument.modelspace.find but it doesnt work

Thanks in advance for any suggestion

Almaroun

[RICVBA · Accepted solution]

use SelectionSet object methods to group all TEXT objects

here's a quick code you can adapt to your needs

Option Explicit
Sub FindText()
    '-------------------------------------------------------
    'Texts objects searching
    
    Dim myText As AcadText
    Dim ntexts As Integer, iText As Integer
    Dim myString As String
    
    Dim gpCode(0 To 1) As Integer
    Dim dataValue(0 To 1) As Variant
    Dim ssetObj As AcadSelectionSet
    
    myString = "mytext" ' text to find. here you can also use wild characters like "*mytext" or "*mytext*"
   
    'selecting texts objects in the active drawing
    gpCode(0) = 0:  dataValue(0) = "TEXT" ' here you can also use "TEXT,MTEXT" to pick up both object types
    gpCode(1) = 1:  dataValue(1) = myString
    On Error Resume Next
    Set ssetObj = ThisDrawing.SelectionSets.Item("TextSset")
    If Err <> 0 Then
        Set ssetObj = ThisDrawing.SelectionSets.Add("TextSset")
    Else
        ssetObj.Clear
    End If
    On Error GoTo 0
    ssetObj.Select acSelectionSetAll, , , gpCode, dataValue

    'handling texts object found
    ntexts = ssetObj.Count
    For iText = 0 To ntexts - 1
        ' do your stuff here
        ' for instance I'm listing all textstrings of the found objects
        Set myText = ssetObj.Item(iText)
        MsgBox ("Found :" & myText.TextString)
    Next iText
    '-------------------------------------------------------


End Sub

 bye

[almaroun · Accepted solution]

Thanks a lot RICVBA,

this does solve my issue

Thanks

Almaroun

[Ravi3689]

Hi,

I am getting error in this Line.

Set myText = ssetObj.Item(iText)

Type Mismatch.

Regards,

Ravi

[e_c]

I modified the code slightly; I believe it's a bit cleaner:

replace "Dim ntexts As Integer, iText As Integer" and "Dim myText As AcadText" with "Dim AcadEnt As AcadEntity"

replace everything after " 'handling texts objects found" with:

For Each AcadEnt In ssetObj
  ' Do stuff in here; the text string can be accessed with AcadEnt.TextString
   MsgBox("Found : " & AcadEnt.TextString)
Next AcadEnt

This eliminates the clunky counting, which should fix your issue.

---

@Ravi3689 wrote:

Hi,

I am getting error in this Line.

Set myText = ssetObj.Item(iText)

Type Mismatch.

Regards,

Ravi

---

[martyn.hilbers]

Hi,

I am new to Autocad and am trying to achieve a very similar objective. I want to change the text of a tag in an attribute so I can generate unique drawings from a generic template.

I am trying the supplied code in the post here but am getting stuck on the following line: 

Set ssetObj = ThisDrawing.SelectionSets.Item("TextSset")

The ssetObj is set to "nothing" when the line above is executed. It is as if no block and/or tag and text is selected.

Any help is appreciated!

Thanks

[Ed.Jobe]

Did you include the line prior to that line? e.g. "On Error Resume Next"? Under normal execution, if the named selectionset doesn't exist, it skips to the next line and adds the selectionset.