handleman
Automotive
- Jan 7, 2005
- 3,411
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.
-handleman, CSWP (The new, easy test)
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
'-------------------------------------------------
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-handleman, CSWP (The new, easy test)