As referenced elsewhere, here are two macros that may help you out. The first one de-selects the last-selected item of the current selection set and instead selects the parent subassembly of that component. It's basically the same as the "Select Sub-Assembly" in the RMB menu, except it's easier create large selection sets. The RMB menu command brings up a popup box for you to select the level. This macro just goes up one level. However, if you immediately run it again it will go up another level. I've posted this one before, but I figured I'd go ahead and put it in again for convenience.
The second macro will de-select the last-selected subassembly and instead add all its children (including those in pattern features) to the current selection set. If the last thing selected was not a subassembly it will just give a message and not change the current selections.
I use the first one hundreds of times per day. It works great when mapped to a shortcut key.
' Macro to select parent assembly of the selected assembly component ' for easy mating. Modified extensively from the ' "Select Origin of Assembly Component Example (VB)" in ' SolidWorks and Add-Ins API Help
' Preconditions:
' (1) Assembly document is open.
' (2) One or more items is selected.
'
' Postconditions: The parent subassembly is selected. Will not select 'the top level assembly. '
Dim swApp As SldWorks.SldWorks Dim swModel As SldWorks.ModelDoc2 Dim swSelMgr As SldWorks.SelectionMgr Dim swSelComp As SldWorks.Component2 Dim bRet As Boolean Dim GeneralSelObj As Object Dim i As Integer Dim CurSelCount As Long Dim NewObjToSelect As Object Dim swVer As Variant Dim ResolveIt As Integer Dim DocTitle As String Dim DwgDocComp As DrawingComponent Dim OldToggleVal As Long
Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc If swModel.GetType = swDocPART Then MsgBox "This macro works on assembly documents or assembly drawings only." Exit Sub ElseIf (swModel.GetType = swDocDRAWING) Then If (swModel.ActiveDrawingView.ReferencedDocument.GetType = swDocPART) Then MsgBox "This macro works on assembly documents or assembly drawings only." Exit Sub End If End If Set swSelMgr = swModel.SelectionManager CurSelCount = swSelMgr.GetSelectedObjectCount If CurSelCount = 0 Then MsgBox "Nothing was selected" Exit Sub End If
Set GeneralSelObj = swSelMgr.GetSelectedObject(CurSelCount) If swModel.GetType = swDocDRAWING Then Set DwgDocComp = swSelMgr.GetSelectedObjectsComponent2(CurSelCount) Set swSelComp = DwgDocComp.Component Else Set swSelComp = swSelMgr.GetSelectedObjectsComponent(CurSelCount) End If
swVer = Split(swApp.RevisionNumber, ".") If CInt(swVer(0)) < 14 Then If swSelComp.GetSuppression <> swComponentFullyResolved Then If swSelComp.GetSuppression <> swComponentResolved Then ResolveIt = MsgBox("The component selected is not fully resolved." _ & vbCrLf & "This functionality is only available for lightweight" & vbCrLf & _ "components in SolidWorks 2006 or greater." & vbCrLf & vbCrLf & _ "Resolve this component now?", vbYesNo, "Upgrade Time!") If vbYes = ResolveIt Then swSelComp.SetSuppression2 swComponentFullyResolved Else Exit Sub End If End If End If End If
Set NewObjToSelect = swSelComp.GetParent If Not NewObjToSelect Is Nothing Then swSelMgr.DeSelect CurSelCount If swModel.GetType = swDocDRAWING Then Set NewObjToSelect = NewObjToSelect.GetDrawingComponent(swSelMgr.GetSelectedObject6(swSelMgr.GetSelectedObjectCount2(-1), -1)) swModel.ClearSelection2 True OldToggleVal = swApp.GetUserPreferenceToggle(swAutoShowPropertyManager) swApp.SetUserPreferenceToggle swAutoShowPropertyManager, False bRet = NewObjToSelect.Select(True, Nothing) swApp.SetUserPreferenceToggle swAutoShowPropertyManager, OldToggleVal Else bRet = NewObjToSelect.Select(True) End If 'Debug.Print bRet End If
Dim swApp As SldWorks.SldWorks Dim swDoc As SldWorks.ModelDoc2 Dim swAssy As SldWorks.AssemblyDoc Dim swSelMgr As SldWorks.SelectionMgr Dim GeneralSelObj As Object Dim SelComp As SldWorks.Component2
Sub main()
Set swApp = Application.SldWorks Set swDoc = swApp.ActiveDoc If swDoc.GetType <> swDocASSEMBLY Then Exit Sub End If Set swAssy = swDoc Set swSelMgr = swDoc.SelectionManager On Error GoTo HANDLER Set SelComp = swSelMgr.GetSelectedObject6(swSelMgr.GetSelectedObjectCount2(-1), -1) On Error GoTo 0 swSelMgr.DeSelect swSelMgr.GetSelectedObjectCount2(-1)
AddChildrenToSelectionSet SelComp
HANDLER: If Err.Number <> 0 Then MsgBox "An error occurred. Your selection may not be a subassembly." End If Set SelComp = Nothing Set swAssy = Nothing Set swSelMgr = Nothing Set swApp = Nothing End Sub
Private Sub AddChildrenToSelectionSet(ByVal myComp As SldWorks.Component2)
Dim ChildArray As Variant Dim i As Long
ChildArray = myComp.GetChildren If Not IsNull(ChildArray) Then For i = 0 To UBound(ChildArray) ChildArray(i).Select True AddChildrenToSelectionSet ChildArray(i) Next i End If
Thanks! I can see myself using that 2nd Macro for sure.
This is in response to a complaint I had about using the Cavity feature, and having to select Parts only, not subassys. This will come in handy when I am potting circuit boards in missile components.
...now if I could only select circular/linear patterns without having to expand them!
"Art without engineering is dreaming; Engineering without art is calculating."
Oops, lemme try again. I've never used the cavity feature, so I thought I'd give it a go. In trying it out, I realized that as-posted, the macro doesn't un-select the subassemblies it selects. So I fixed that. Then I found that the Cavity feature doesn't like it when you select suppressed components. So I put a flag constant at the top that controls whether or not suppressed components are selected. Not sure why one would want to select them, but I left the option open.
CODE
Const SELECTSUPPRESSED As Boolean = False
Dim swApp As SldWorks.SldWorks Dim swDoc As SldWorks.ModelDoc2 Dim swAssy As SldWorks.AssemblyDoc Dim swSelMgr As SldWorks.SelectionMgr Dim GeneralSelObj As Object Dim SelComp As SldWorks.Component2
Sub main()
Set swApp = Application.SldWorks Set swDoc = swApp.ActiveDoc If swDoc.GetType <> swDocASSEMBLY Then Exit Sub End If Set swAssy = swDoc Set swSelMgr = swDoc.SelectionManager On Error GoTo HANDLER Set SelComp = swSelMgr.GetSelectedObject6(swSelMgr.GetSelectedObjectCount2(-1), -1) On Error GoTo 0 swSelMgr.DeSelect swSelMgr.GetSelectedObjectCount2(-1)
AddChildrenToSelectionSet SelComp
HANDLER: If Err.Number <> 0 Then MsgBox "An error occurred. Your selection may not be a subassembly." End If Set SelComp = Nothing Set swAssy = Nothing Set swSelMgr = Nothing Set swApp = Nothing End Sub
Private Sub AddChildrenToSelectionSet(ByVal myComp As SldWorks.Component2)
Dim ChildArray As Variant Dim i As Long
ChildArray = myComp.GetChildren If UBound(ChildArray) > -1 Then swSelMgr.DeSelect swSelMgr.GetSelectedObjectCount2(-1) For i = 0 To UBound(ChildArray) If ChildArray(i).GetSuppression = swComponentSuppressed Then If SELECTSUPPRESSED Then ChildArray(i).Select True End If Else ChildArray(i).Select True End If AddChildrenToSelectionSet ChildArray(i) Next i End If
After a bit of modification, this will now do both subassemblies and patterns. Any selection other than a subassembly or a pattern feature is ignored. Enjoy!
CODE
Const SELECTSUPPRESSED As Boolean = False
Dim swApp As SldWorks.SldWorks Dim swDoc As SldWorks.ModelDoc2 Dim swAssy As SldWorks.AssemblyDoc Dim swSel As SldWorks.SelectionMgr Dim swFeat As SldWorks.Feature Dim PtnChild As Variant
Sub main()
Dim i As Long Dim swPtnComp As SldWorks.Component2 Dim mySelType As Long
Set swApp = Application.SldWorks Set swDoc = swApp.ActiveDoc If swDoc.GetType <> swDocASSEMBLY Then Exit Sub End If Set swAssy = swDoc Set swSel = swDoc.SelectionManager
Select Case swSel.GetSelectedObjectType3(swSel.GetSelectedObjectCount2(-1), -1) Case swSelCOMPPATTERN Set swFeat = swSel.GetSelectedObject6(swSel.GetSelectedObjectCount2(-1), -1) swSel.DeSelect swSel.GetSelectedObjectCount2(-1) PtnChild = swFeat.GetChildren For i = 0 To UBound(PtnChild) Set swPtnComp = PtnChild(i).GetSpecificFeature If (swPtnComp.GetSuppression = swComponentSuppressed) Then If SELECTSUPPRESSED Then swPtnComp.Select True End If Else swPtnComp.Select True End If AddChildrenToSelectionSet swPtnComp Next i Case swSelCOMPONENTS Set swPtnComp = swSel.GetSelectedObject6(swSel.GetSelectedObjectCount2(-1), -1) swSel.DeSelect swSel.GetSelectedObjectCount2(-1) AddChildrenToSelectionSet swPtnComp End Select
Debug.Print swSel.GetSelectedObjectCount2(-1)
Set swPtnComp = Nothing Set swSel = Nothing Set swAssy = Nothing Set swDoc = Nothing Set swApp = Nothing
End Sub
Private Sub AddChildrenToSelectionSet(ByVal myComp As SldWorks.Component2)
Dim ChildArray As Variant Dim i As Long
ChildArray = myComp.GetChildren If UBound(ChildArray) > -1 Then swSel.DeSelect swSel.GetSelectedObjectCount2(-1) For i = 0 To UBound(ChildArray) If ChildArray(i).GetSuppression = swComponentSuppressed Then If SELECTSUPPRESSED Then ChildArray(i).Select True End If Else ChildArray(i).Select True End If AddChildrenToSelectionSet ChildArray(i) Next i End If
DESCRIPTION: SolidWorks 3D CAD products technical support forum and mutual help system for engineering professionals. Selling and recruiting forbidden.
Attn: MadMango