Hier die 1. Möglichkeit – Replace über StartCommand

Vorteile: native Replace-Funktion von Catia mit allen ihren Möglichkeiten wird genutzt

Nachteil: Api-Funktionen werden genutzt, dadurch nicht ganz so stabil und langsamer

Folgenden Code bitte am Anfang eines öffentlichen Moduls (also z.B. nicht innerhalb einer UserForm):

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (Byval lpClassName As String, Byval lpWindowName As String) As Long

Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (Byval hwnd As Long, Byval lpClassName As String, Byval nMaxCount As Long) As Long

Public Declare Function EnumChildWindows Lib "user32" (Byval hWndParent As Long, Byval lpEnumFunc As Long, Byval lParam As Long) As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (Byval hwnd As Long, Byval wMsg As Long, Byval wParam As Long, Byval lParam As String) As Long

Public Declare Sub Sleep Lib "kernel32" (Byval dwMilliseconds As Long)

Public Const WM_GETTEXT = &HD

Public Const BM_CLICK = &HF5&

Public O_hwnd As Long

Public C_hwnd As Long

Folgende Funktionen ebenfalls in eine öffentliches Modul:

Public Function FindButtonCheck(ByVal hChild As Long, ByVal lParam As Long) As Long

    Dim iClass As String
    Dim iText As String
    Dim j As Integer
   
    'find all subelements of window
    iClass = Space(256)
    j = GetClassName(hChild, iClass, 63)
    iClass = Left(iClass, j)
    iText = Space(256)
    j = SendMessage(hChild, WM_GETTEXT, 255, iText)
    iText = Left(iText, j)

   
    If InStr(1, iText, "Delete") > 0 Then  'test whether Checkbox or not
        O_hwnd = hChild
        SendMessage O_hwnd, BM_CLICK, 0, 0
    End If
   
    FindButtonCheck = 1
   
End Function

Public Function FindButtonOK(ByVal hChild As Long, ByVal lParam As Long) As Long
    
   Dim iClass As String
   Dim iText As String
   Dim j As Integer
   
    'find all subelements of window
    iClass = Space(256)
    j = GetClassName(hChild, iClass, 63)
    iClass = Left(iClass, j)
    iText = Space(256)
    j = SendMessage(hChild, WM_GETTEXT, 255, iText)
    iText = Left(iText, j)

    If iText = "OK" Then 'test whether OK-Button or not 
    O_hwnd = hChild SendMessage O_hwnd, BM_CLICK, 0, 0 'click Button 
    End If 
   
    FindButtonOK = 1 

End Function

Hier nun die eigentlich Routine, mit der das Replace aufgerufen wird
Der Aufruf benötigt 3 Parameter:
1. ElementToReplace [Object] – Element welches replaced werden soll
2. ReplaceWith [Object] – Element welches Element ElementToReplace ersetzt
3. Delete [Boolean] – legt fest ob ersetztes Element gelöscht wird (true) oder nicht (false)

Sub ElementReplace(ElementToReplace As Object, ReplaceWith As Object, Delete As Boolean)

    'ElementToReplace selektieren
    MySelection.Clear
    MySelection.Add ElementToReplace

    'Replacebefehl starten
    CATIA.StartCommand "CATReplaceHdr"
    CATIA.RefreshDisplay = True

    'wait for window open
    Do While FensterObjekt = 0
        Sleep (500)
        FensterObjekt = FindWindow(vbNullString, "Replace")
    Loop

    'select Element "ReplaceWith"
    MySelection.Clear
    MySelection.Add ReplaceWith
    MySelection.Search "Name='" & ReplaceWith.Name & "' ,sel"
    Sleep (200)
    
    ' if exclusive parents should be deleted - select checkbox
    If Delete = True Then
        EnumChildWindows FensterObjekt, AddressOf FindButtonCheck, 0
        Sleep (200)
    End If
    
    z = 0 'avoid endless loop
    Do While FensterObjekt <> 0 And z < 10 'wait for window closed or 5 seconds past
        z = z + 1
        EnumChildWindows FensterObjekt, AddressOf FindButtonOK, 0 'OK-Button druecken
        Sleep (500)
        FensterObjekt = FindWindow(vbNullString, "Replace")
    Loop

End Sub

Beispiel zum Aufruf der Procedur:

   'change element "ElementToReplace" into object
    Dim MyObject_01 As Object
    Set MyObject_01 = Element01
    
    'change element "ReplaceWith" into object
    Dim MyObject_02 As Object
    Set MyObject_02 = Element02
    
    'call procedure

    ElementReplace MyObject_01, MyObject_02, True

---