Suchen und Ersetzen mehrerer Werte in VBA

Question

Ich versuche, diese Aufgabe in Microstation mit VBA durchzuführen. Ich möchte es verwenden, um mehrere Zahlen in der Zeichnung zu finden und zu ersetzen.

Ich kenne das Programm im Allgemeinen, aber ich habe Schwierigkeiten, dies zusammen zu setzen. Ich habe 2 Variablen.

Vielen Dank im Voraus und Entschuldigung für den schlecht geschriebenen Code. Gewöhne dich einfach an VBA!

Sub main() 
    Dim Find_text() As string = split ("150 160 170 180 190 200 210 220") 
    Dim Replace_text() As string = split ("15 16 17 18 19 20 21 22") 

    For i As Integer = 0 To Find_text.length - 1 
     'I will write my find and replace code here 
    Next 
End Sub 

Answer 1

Sie Funktion InStr() verwenden können Replace() String in String und Funktion zu finden gefunden Zeichenfolge ersetzen mit replace_string

Sub main() 

Dim Find_text() As String 
Dim Replace_text() As String 

Dim str As String 

str = "test 150 test 160 test 170 test 200 test 220" 

Find_text = Split("150 160 170 180 190 200 210 220") 
Replace_text = Split("15 16 17 18 19 20 21 22") 

For i = 0 To UBound(Find_text) 
    For j = 0 To UBound(Replace_text) 
     If InStr(str, Find_text(j)) > 0 Then 
      str = Replace(str, Find_text(j), Replace_text(j)) 
     End If 
    Next 
Next 

MsgBox str 

End Sub 

Answer 2

Der Trick ist, die Microstation-API verwenden, um eine Liste von Elementen zu erhalten auf den Betrieb . Sie können .GetSelectedElements oder .Scan verwenden, je nachdem, wie Ihr Werkzeug arbeiten soll. Wie du gesagt hast, du gewöhnst dich nur an vba. Ich habe den unten stehenden Code stark kommentiert.

Andere Fehler enthalten Textelemente und Textknoten (mehrzeiliger Text) müssen anders gehandhabt werden, und vergessen Sie nicht das Element .Rewrite, nachdem Sie es geändert haben.

Option Explicit 

Sub replaceText() 


    Dim findText() As String 
    Dim replaceText() As String 

    'set find and replace 
    findText = Split("10 20 30 40 50") 
    replaceText = Split("a b c d e") 

    'guard against unequal length searches 
    If UBound(findText) <> UBound(replaceText) Then 
     MsgBox "Find and replace are not equal lengths" 
     Exit Sub 
    End If 

    ' Scan Criteria are needed when looking for elements in a model 
    ' Set up scan criteria to only include text types 
    Dim eSC As New ElementScanCriteria 
    eSC.ExcludeAllTypes 
    eSC.IncludeType msdElementTypeText  'text element 
    eSC.IncludeType msdElementTypeTextNode 'multiple line text element 

    Dim model As ModelReference 
    Set model = ActiveModelReference 

    ' if you need to loop through multiple models you could use this 
    ' Set model = ActiveDesignFile.Models(i) 

    ' Element Enumerator is a list of elements 
    Dim elements As ElementEnumerator 

    'scan active model for text 
    Set elements = model.Scan(eSC) 

    ' the elements could also be retrieved using 
    ' Set elements = model.GetSelectedElements 

    ' iterate through element set 
    ' If there is another element in the list then 
    ' MoveNext sets elements.Current to the next element and returns true 
    ' otherwise it returns false and the loop exits. 
    Do While elements.MoveNext 

     Dim i As Integer 
     Dim textNodeI As Integer 
     Dim tempText As String 

     ' elements.Current is a generic element 
     ' we need to check its type to handle it correctly 
     If elements.Current.IsTextElement Then 

      ' access the generic element using the text element interface 
      With elements.Current.AsTextElement 

       '.text here refers to elements.Current.AsTextElement.text as specified by the With statement 
       tempText = .text 

       'split is 0 indexed 
       For i = 0 To UBound(findText) 
        tempText = Replace(tempText, findText(i), replaceText(i)) 
       Next 

       'set the elements text to the replaced text 
       .text = tempText 

       'rewrite the text element to the model 
       .Rewrite 
      End With 

     ElseIf elements.Current.IsTextNodeElement Then 
      With elements.Current.AsTextNodeElement 

       ' TextNodes have an array of TextLines (1 indexed) 
       For textNodeI = 1 To .TextLinesCount 

        'same as for text but for each line of node 
        tempText = .TextLine(textNodeI) 
        For i = 0 To UBound(findText) 
         tempText = Replace(tempText, findText(i), replaceText(i)) 
        Next 
        .TextLine(textNodeI) = tempText 

       Next 

       ' Rewrite the text node after you have replaced each line. 
       .Rewrite 
      End With 
     End If 
    Loop 

End Sub