find and replace text for active sheet

[chris_blessing]

Can someone help me modify this code to only search active sheet please

Sub main
        oDoc = ThisDoc.Document
        Dim oSheets As Sheets
        Dim oSheet As Sheet
        Dim oGeneralNotes As GeneralNotes
        Dim oGeneralNote As GeneralNote
        Dim oSymbol As SketchedSymbol
        Dim oSymbols As SketchedSymbols
        Dim oTitleBlock As TitleBlock
        Dim oTextBox As TextBox

        Dim ooTXT2Find As String
        Dim oNewTXT As String

        'get user input
        oTXT2Find = InputBox("Enter Text To Find:", "iLogic", "XXX")
        'look for blank value
        If oTXT2Find = "" Then
               Return 'exit rule
        End If

        oNewTXT = InputBox("Enter Text To Replace   '" & oTXT2Find _
        & "'  with.", "iLogic", "ZZZ")
        'look for blank value
        If oNewTXT = "" Then
               Return 'exit rule
        End If

        oSheets = oDoc.Sheets
        For Each oSheet In oSheets

               'handle errors
               On Error Resume Next

               'look at General Notes
               oGeneralNotes = oSheet.DrawingNotes.GeneralNotes
               For Each oGeneralNote In oGeneralNotes
                       oText = oGeneralNote.FormattedText
                       oText = ReplaceText(oText, oTXT2Find, oNewTXT)
                       oGeneralNote.FormattedText = oText
               Next

               'look at leader notes 
               oLeaderNotes = oSheet.DrawingNotes.LeaderNotes
               For Each oLeaderNote In oLeaderNotes
                       oText = oLeaderNote.FormattedText
                       oText = ReplaceText(oText, oTXT2Find, oNewTXT)
                       oLeaderNote.FormattedText = oText
               Next

               'look at title blocks
               oTitleBlock = oSheet.TitleBlock
               For Each oTextBox In oTitleBlock.Definition.Sketch.TextBoxes
                       oText = oTitleBlock.GetResultText(oTextBox)
                       oText = ReplaceText(oText, oTXT2Find, oNewTXT)
                       oTitleBlock.SetPromptResultText(oTextBox, oText)
               Next

               'look at sketched symbols    
               oSymbols = oSheet.SketchedSymbols
               For Each oSymbol In oSymbols
                       For Each oTextBox In oSymbol.Definition.Sketch.TextBoxes
                               oText = oSymbol.GetResultText(oTextBox)
                               oText = ReplaceText(oText, oTXT2Find, oNewTXT)
                               oSymbol.SetPromptResultText(oTextBox, oText)
                       Next
               Next
        Next

End Sub


Function ReplaceText(oText As String, oTXT2Find As String, oNewTXT As String)

        If oText = oTXT2Find Or oText.Contains(oTXT2Find) Then
               oText = Replace(oText, oTXT2Find, oNewTXT)
        End If
        Return oText

End Function

[vianney_cheneau]

hi,

if it could help someone one day

The code updated to search the text on all the sheets

An additional window will tell you the number of occurrences founded on each sheet and you will have to choose if you apply or not to all sheets

Thanks all

Sub Main
    If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then Return
    Dim oDDoc As DrawingDocument = ThisDoc.Document
    Dim oSheet As Inventor.Sheet = oDDoc.ActiveSheet
    '<<< set initial values to 'shared' variables >>>
    oDNotes = oSheet.DrawingNotes
    oTO = ThisApplication.TransientObjects
    oHLS = oDDoc.CreateHighlightSet
    oHLS.Color = oTO.CreateColor(255, 0, 0, 1) 'Red - Opaque
    oFoundDNotesColl = oTO.CreateObjectCollection
    sFind = ""
    sNew = ""
    '<<< done setting initial values >>>
    '<<< following is a designated marker for a place to jump to later (using GoTo) >>>
StartOfRepeat:
    '<<< all following code may repeat, so clear the 3 collections >>>
    oHLS.Clear
    oFoundDNotesColl.Clear
    '<<< get required inputs from user  - exit if nothing entered >>>
    sFind = InputBox("Entrer le texte a remplacer", "Search...", "")
    If sFind = "" Then Return
    sNew = InputBox("Entrer le texte de remplacement", "...and replace", "")
    If sNew = "" Then Return
    '<<< conduct searches >>>
    FindReplace(False) 'False means SearchOnly, no Replace
    '<<< inspect findings, react appropriately >>>
    If oHLS.Count > 0 Then
        ' Count the occurrences found
        Dim occurrencesCount As Integer = oHLS.Count
        Dim oAns As DialogResult = MessageBox.Show("Il y a " & occurrencesCount & " occurrence(s) trouvée(s)." & vbCrLf & _ 
        "Les textes surlignés seront remplacés." & vbCrLf & _ 
        "Procéder aux remplacements ? [Oui]" & vbCrLf & _ 
        "Enlever certains textes du remplacement ? [Non]" & vbCrLf & _ 
        "Annuler la fonction ? [Annuler]", "Textes trouvés", _ 
        MessageBoxButtons.YesNoCancel, MessageBoxIcon.Question, MessageBoxDefaultButton.Button2)
        If oAns = DialogResult.Cancel Then
            GoTo MaybeFinished
        ElseIf oAns = DialogResult.Yes Then
            FindReplace(True) 'True means do Replace process
        ElseIf oAns = DialogResult.No Then
            RemoveSelectedFromEditGroup
            FindReplace(True) 'True means do Replace process
        End If
    End If
    
    '<<< Demander si appliquer à toutes les feuilles >>>
    ' Calculez les occurrences par feuille
    Dim occurrencesPerSheet As String = CountOccurrencesPerSheet()

    ' Affichez le nombre d'occurrences par feuille dans la boîte de dialogue
    Dim oApplyAll As DialogResult = MessageBox.Show("Occurrence(s) à remplacer par feuille:" & vbCrLf & occurrencesPerSheet & _ 
    vbCrLf & "Appliquer les remplacements à toutes les feuilles ?", _ 
    "Partout ?", MessageBoxButtons.YesNo, _ 
    MessageBoxIcon.Question, MessageBoxDefaultButton.Button2)
    
MaybeFinished:
    If oApplyAll = DialogResult.Yes Then
        ApplyToAllSheets
    End If

    ' Relancer la fonction ? (Placé tout à la fin)
    Dim oAgain As DialogResult = MessageBox.Show("Relancer la fonction? [Oui]" & vbCrLf & "Ou sortir de la fonction? [Non]", "Encore ?", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button2)
    If oAgain = DialogResult.Yes Then GoTo StartOfRepeat
End Sub

'declare variables here that all routines will need access to
Dim oDNotes As Inventor.DrawingNotes
Dim oTO As TransientObjects
Dim oHLS As Inventor.HighlightSet
Dim oFoundDNotesColl As ObjectCollection
Dim sFind As String
Dim sNew As String

Sub FindReplace(ByVal bReplace As Boolean)
    If bReplace = False Then
        If oDNotes.Count > 0 Then
            oFoundDNotesColl.Clear
            For Each oDNote As Inventor.DrawingNote In oDNotes
                If oDNote.FormattedText.Contains(sFind) Then
                    oFoundDNotesColl.Add(oDNote)
                End If
            Next
            oHLS.Clear
            Try : oHLS.AddMultipleItems(oFoundDNotesColl) : Catch : End Try
        End If
    Else
        If oFoundDNotesColl.Count > 0 Then
            For Each oDNote As Inventor.DrawingNote In oFoundDNotesColl
                Try : oDNote.FormattedText = oDNote.FormattedText.Replace(sFind, sNew) : Catch : End Try
                Try : oFoundDNotesColl.RemoveByObject(oDNote) : Catch : End Try
                Try : oHLS.Remove(oDNote) : Catch : End Try
            Next
        End If
    End If
End Sub

Sub RemoveSelectedFromEditGroup()
    Dim oSelDNote As DrawingNote = Nothing
    Dim oFilter As SelectionFilterEnum = SelectionFilterEnum.kDrawingNoteFilter
    Dim sPrompt As String = "Selectionner le texte à enlever de l'édition" & vbCrLf & "Pour sortir de la sélection, appuyer sur échap"
    Do
        oSelDNote = Nothing
        oSelDNote = ThisApplication.CommandManager.Pick(oFilter, sPrompt)
        If oSelDNote Is Nothing Then Exit Do
        If oFoundDNotesColl.Count > 0 Then
            For Each oDNote As DrawingNote In oFoundDNotesColl
                If oDNote Is oSelDNote Then oFoundDNotesColl.RemoveByObject(oDNote)
            Next
            Try : oHLS.Clear : oHLS.AddMultipleItems(oFoundDNotesColl) : Catch : End Try
        End If
    Loop Until oSelDNote Is Nothing
End Sub

' Calculez les occurrences par feuille
Function CountOccurrencesPerSheet() As String
    Dim oDDoc As DrawingDocument = ThisDoc.Document
    Dim occurrencesPerSheet As String = ""
    Dim totalOccurrences As Integer = 0

    ' Parcourir chaque feuille et compter les occurrences
    For Each oSheet As Sheet In oDDoc.Sheets
        Dim sheetOccurrences As Integer = 0
        If oSheet IsNot oDDoc.ActiveSheet Then ' Éviter de refaire sur la feuille actuelle
            Dim oDNotes As DrawingNotes = oSheet.DrawingNotes
            For Each oDNote As DrawingNote In oDNotes
                If oDNote.FormattedText.Contains(sFind) Then
                    sheetOccurrences += 1
                End If
            Next
        End If
        ' Ajoutez le nombre d'occurrences pour cette feuille
        occurrencesPerSheet &= oSheet.Name & ": " & sheetOccurrences & " occurrences" & vbCrLf
        totalOccurrences += sheetOccurrences
    Next

    ' Ajoutez le total global
    occurrencesPerSheet &= vbCrLf & "Total : " & totalOccurrences & " occurrences"
    
    Return occurrencesPerSheet
End Function

Sub ApplyToAllSheets()
    Dim oDDoc As DrawingDocument = ThisDoc.Document
    Dim totalOccurrences As Integer = 0
    
    ' Parcourir chaque feuille et effectuer le remplacement
    For Each oSheet As Sheet In oDDoc.Sheets
        If oSheet IsNot oDDoc.ActiveSheet Then ' Éviter de refaire sur la feuille actuelle
            Dim oDNotes As DrawingNotes = oSheet.DrawingNotes
            For Each oDNote As DrawingNote In oDNotes
                If oDNote.FormattedText.Contains(sFind) Then
                    totalOccurrences += 1
                    Try
                        oDNote.FormattedText = oDNote.FormattedText.Replace(sFind, sNew)
                    Catch
                    End Try
                End If
            Next
        End If
    Next
    
    MessageBox.Show("Remplacement effectué sur toutes les feuilles. Total d'occurrences remplacées: " & totalOccurrences, "Terminé", MessageBoxButtons.OK, MessageBoxIcon.Information)
End Sub