Hello
I would like to add at the end of my macro that I created, the Gather All feature.
but I can't figure out how to call this function in VBA and use it. not to be found in the API
Does anyone have an idea?
Is there a simplified file that lists all SW functions and how they are in VBA?
Hello
I have (long) looked for this vba function in vain.
To finish with this code which is not what I wanted at all but which works:
'Rassembler l'arbre de création
SendKeys "{ESC}"
SendKeys "+{R}"
And in the shortcuts:
Of course this is a roundabout way since this code only launches a shortcut. Be careful in edit mode this code writes an R in the code!.
So far from optimal but nothing better.
All the other vba code to gather the tree being much too long in time
Example:
'---------------------------------------------------------------------------
' Preconditions:
' 1. Open a part or assembly document.
' 2. Open the Immediate window.
'
' Postconditions:
' 1. Expands all of the FeatureManager design tree nodes.
' 2. Click OK to collapse all nodes.
' 3. Inspect the Immediate window.
'--------------------------------------------------------------------------
Option Explicit
Dim traverseLevel As Integer
Dim expandThis As Boolean
Sub main()
Dim i As Integer
Dim swApp As SldWorks.SldWorks
Dim myModel As SldWorks.ModelDoc2
Dim featureMgr As SldWorks.FeatureManager
Dim rootNode As SldWorks.TreeControlItem
Set swApp = Application.SldWorks
Set myModel = swApp.ActiveDoc
Set featureMgr = myModel.FeatureManager
Set rootNode = featureMgr.GetFeatureTreeRootItem2(swFeatMgrPaneBottom)
expandThis = True
For i = 0 To 1
If Not rootNode Is Nothing Then
Debug.Print
traverseLevel = 0
traverse_node rootNode
End If
expandThis = False
If i = 0 Then
MsgBox "OK to collapse all nodes?"
End If
Next
End Sub
Private Sub traverse_node(node As SldWorks.TreeControlItem)
Dim childNode As SldWorks.TreeControlItem
Dim featureNode As SldWorks.Feature
Dim componentNode As SldWorks.Component2
Dim nodeObjectType As Long
Dim nodeObject As Object
Dim restOfString As String
Dim indent As String
Dim i As Integer
Dim displayNodeInfo As Boolean
Dim compName As String
Dim suppr As Long, supprString As String
Dim vis As Long, visString As String
Dim fixed As Boolean, fixedString As String
Dim componentDoc As Object, docString As String
Dim refConfigName As String
displayNodeInfo = False
nodeObjectType = node.ObjectType
Set nodeObject = node.Object
Select Case nodeObjectType
Case SwConst.swTreeControlItemType_e.swFeatureManagerItem_Feature:
displayNodeInfo = True
If Not nodeObject Is Nothing Then
Set featureNode = nodeObject
restOfString = "[FEATURE: " & featureNode.Name & "]"
Else
restOfString = "[FEATURE: object Null?!]"
End If
Case SwConst.swTreeControlItemType_e.swFeatureManagerItem_Component:
displayNodeInfo = True
If Not nodeObject Is Nothing Then
Set componentNode = nodeObject
compName = componentNode.Name2
If (compName = "") Then
compName = "???"
End If
suppr = componentNode.GetSuppression
Select Case (suppr)
Case SwConst.swComponentSuppressionState_e.swComponentFullyResolved
supprString = "Resolved"
Case SwConst.swComponentSuppressionState_e.swComponentLightweight
supprString = "Lightweight"
Case SwConst.swComponentSuppressionState_e.swComponentSuppressed
supprString = "Suppressed"
End Select
vis = componentNode.Visible
Select Case (vis)
Case SwConst.swComponentVisibilityState_e.swComponentHidden
visString = "Hidden"
Case SwConst.swComponentVisibilityState_e.swComponentVisible
visString = "Visible"
End Select
fixed = componentNode.IsFixed
If fixed = 0 Then
fixedString = "Floating"
Else
fixedString = "Fixed"
End If
Set componentDoc = componentNode.GetModelDoc2
If componentDoc Is Nothing Then
docString = "NotLoaded"
Else
docString = "Loaded"
End If
refConfigName = componentNode.ReferencedConfiguration
If (refConfigName = "") Then
refConfigName = "???"
End If
restOfString = "[COMPONENT: " & compName & " " & docString & " " & supprString & " " & visString & " " & refConfigName & "]"
Else
restOfString = "[COMPONENT: object Null?!]"
End If
Case Else:
displayNodeInfo = True
If Not nodeObject Is Nothing Then
restOfString = "[object type not handled]"
Else
restOfString = "[object Null?!]"
End If
End Select
For i = 1 To traverseLevel
indent = indent & " "
Next i
If (displayNodeInfo) Then
Debug.Print indent & node.Text & " : " & restOfString
End If
' Expand the node
node.Expanded = expandThis
traverseLevel = traverseLevel + 1
Set childNode = node.GetFirstChild
While Not childNode Is Nothing
Debug.Print indent & "Node is expanded: " & childNode.Expanded
traverse_node childNode
Set childNode = childNode.GetNext
Wend
traverseLevel = traverseLevel - 1
End Sub
Good luck in your search and if you find better, please share!
Hello, thank you for the answer.
Currently I do the same: SendKeys " +c " except that when I execute the code it deactivates my Num lock or disables my caplock. so I added SendKeys " {NUMLOCK} " just below but from time to time it doesn't work and still deactivates it's horrible...
I'll try to dig to see if I find
It does the same on a colleague's workstation, on all the other workstations no worries.
Never understood why...
Bonjour,
Ce code non? Expand or Collapse FeatureManager Design Tree Nodes Example (VBA) - 2024 - SOLIDWORKS API Help
Yes @Cyril_f this code is the one I put in my 1st post, it works well but it is much slower than the requested function (goes through the whole tree).
@Edouard_B it would seem that by adding , true to sendkeys it avoids the unlocking of the caps lock:
SendKeys "+c", True
I just did the test by adding the True and I have no change on my PC 
it still deactivates the my NumLock
I tested this command:
Set WshShell = CreateObject("WScript.Shell")
WshShell.SendKeys "+R", True
Instead of:
SendKeys "+c", True
And it works too and it seems that this method avoids the bug, as I can't test on my PC not having this bug, it's up to you to try and be the guinea pig!
I just played the guinea pig, and the result is always the same
I found a code that works and no longer disables my Numlock and caplock:
' === Déclarations Windows API (64 bits uniquement) ===
Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
' === Fonction pour vérifier si une touche est active ===
Function IsLockOn(vkKey As Long) As Boolean
IsLockOn = CBool(GetKeyState(vkKey) And 1)
End Function
' === Fonction pour activer ou désactiver une touche de verrouillage ===
Sub SetLockKey(vkKey As Long, shouldBeOn As Boolean)
If IsLockOn(vkKey) <> shouldBeOn Then
keybd_event vkKey, &H45, KEYEVENTF_EXTENDEDKEY, 0
keybd_event vkKey, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
End If
End Sub
Sub Rassembler()
Const VK_NUMLOCK As Long = &H90
Const VK_CAPITAL As Long = &H14
Const VK_SCROLL As Long = &H91
Const KEYEVENTF_EXTENDEDKEY As Long = &H1
Const KEYEVENTF_KEYUP As Long = &H2
' Sauvegarder les états initiaux
Dim initialNumLock As Boolean
Dim initialCapsLock As Boolean
Dim initialScrollLock As Boolean
initialNumLock = IsLockOn(VK_NUMLOCK)
initialCapsLock = IsLockOn(VK_CAPITAL)
initialScrollLock = IsLockOn(VK_SCROLL)
' Envoi de touches
SendKeys "+c", True
' Restaurer les états initiaux
SetLockKey VK_NUMLOCK, initialNumLock
SetLockKey VK_CAPITAL, initialCapsLock
SetLockKey VK_SCROLL, initialScrollLock
End sub
Thank you for sharing I will test the method internally, if my colleague doesn't complain anymore, it's because it works!
I also found this 
that gathers the tree to the 1st level without using sendkeys
Sub CollapseTopLevelOnly()
Dim swApp As SldWorks.SldWorks
Dim model As SldWorks.ModelDoc2
Dim featMgr As SldWorks.FeatureManager
Dim rootNode As SldWorks.TreeControlItem
Dim childNode As SldWorks.TreeControlItem
Set swApp = Application.SldWorks
Set model = swApp.ActiveDoc
If model Is Nothing Then
MsgBox "Aucun document actif"
Exit Sub
End If
Set featMgr = model.FeatureManager
Set rootNode = featMgr.GetFeatureTreeRootItem2(swFeatMgrPaneBottom)
If Not rootNode Is Nothing Then
Set childNode = rootNode.GetFirstChild
Do While Not childNode Is Nothing
childNode.Expanded = False
Set childNode = childNode.GetNext
Loop
End If
End Sub