Attn: MadMango
Attn: MadMango
(OP)
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.
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.
CODE
'-------------------------------------------------
' 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.
'
'--------------------------------------------------
Option Explicit
Sub main()
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
End Sub
'-------------------------------------------------
' 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.
'
'--------------------------------------------------
Option Explicit
Sub main()
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
End Sub
'-------------------------------------------------
CODE
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
End Sub
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
End Sub
-handleman, CSWP (The new, easy test)






RE: Attn: MadMango
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."
Have you read FAQ731-376: Eng-Tips.com Forum Policies to make the best use of Eng-Tips Forums?
RE: Attn: MadMango
CODE
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
End Sub
-handleman, CSWP (The new, easy test)
RE: Attn: MadMango
CODE
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
End Sub
-handleman, CSWP (The new, easy test)
RE: Attn: MadMango
"Art without engineering is dreaming; Engineering without art is calculating."
Have you read FAQ731-376: Eng-Tips.com Forum Policies to make the best use of Eng-Tips Forums?
RE: Attn: MadMango
A star for you. This is just what I needed. I have not tried it yet, but I will. Thank you.
Bradley
SolidWorks Pro 2008 x64, SP3.0
PDMWorks Workgroup, SolidWorks BOM,
Dell XPS Intel(R) Pentium(R) D CPU
3.00 GHz, 5 GB RAM, Virtual memory 12577 MB,
nVidia Quadro FX 3400
Use SolidWorks BOM
e-mail is Lotus Notes