Catia V5 Macro - Reorder Body in CATPart

Catia V5 Macro - Reorder Body in CATPart

Please read Liability Disclaimer and License Agreement CAREFULLY

Create a module called "iM" and paste the following code in it

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindow Lib "User" (ByVal hWnd, ByVal wCmd) As Integer
Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Integer) As Integer
Public Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) 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 FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) 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 SW_HIDE = 0
Public Const SW_SHOW = 5
Public Const WM_GETTEXT = &HD
Public Const WM_KEYUP = &H101
Public Const WM_KEYDOWN = &H100
Public Const VK_UP = &H26
Public Const VK_DOWN = &H28
Public Const BM_CLICK = &HF5&
Public Const LB_GETCOUNT = &H18B
Public Const LB_GETTEXT = &H189
Public Const LB_GETTEXTLEN = &H18A
Public Const LB_SETCURSEL = &H186
Public F_hwnd As Long    'Forma
Public L_hwnd As Long    'Lista
Public O_hwnd As Long    'OK
Public C_hwnd As Long    'Cancel
Public U_hwnd As Long    'Move Up
Public D_hwnd As Long    'Move Down
Public Restrict As New Collection
Public PrtDoc 'As PartDocument
Public Sel 'As Selection
Sub CATMain()
    Restrict.Add "xy plane", "xy plane"
    Restrict.Add "yz plane", "yz plane"
    Restrict.Add "zx plane", "zx plane"
    Restrict.Add "Axis Systems", "Axis Systems"
    Restrict.Add "Parameters", "Parameters"
    Restrict.Add "Relations", "Relations"
    Set PrtDoc = CATIA.ActiveDocument
    Set Sel = PrtDoc.Selection
    Sel.Clear
    Sel.Add PrtDoc.Part
    CATIA.StartCommand ("Reorder Children")
    Sleep 100
    GVI_Reorder.Show
End Sub
Public Function EnumChildWindow(ByVal hChild As Long, ByVal lParam As Long) As Long
    Dim iClass As String
    Dim iText As String
    Dim j As Integer
    iClass = VBA.Space(256)
    j = GetClassName(hChild, iClass, 63)
    iClass = VBA.Left(iClass, j)
    iText = VBA.Space(256)
    j = SendMessage(hChild, WM_GETTEXT, 255, iText)
    iText = VBA.Left(iText, j)
    Select Case iText
    Case "OK"
        O_hwnd = hChild
    Case "Cancel"
        C_hwnd = hChild
    Case "ListChildren"
        L_hwnd = hChild
    Case "Move Up"
        U_hwnd = hChild
    Case "Move Down"
        D_hwnd = hChild
    End Select
    EnumChildWindow = 1  ' Continua enumerarea
End Function

Create a form, name it "GVI_Reorder", and add the following controls:

1. ListBox - iList

2. CommandButton - OK

3. CommandButton - Cancel

4. CommandButton - Up

5. CommandButton - Down

Add the following code in the VBA form

Option Explicit
Dim TmpA As String
Dim TmpB As String
Dim Idx As Integer
Dim q As Long
Dim iSender As String
Public Sub UserForm_Initialize()
    Dim lpClassName As String
    Dim lngTextLength As String
    Dim nMaxCount As Long
    Dim ClsName As String
    Dim PrtDoc 'As PartDocument
    Dim Sel 'As Selection
    Set PrtDoc = CATIA.ActiveDocument
    Set Sel = PrtDoc.Selection
    Sel.Add PrtDoc.Part
    F_hwnd = FindWindow(vbNullString, "Reorder Children")
    ShowWindow F_hwnd, SW_HIDE
    EnumChildWindows F_hwnd, AddressOf EnumChildWindow, 0
    Call GetList
End Sub
Private Sub iList_Click()
    If Not IsItemOK Then Exit Sub
End Sub
Public Sub OK_Click()
    iSender = "O"
    Unload Me
End Sub
Public Sub Cancel_Click()
    Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    ShowWindow F_hwnd, SW_SHOW
    Select Case iSender
    Case "O"
        SendMessage O_hwnd, BM_CLICK, 0, 0
    Case Else
        SendMessage C_hwnd, BM_CLICK, 0, 0
    End Select
    Sel.Clear
    Set Sel = Nothing
    Set PrtDoc = Nothing
End Sub
Public Sub Up_Click()
    If Not IsItemOK Then Exit Sub
    Idx = iList.ListIndex
    TmpA = iList.Text
    TmpB = iList.List(Idx - 1)
    iList.List(Idx) = TmpB
    iList.List(Idx - 1) = TmpA
    SetFocus L_hwnd
    q = SendMessage(L_hwnd, LB_SETCURSEL, ByVal CLng(0), ByVal CLng(0))
    'q = SendMessage(L_hwnd, WM_KEYDOWN, BM_CLICK, &H510001)
    'q = SendMessage(L_hwnd, WM_KEYUP, BM_CLICK, &HC0510001)
    q = SendMessage(L_hwnd, LB_SETCURSEL, ByVal CLng(Idx), ByVal CLng(0))
    q = SendMessage(L_hwnd, WM_KEYDOWN, BM_CLICK, &H510001)
    'q = SendMessage(L_hwnd, WM_KEYUP, BM_CLICK, &HC0510001)
    q = SendMessage(U_hwnd, BM_CLICK, 0, ByVal 0&)
    iList.ListIndex = Idx - 1
    DoEvents
End Sub
Public Sub Down_Click()
    If Not IsItemOK Then Exit Sub
    Idx = iList.ListIndex
    TmpA = iList.Text
    TmpB = iList.List(Idx + 1)
    iList.List(Idx) = TmpB
    iList.List(Idx + 1) = TmpA
    SetFocus L_hwnd
    q = SendMessage(L_hwnd, LB_SETCURSEL, ByVal CLng(0), ByVal CLng(0))
    'q = SendMessage(L_hwnd, WM_KEYDOWN, BM_CLICK, &H510001)
    'q = SendMessage(L_hwnd, WM_KEYUP, BM_CLICK, &HC0510001)
    q = SendMessage(L_hwnd, LB_SETCURSEL, ByVal CLng(Idx), ByVal CLng(0))
    q = SendMessage(L_hwnd, WM_KEYDOWN, BM_CLICK, &H510001)
    'q = SendMessage(L_hwnd, WM_KEYUP, BM_CLICK, &HC0510001)
    q = SendMessage(D_hwnd, BM_CLICK, 0, ByVal 0&)
    iList.ListIndex = Idx + 1
    q = SendMessage(L_hwnd, LB_SETCURSEL, ByVal CLng(-1), ByVal CLng(0))
    DoEvents
End Sub
Public Sub GetList()
    Dim No As Long       ' cate bucati sunt in listbox
    Dim CrtItm As Long         ' item-ul curent
    Dim ItmTxt As String  ' textul item-ului
    Dim TxtLen As Long     ' lungimea textului
    No = SendMessage(L_hwnd, LB_GETCOUNT, ByVal CLng(0), ByVal CLng(0))
    For CrtItm = 0 To No - 1
        TxtLen = SendMessage(L_hwnd, LB_GETTEXTLEN, ByVal CrtItm, ByVal CLng(0))
        ItmTxt = VBA.Space(TxtLen) & vbNullChar
        TxtLen = SendMessage(L_hwnd, LB_GETTEXT, ByVal CrtItm, ByVal ItmTxt)
        ItmTxt = Left(ItmTxt, TxtLen)
        iList.AddItem ItmTxt    'bag itemurile in lista
    Next
End Sub
Public Function IsItemOK() As Boolean
    On Error GoTo iHandle
    Select Case iList.ListIndex
    Case -1
        Up.Enabled = False
        Down.Enabled = False
        MsgBox "No Item selected"
        IsItemOK = False
        Exit Function
    Case Is = iList.ListCount - 1
        Down.Enabled = False
        IsItemOK = True
    Case Else
        Restrict.Add iList.Text, iList.Text
        Restrict.Remove iList.Text
        Up.Enabled = True
        Down.Enabled = True
        IsItemOK = True
    End Select
iHandle:
    If Err.Number <> 0 Then
        MsgBox iList.Text & ": You can't reorder this feature"
        Err.Clear
        Up.Enabled = False
        Down.Enabled = False
        IsItemOK = False
    End If
End Function