I have tried to combine a few codes and came up with something workable when running it from VB editor but not when it run in CATIA V5 itself, it always freeze up.
I did use some codes from [URL unfurl="true"]https://scripts4all.eu/graph-tree-reordering-vba/[/url] and thread560-416671
Need some enlightenment on why does it freezes up when it runs via CATIA V5 R21
I did use some codes from [URL unfurl="true"]https://scripts4all.eu/graph-tree-reordering-vba/[/url] and thread560-416671
Need some enlightenment on why does it freezes up when it runs via CATIA V5 R21
Code:
Option Explicit
Dim selectProducts As Products
Dim Excel As Object
Dim Item As Product
Dim a, b, d, e As Integer
Dim x, m, g, c As String
Dim z, p, y As Integer
Dim save As Variant
Dim prodCnt, position As Integer
Dim continue As Integer
Dim CATIA, doc, prod, sel
Dim winAutomation As CUIAutomation
Dim desktop As IUIAutomationElement
Dim allWindowsCond As IUIAutomationCondition
Dim childs As IUIAutomationElementArray
Dim i As Long, currChild As IUIAutomationElement
Dim catiaWindow As IUIAutomationElement
Dim graphWinCond As IUIAutomationCondition
Dim graphWin As IUIAutomationElement
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub CATMain()
save = MsgBox("Did you save your file before using macro?", vbYesNo)
If save = 7 Then GoTo 1
Set CATIA = GetObject(, "CATIA.Application") ' get CATIA Application
Set doc = CATIA.ActiveDocument
Set prod = doc.Product
Set sel = doc.Selection
Set winAutomation = New CUIAutomation
' get reference to the root element (desktop)
Set desktop = winAutomation.GetRootElement
' retrieves a predefined condition that selects all elements
Set allWindowsCond = winAutomation.CreateTrueCondition
' find all elements & put them into element array
Set childs = desktop.FindAll(TreeScope_Children, allWindowsCond)
' select top product in a CATIA tree
sel.Clear
sel.Add prod
On Error GoTo 3
Set selectProducts = sel.Item2(1).Value.Products
'Launch Excel
Set Excel = CreateObject("Excel.Application")
Excel.Visible = True
Excel.workbooks.Add
'Headers
Excel.cells(1, 1) = "Part Number"
Excel.cells(1, 2) = "NUMBERING"
Excel.cells(1, 3) = "Instance Name"
Excel.cells(1, 4) = "ORDER"
Excel.Range("A1, D1").Font.Bold = True
Excel.cells(1, 4).Interior.ColorIndex = 15
'Product counts(Num of products)
prodCnt = prod.Products.Count
On Error Resume Next
'Input values into excel
x = 1
g = 2
Do While x < prodCnt + 1
'list down part number, instance num and initial position
Set Item = selectProducts.Item(x)
'initial list
Excel.cells(g, 1) = Item.PartNumber
Excel.cells(g, 3) = Item.Name
Excel.cells(g, 4) = x
Excel.cells(g, 4).Interior.ColorIndex = 15
Excel.Worksheets("Sheet1").Range("A:D").Columns.AutoFit
a = Len(Item.PartNumber) 'xxxx
b = Len(Item.Name) 'xxxx.xxx
c = Right(Item.Name, b - a - 1) 'instance number
d = prodCnt
e = Len(d)
Excel.cells(g, 2) = Item.PartNumber & "."
Do While e - Len(c) > 0
Excel.cells(g, 2) = Excel.cells(g, 2) & "0"
e = e - 1
Loop
Excel.cells(g, 2) = Excel.cells(g, 2) & c
g = g + 1
x = x + 1
Loop
Excel.ScreenUpdating = True
'Sorting to alphabetical order
Excel.Worksheets("Sheet1").Range("A:D").Sort key1:=Excel.Range("B2"), Header:=1
'txtbox to continue or end macro
Dim closeExcel As Variant
closeExcel = MsgBox("Would you like to close Excel? Press No if Continuing.", vbYesNo)
If closeExcel = vbYes Then
Close Excel
Excel.ActiveWorkbook.Close SaveChanges:=False
Excel.Quit
GoTo 1
End If
'end of excel
'm is going to be the number for the row in excel
'p is going to be the number for the list in product tree
m = 2
Do While m < prod.Products.Count + 2
p = 0
Do While p < prod.Products.Count
Set Item = selectProducts.Item(p + 1)
'if item instance name is = to name in excel cell then exit loop and proceed to call
If Item.Name = Excel.cells(m, 3) Then
Exit Do
End If
'p+1 to increase p value by one for each loop
p = p + 1
Loop
Call CATOrder1
Call CATOrder2
'm+1 to increase p value by one for each loop
m = m + 1
Loop
Call CATOkay
GoTo 1
3: MsgBox "Select a product before running macro."
Excel.ActiveWorkbook.Close SaveChanges:=False
Excel.Quit
1:
Close Excel
Excel.ActiveWorkbook.Close SaveChanges:=False
Excel.Quit
End Sub
Sub CATOrder1()
If m = 2 Then
' select top product in a CATIA tree
sel.Clear
sel.Add prod
CATOpen
End If
Dim winAutomation As CUIAutomation
Set winAutomation = New CUIAutomation
Dim desktop As IUIAutomationElement
' get reference to the root element (desktop)
Set desktop = winAutomation.GetRootElement
Dim allWindowsCond As IUIAutomationCondition
' retrieves a predefined condition that selects all elements
Set allWindowsCond = winAutomation.CreateTrueCondition
Dim childs As IUIAutomationElementArray
' find all elements & put them into element array
Set childs = desktop.FindAll(TreeScope_Children, allWindowsCond)
Dim i As Long, currChild As IUIAutomationElement
Dim catiaWindow As IUIAutomationElement
' loop through all element and find CATIA by window name which contains "CATIA V5" string
For i = 0 To childs.Length - 1
Set currChild = childs.GetElement(i)
If InStr(currChild.CurrentName, "CATIA V5") Then
Set catiaWindow = currChild ' set main catia window
End If
'Debug.Print currChild.CurrentName, currChild.CurrentClassName
Next
Dim graphWinCond As IUIAutomationCondition
Set graphWinCond = winAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Graph tree reordering")
Dim graphWin As IUIAutomationElement
'wait for Graph window to open and get it
Do
Set graphWin = catiaWindow.FindFirst(TreeScope_Children, graphWinCond)
'do not freeze application in case of infinite loop
DoEvents
Loop While graphWin Is Nothing
'Focus on the graph reorder window
graphWin.SetFocus
'tab key input to change from "OK" to Listbox
SendKeys "{TAB 3}", 0.2
Sleep 10
graphWin.SetFocus
'move selection back up to top
For y = 0 To prod.Products.Count - 2
SendKeys "{UP}", 0.2
Next
Sleep 10
graphWin.SetFocus
'p-1 number of down input to select the target
For y = 0 To p - 1
SendKeys "{DOWN}", 0.2
Next
Sleep 10
End Sub
Sub CATOrder2()
Dim winAutomation As CUIAutomation
Set winAutomation = New CUIAutomation
Dim desktop As IUIAutomationElement
' get reference to the root element (desktop)
Set desktop = winAutomation.GetRootElement
Dim allWindowsCond As IUIAutomationCondition
' retrieves a predefined condition that selects all elements
Set allWindowsCond = winAutomation.CreateTrueCondition
Dim childs As IUIAutomationElementArray
' find all elements & put them into element array
Set childs = desktop.FindAll(TreeScope_Children, allWindowsCond)
Dim i As Long, currChild As IUIAutomationElement
Dim catiaWindow As IUIAutomationElement
' loop through all element and find CATIA by window name which contains "CATIA V5" string
For i = 0 To childs.Length - 1
Set currChild = childs.GetElement(i)
If InStr(currChild.CurrentName, "CATIA V5") Then
Set catiaWindow = currChild ' set main catia window
End If
' Debug.Print currChild.CurrentName, currChild.CurrentClassName
Next
Dim graphWinCond As IUIAutomationCondition
Set graphWinCond = winAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Graph tree reordering")
Dim graphWin As IUIAutomationElement
'wait for Graph window to open and get it
Do
Set graphWin = catiaWindow.FindFirst(TreeScope_Children, graphWinCond)
' do not freeze application in case of infinite loop
DoEvents
Loop While graphWin Is Nothing
' get OK button
Dim btnOKCondition As IUIAutomationCondition, btnOk As IUIAutomationElement
Set btnOKCondition = winAutomation.CreatePropertyCondition(UIA_NamePropertyId, "OK")
Set btnOk = graphWin.FindFirst(TreeScope_Children, btnOKCondition)
' get Move Down button
Dim btnMoveDownCondition As IUIAutomationCondition, btnMoveDown As IUIAutomationElement
Set btnMoveDownCondition = winAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Move Down")
Set btnMoveDown = graphWin.FindFirst(TreeScope_Descendants, btnMoveDownCondition)
' get Move Up button
Dim btnMoveUpCondition As IUIAutomationCondition, btnMoveUp As IUIAutomationElement
Set btnMoveUpCondition = winAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Move Up")
Set btnMoveUp = graphWin.FindFirst(TreeScope_Descendants, btnMoveUpCondition)
' get Apply button
Dim btnApplyCondition As IUIAutomationCondition, btnApply As IUIAutomationElement
Set btnApplyCondition = winAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Apply")
Set btnApply = graphWin.FindFirst(TreeScope_Descendants, btnApplyCondition)
' control pattern definition (button click)
Dim patApply As IUIAutomationInvokePattern, patMoveUp As IUIAutomationInvokePattern, patMoveDown As IUIAutomationInvokePattern, patOK As IUIAutomationInvokePattern
Set patMoveUp = btnMoveUp.GetCurrentPattern(UIA_InvokePatternId)
Set patMoveDown = btnMoveDown.GetCurrentPattern(UIA_InvokePatternId)
Set patOK = btnOk.GetCurrentPattern(UIA_InvokePatternId)
Set patApply = btnApply.GetCurrentPattern(UIA_InvokePatternId)
'to invoke the number of button click down to bottom of list
For i = 1 To prod.Products.Count - p
' button click events invoked
patMoveDown.Invoke
Next
'Press OK
patApply.Invoke
Sleep 10
'Focus on the graph reorder window
graphWin.SetFocus
'tab key input to change from "Apply" to "OK"
SendKeys "+{TAB}", 0.5
Sleep 10
End Sub
Sub CATOkay()
Dim winAutomation As CUIAutomation
Set winAutomation = New CUIAutomation
Dim desktop As IUIAutomationElement
' get reference to the root element (desktop)
Set desktop = winAutomation.GetRootElement
Dim allWindowsCond As IUIAutomationCondition
' retrieves a predefined condition that selects all elements
Set allWindowsCond = winAutomation.CreateTrueCondition
Dim childs As IUIAutomationElementArray
' find all elements & put them into element array
Set childs = desktop.FindAll(TreeScope_Children, allWindowsCond)
Dim i As Long, currChild As IUIAutomationElement
Dim catiaWindow As IUIAutomationElement
' loop through all element and find CATIA by window name which contains "CATIA V5" string
For i = 0 To childs.Length - 1
Set currChild = childs.GetElement(i)
If InStr(currChild.CurrentName, "CATIA V5") Then
Set catiaWindow = currChild ' set main catia window
End If
'Debug.Print currChild.CurrentName, currChild.CurrentClassName
Next
Dim graphWinCond As IUIAutomationCondition
Set graphWinCond = winAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Graph tree reordering")
Dim graphWin As IUIAutomationElement
'wait for Graph window to open and get it
Do
Set graphWin = catiaWindow.FindFirst(TreeScope_Children, graphWinCond)
' do not freeze application in case of infinite loop
DoEvents
Loop While graphWin Is Nothing
' get OK button
Dim btnOKCondition As IUIAutomationCondition, btnOk As IUIAutomationElement
Set btnOKCondition = winAutomation.CreatePropertyCondition(UIA_NamePropertyId, "OK")
Set btnOk = graphWin.FindFirst(TreeScope_Children, btnOKCondition)
Dim patOK As IUIAutomationInvokePattern
Set patOK = btnOk.GetCurrentPattern(UIA_InvokePatternId)
'Focus on the graph reorder window
graphWin.SetFocus
'tab key input to change from "OK" to Listbox
patOK.Invoke
Sleep 10
End Sub
Sub CATOpen()
' launch "Graph tree reordering" command
CATIA.StartCommand "Graph tree reordering"
CATIA.RefreshDisplay = True
Dim graphopen As Integer
4:
graphopen = MsgBox("Is the graph reorder open?", vbYesNo)
If graphopen = 7 Then
GoTo 4
End If
End Sub