Re-Order CATIA Tree
Re-Order CATIA Tree
(OP)
All,
I am working on a macro to re-order the product tree. I first developed a macro that cuts and pastes the each of the components in the right order. This worked great but has the issue of breaking any drawings that are linked to the components. As far as I know the only way to re-order the tree without breaking links is using the "Graph tree Reorder" command. I have had some success pushing keystrokes (sendkeys) into this command to perform the required re-ordering but I am running into an issue as the model gets larger allowing time for the command to open prior to sending keys is proving difficult. I have tried using "Sub Sleep Lib "kernel32"", Application.Wait (Now + TimeValue("00:00:10")), sending the program into a loop for a set period of time, and CATIA.RefreshDisplay = True. All of these pause the macro, but the command doesn't open while the code is paused. Any ideas?
Public Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
'Declare sleep
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub CATOrder()
Dim selectProducts As Products
Dim Item As Product
Dim i, d, m, k, g As String
Dim prodCnt, pn, currentPos, position, cntr, bs As Integer
Dim continue As Boolean
Dim pastPos() As Integer
Dim timer As Double
On Error GoTo 2
Set selectProducts = CATIA.ActiveDocument.Selection.Item2(1).Value.Products
'Open Excel
Dim Excel As Object
Set Excel = CreateObject("Excel.Application")
Excel.Visible = True
Excel.workbooks.Add
Excel.Cells(1, 1) = "Part Number"
Excel.Cells(1, 2) = "Detail Number"
Excel.Cells(1, 3) = "Instance Name"
Excel.Cells(1, 4) = "ORDER"
Excel.Cells(1, 1).Font.Bold = True
Excel.Cells(1, 2).Font.Bold = True
Excel.Cells(1, 3).Font.Bold = True
Excel.Cells(1, 4).Font.Bold = True
Excel.Cells(1, 4).Interior.ColorIndex = 15
Excel.Cells(1, 1).Borders.LineStyle = xlContinuous
Excel.Cells(1, 2).Borders.LineStyle = xlContinuous
Excel.Cells(1, 3).Borders.LineStyle = xlContinuous
Excel.Cells(1, 3).Borders.LineStyle = xlContinuous
prodCnt = selectProducts.Count
On Error Resume Next
'Input values into excel
i = 1
g = 2
Do While i < prodCnt + 1
Set Item = selectProducts.Item(i)
pn = InStr(Item.PartNumber, "_")
pn = Right(Item.PartNumber, Len(Item.PartNumber) - pn)
pn = Left(pn, Len(pn) - 2)
Excel.Cells(g, 1) = Item.PartNumber
Excel.Cells(g, 2) = pn
Excel.Cells(g, 3) = Item.Name
Excel.Cells(g, 4) = i
Excel.Cells(g, 1).Borders.LineStyle = xlContinuous
Excel.Cells(g, 2).Borders.LineStyle = xlContinuous
Excel.Cells(g, 3).Borders.LineStyle = xlContinuous
Excel.Cells(g, 4).Borders.LineStyle = xlContinuous
Excel.Cells(g, 4).Interior.ColorIndex = 15
g = g + 1
i = i + 1
Loop
'Sort values in Excel
continue = MsgBox("Sort Excel then press 'OK'.", vbOKCancel)
If continue = vbCancel Then
End
End If
CATIA.RefreshDisplay = True
CATIA.StartCommand "Graph tree Reordering"
Sleep 1000
'Application.Wait (Now + TimeValue("00:00:10"))
'timer = Now + 0.0000115
'Do While Now < timer
'bs = bs + 1
'Loop
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
Sleep 50
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Excel.Cells(1, 5) = "i"
Excel.Cells(1, 6) = "position"
Excel.Cells(1, 7) = "d"
Excel.Cells(1, 8) = "m"
Excel.Cells(1, 9) = "cntr"
'Sort tree with Graph tree Reordering
i = 1
Do While i < prodCnt + 1
Excel.Cells(i + 1, 5) = i
position = Excel.Cells(i + 1, 4)
k = i - 2
cntr = 0
Do While k >= 0
If pastPos(k) > position Then
cntr = cntr + 1
End If
k = k - 1
Loop
ReDim Preserve pastPos(i - 1)
pastPos(i - 1) = position
d = position + cntr - i + 1
If i = 1 Then
d = d - 1
End If
m = position + cntr - i
Excel.Cells(i + 1, 9) = cntr
Excel.Cells(i + 1, 6) = position
Excel.Cells(i + 1, 7) = d
Do While d > 0
Call arrowDwn
d = d - 1
Loop
Call tabUp
Excel.Cells(i + 1, 8) = m
Do While m > 0
Call moveUp
m = m - 1
Loop
Call tabDwn
i = i + 1
Sleep 200
Loop
closeExcel = MsgBox("Would you like to close Excel?", vbYesNo)
If closeExcel = vbYes Then
Close Excel
Excel.ActiveWorkbook.Close SaveChanges:=False
Excel.Quit
End If
GoTo 1
2:
MsgBox "Select a product before running macro."
Excel.ActiveWorkbook.Close SaveChanges:=False
Excel.Quit
1:
End Sub
Function moveUp()
Application.SendKeys "~"
End Function
Function arrowDwn()
Application.SendKeys "{DOWN}"
End Function
Function tabUp()
Application.SendKeys "{TAB}"
End Function
Function tabDwn()
Application.SendKeys "+{TAB}"
End Function
I am working on a macro to re-order the product tree. I first developed a macro that cuts and pastes the each of the components in the right order. This worked great but has the issue of breaking any drawings that are linked to the components. As far as I know the only way to re-order the tree without breaking links is using the "Graph tree Reorder" command. I have had some success pushing keystrokes (sendkeys) into this command to perform the required re-ordering but I am running into an issue as the model gets larger allowing time for the command to open prior to sending keys is proving difficult. I have tried using "Sub Sleep Lib "kernel32"", Application.Wait (Now + TimeValue("00:00:10")), sending the program into a loop for a set period of time, and CATIA.RefreshDisplay = True. All of these pause the macro, but the command doesn't open while the code is paused. Any ideas?
Public Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
'Declare sleep
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub CATOrder()
Dim selectProducts As Products
Dim Item As Product
Dim i, d, m, k, g As String
Dim prodCnt, pn, currentPos, position, cntr, bs As Integer
Dim continue As Boolean
Dim pastPos() As Integer
Dim timer As Double
On Error GoTo 2
Set selectProducts = CATIA.ActiveDocument.Selection.Item2(1).Value.Products
'Open Excel
Dim Excel As Object
Set Excel = CreateObject("Excel.Application")
Excel.Visible = True
Excel.workbooks.Add
Excel.Cells(1, 1) = "Part Number"
Excel.Cells(1, 2) = "Detail Number"
Excel.Cells(1, 3) = "Instance Name"
Excel.Cells(1, 4) = "ORDER"
Excel.Cells(1, 1).Font.Bold = True
Excel.Cells(1, 2).Font.Bold = True
Excel.Cells(1, 3).Font.Bold = True
Excel.Cells(1, 4).Font.Bold = True
Excel.Cells(1, 4).Interior.ColorIndex = 15
Excel.Cells(1, 1).Borders.LineStyle = xlContinuous
Excel.Cells(1, 2).Borders.LineStyle = xlContinuous
Excel.Cells(1, 3).Borders.LineStyle = xlContinuous
Excel.Cells(1, 3).Borders.LineStyle = xlContinuous
prodCnt = selectProducts.Count
On Error Resume Next
'Input values into excel
i = 1
g = 2
Do While i < prodCnt + 1
Set Item = selectProducts.Item(i)
pn = InStr(Item.PartNumber, "_")
pn = Right(Item.PartNumber, Len(Item.PartNumber) - pn)
pn = Left(pn, Len(pn) - 2)
Excel.Cells(g, 1) = Item.PartNumber
Excel.Cells(g, 2) = pn
Excel.Cells(g, 3) = Item.Name
Excel.Cells(g, 4) = i
Excel.Cells(g, 1).Borders.LineStyle = xlContinuous
Excel.Cells(g, 2).Borders.LineStyle = xlContinuous
Excel.Cells(g, 3).Borders.LineStyle = xlContinuous
Excel.Cells(g, 4).Borders.LineStyle = xlContinuous
Excel.Cells(g, 4).Interior.ColorIndex = 15
g = g + 1
i = i + 1
Loop
'Sort values in Excel
continue = MsgBox("Sort Excel then press 'OK'.", vbOKCancel)
If continue = vbCancel Then
End
End If
CATIA.RefreshDisplay = True
CATIA.StartCommand "Graph tree Reordering"
Sleep 1000
'Application.Wait (Now + TimeValue("00:00:10"))
'timer = Now + 0.0000115
'Do While Now < timer
'bs = bs + 1
'Loop
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
Sleep 50
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Excel.Cells(1, 5) = "i"
Excel.Cells(1, 6) = "position"
Excel.Cells(1, 7) = "d"
Excel.Cells(1, 8) = "m"
Excel.Cells(1, 9) = "cntr"
'Sort tree with Graph tree Reordering
i = 1
Do While i < prodCnt + 1
Excel.Cells(i + 1, 5) = i
position = Excel.Cells(i + 1, 4)
k = i - 2
cntr = 0
Do While k >= 0
If pastPos(k) > position Then
cntr = cntr + 1
End If
k = k - 1
Loop
ReDim Preserve pastPos(i - 1)
pastPos(i - 1) = position
d = position + cntr - i + 1
If i = 1 Then
d = d - 1
End If
m = position + cntr - i
Excel.Cells(i + 1, 9) = cntr
Excel.Cells(i + 1, 6) = position
Excel.Cells(i + 1, 7) = d
Do While d > 0
Call arrowDwn
d = d - 1
Loop
Call tabUp
Excel.Cells(i + 1, 8) = m
Do While m > 0
Call moveUp
m = m - 1
Loop
Call tabDwn
i = i + 1
Sleep 200
Loop
closeExcel = MsgBox("Would you like to close Excel?", vbYesNo)
If closeExcel = vbYes Then
Close Excel
Excel.ActiveWorkbook.Close SaveChanges:=False
Excel.Quit
End If
GoTo 1
2:
MsgBox "Select a product before running macro."
Excel.ActiveWorkbook.Close SaveChanges:=False
Excel.Quit
1:
End Sub
Function moveUp()
Application.SendKeys "~"
End Function
Function arrowDwn()
Application.SendKeys "{DOWN}"
End Function
Function tabUp()
Application.SendKeys "{TAB}"
End Function
Function tabDwn()
Application.SendKeys "+{TAB}"
End Function





RE: Re-Order CATIA Tree
Drew Mumaw
www.textsketcher.com
www.drewmumaw.com
RE: Re-Order CATIA Tree
Is existing in V6 as it is also 3D text
Regards
Fernando
https://picasaweb.google.com/102257836106335725208 - Romania
https://picasaweb.google.com/103462806772634246699... - EU
RE: Re-Order CATIA Tree
It's about time!
Drew Mumaw
www.textsketcher.com
www.drewmumaw.com
RE: Re-Order CATIA Tree
Can't use V6 so that doesn't really help. It's nice that they added this functionality though.
RE: Re-Order CATIA Tree
Drew Mumaw
www.textsketcher.com
www.drewmumaw.com
RE: Re-Order CATIA Tree
http://scripts4all.eu/smartsort/
It is doing exactly what you are after but much faster and more reliable way through Windows Automation.
Main Features:
- Works in Visualization mode or Design mode
- Perfect for large assemblies (no need to switch to Design mode)
- Constraint links are preserved
- No CUT & PASTE operations and no broken links
- No components renaming
- It uses CATIA native Graph tree reordering feature
Regards,Tesak
http://scripts4all.eu/txtoncurve/ - Text along a curve for Catia V5
RE: Re-Order CATIA Tree
Here is an idea if you hit that wall :)
Of course, the solution is not the "cut&paste" one.
cilici
RE: Re-Order CATIA Tree
Tesak
http://scripts4all.eu/txtoncurve/ - Text along a curve for Catia V5
RE: Re-Order CATIA Tree
Yes, it will soon be available. It is in testing now.
cilici
RE: Re-Order CATIA Tree
RE: Re-Order CATIA Tree
Any help will be appriciated.
Sub CATMain()
CATIA.SystemService.ExecuteProcessus("D:\00_CATia_tool\SmartSort.exe") 'file position
End Sub
RE: Re-Order CATIA Tree
Sub CATMain()
If CATIA.GetWorkbenchId = "Drw" And CATIA.GetWorkbenchId = "DrwBG" Then
MsgBox "Not for drawings.", , "Error"
End
End If
If Len(Dir("C:\Temp\")) = 0 Then
MkDir ("C:\Temp")
End If
runPath = Dir("C:\Temp\SmartSortLoc.txt")
If runPath <> "" Then
Open "C:\Temp\SmartSortLoc.txt" For Input As #1
Line Input #1, runPath
Close #1
End If
Check:
If Dir(runPath & "\") = "" Or runPath = "" Then
runPath = ""
runPath = InputBox("Please input the path to your SmartSort folder e.g. [C:\Users\user.name\Desktop\SmartSort]", "Path")
If runPath = "" Then End
Open "C:\Temp\SmartSortLoc.txt" For Output As #1
Print #1, runPath
Close #1
GoTo Check
End If
Dim apps() As Variant
apps() = AllRunningApps
g = 0
For i = 1 To UBound(apps, 2)
If apps(0, i) = "CNEXT.exe" Then
If g = 0 Then
g = 1
Else
MsgBox "More than one instance of CATIA is running. Please close the other instance of CATIA and try again.", , "Error"
End
End If
End If
Next
If CATIA.GetWorkbenchId <> "Assembly" Then
CATIA.StartWorkbench ("Assembly")
End If
Open runPath & "\AutoPlay.bat" For Output As #1
Print #1, "start /d " & Chr(34) & runPath & Chr(34) & " SmartSort.exe"
Close #1
If Dir(runPath & "\SmartSort.exe") <> "SmartSort.exe" Then
MsgBox "SmartSort.exe was not found. Please make sure that the application is named correctly.", , "Error"
End
End If
Call Shell(runPath & "\AutoPlay.bat", 1)
End Sub
Public Function AllRunningApps() As Variant
Dim strComputer As String
Dim objServices As Object, objProcessSet As Object, Process As Object
Dim oDic As Object, a() As Variant
Set oDic = CreateObject("Scripting.Dictionary")
strComputer = "."
Set objServices = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set objProcessSet = objServices.ExecQuery("SELECT Name, ProcessID FROM Win32_Process", , 48)
ReDim a(1, 0)
a(0, 0) = ""
For Each Process In objProcessSet
If a(0, 0) = "" Then
a(0, 0) = Process.Properties_("Name").Value
a(1, 0) = Process.Properties_("ProcessID").Value
Else
ReDim Preserve a(1, UBound(a, 2) + 1)
a(0, UBound(a, 2)) = Process.Properties_("Name").Value
a(1, UBound(a, 2)) = Process.Properties_("ProcessID").Value
End If
Next
AllRunningApps = a()
End Function
RE: Re-Order CATIA Tree
Here is the full version of the Reorder. The zip's password is 1234.
The minimum protection of the code inside is using an *.exe file.
Feel free to use it or not.
Good luck!
RE: Re-Order CATIA Tree
it is a great tool. well done.
uhm do you have that kind of tool of renaming every part number or instance name? or just deleting part number or instance name?
thanks
RE: Re-Order CATIA Tree
Here is my sorter that I created. It can sort based on Boeing detail number (which is what we do here mostly) or by instance name. I have also included the source file so you can add your own sorting algorithm (you just need to sort the values in the right box).
RE: Re-Order CATIA Tree
indocti discant et ament meminisse periti
RE: Re-Order CATIA Tree
Here is an updated version of Reorder.
https://goo.gl/gvDi9D
It now manages the situations when instances' names are identical except the case (e.g. Part1(Part1.1) versus Part1(PART1.1)).
Please note that the tool is free of use commercially or not.
Any feedback (especially the negative ones) will be appreciated (you can find my email in the file properties).
Calin
RE: Re-Order CATIA Tree
Tiago Figueiredo
Tooling Engineer
Youtube channel:
https://www.youtube.com/channel/UC1qdlBeJJEgMgpPLV...