VBA find or search

[ofcarvajall]

Hello,

I need a method in Autocad VBA like the Autocad linecommand "find". The goal is to have a list (I am not sure if a dictinionary) with the results of this command.

For example:

I want to identify all elements that are related to the word "Motor".

I appreciate any help.

Regards,

[Ray-Sync · Accepted solution]

Hi, Look at this:

Sub FindText(keyword As String)
    Dim doc As Object
    Set doc = ThisDrawing

    Dim result() As String
    Dim i As Integer
    i = 0

    ' Iterate through all entities in the drawing
    Dim obj As Object
    For Each obj In doc.ModelSpace
        If obj.ObjectName = "AcDbText" Or obj.ObjectName = "AcDbMText" Or obj.ObjectName = "AcDbAttributeReference" Then
            ' Check if the text contains the keyword
            If InStr(1, obj.TextString, keyword, vbTextCompare) > 0 Then
                ' Add the text to the result array
                ReDim Preserve result(i)
                result(i) = obj.TextString
                i = i + 1
            End If
        End If
    Next obj

    ' Check if any results were found
    If i > 0 Then
        ' Display the results
        MsgBox "Elements related to '" & keyword & "':" & vbCrLf & Join(result, vbCrLf)
    Else
        MsgBox "No elements related to '" & keyword & "' found."
    End If
End Sub

[norman.yuan · Accepted solution]

A bit of correction: while the code does the work correctly by looping through ModelSpace (or PaperSpace), but it would not find text values of AcadAttributeReferences, because they are not directly owned/contained in the ModelSpace/PaperSpace, rather they are inside AcadBlockReferences. So if the OP does indeed expect text values of block attributes are also searched, the code should be updated like:

    Dim obj As Object
    Dim blk As AcadBlockReference
    Dim atts As Variant
    Dim n As Integer
    For Each obj In doc.ModelSpace
        If obj.ObjectName = "AcDbText" Or obj.ObjectName = "AcDbMText" Then
            ' Check if the text contains the keyword
            If InStr(1, obj.TextString, keyword, vbTextCompare) > 0 Then
                ' Add the text to the result array
                ReDim Preserve result(i)
                result(i) = obj.TextString
                i = i + 1
            End If
        ElseIf TypeOf obj Is AcadBlockReference Then
            Set blk=obj
            If blk.HasAttributes Then
                atts = blk.GetAttributes
                For n=0 to UBound(atts)
                    If InStr(1, atts(n).TextString, keyword, vbTextCompare) > 0 Then
                       ' Add the text to the result array
                        ReDim Preserve result(i)
                        result(i) = obj.TextString
                        i = i + 1
                     End If
                Next
            End If
        End If
    Next obj

[ofcarvajall]

Thanks!!!