-
1
- #1
handleman
Automotive
- Jan 7, 2005
- 3,411
Here's a macro that's a modification of one I posted here in thread559-175155 some time ago. The purpose of the previous macro was easy selection of the reference geometry (origin, main planes) of the currently selected assembly component for easy mating. However, I've found myself more and more wanting to mate to reference geometry of a subassembly rather than the reference geometry of an individual component. To that end, I've written a very similar macro that selects the entire subassembly owning the currently selected component. This nearly mimics the new "Select Sub Assembly" function available in 2008. The main difference (at least in my pre-release 2 version) is that the SW2008 command leaves the original selection in the selection set, while this macro replaces the selected entity of the component with the subassembly in the selection set. When combined with the reference geometry macro you can select reference geometry of subassemblies very quickly. Both this macro and the reference geometry selection macro only act on the most recently made selection. Previously selected items in a selection set are unaffected by either macro. Enjoy!
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
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel.GetType <> swDocASSEMBLY Then
MsgBox "This macro works on assembly documents only."
Exit Sub
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)
Set swSelComp = swSelMgr.GetSelectedObjectsComponent(CurSelCount)
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
bRet = NewObjToSelect.Select(True): Debug.Assert bRet
End If
End Sub
'-------------------------------------------------