handleman
Automotive
- Jan 7, 2005
- 3,411
One thing that's always been a little inconvenient to me is selecting the original 3 planes or origin of a component in an assembly for mating or other purposes. You have to click the component, find it in the design tree, expand it out, and pick the desired plane. I finally got tired enough of doing that to write this macro. It works best when assigned to a keyboard shortcut (I have mine mapped to "R"). To use it, select any component in an assembly. It may be a part, subassembly, or a part of a subassembly (any depth). Then run the macro. It will select the origin of the component. When run multiple times without the user changing selections it will cycle through selecting the origin and the 3 primary planes in succession. You can actually make multiple selections and the macro will only operate on the last selected component without losing your other selections.
The only thing that stinks is that macros are disabled while the "mate" property manager is displayed. :-(
This macro is loosely based on an example in the API help for selecting the origin of an assembly component. However, when you mate the origin of a component in an assembly it is actually mating "Point1@Origin@....". Figuring out how to select that Point1 correctly at any depth of subassembly gave me fits, but I think it's right.
Hope it's useful to you!
The only thing that stinks is that macros are disabled while the "mate" property manager is displayed. :-(
This macro is loosely based on an example in the API help for selecting the origin of an assembly component. However, when you mate the origin of a component in an assembly it is actually mating "Point1@Origin@....". Figuring out how to select that Point1 correctly at any depth of subassembly gave me fits, but I think it's right.
Hope it's useful to you!
Code:
'-------------------------------------------------
' Macro to select main reference geometry of an 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: One of the 3 original planes or the
' origin of the last selected component is selected.
'
'--------------------------------------------------
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 swCompModel As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature
Dim bRet As Boolean
Dim GeneralSelObj As Object
Dim myFeatureCollection As New Collection
Dim i As Integer
Dim CurSelCount As Long
Dim MyTempPointObj As Object
Dim mySelStr As String
Dim NewObjToSelect As Object
Dim Chunks As Variant
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)
' Set swCompModel = swSelComp.GetModelDoc
swSelMgr.DeSelect CurSelCount
Set swFeat = swSelComp.FirstFeature
Do While Not swFeat Is Nothing
If "RefPlane" = swFeat.GetTypeName Then
myFeatureCollection.Add swFeat
End If
If "OriginProfileFeature" = swFeat.GetTypeName Then
Chunks = Split(swSelComp.Name2, "/")
mySelStr = "Point1@Origin@" & Chunks(0) & "@" & _
Left(swModel.GetTitle, Len(swModel.GetTitle) - 7)
For i = 0 To (UBound(Chunks) - 1)
mySelStr = mySelStr & "/" & Chunks(i + 1) & "@" & Left(Chunks(i), (InStrRev(Chunks(i), "-") - 1))
Next
swModel.Extension.SelectByID2 mySelStr, "EXTSKETCHPOINT", _
0, 0, 0, True, 0, Nothing, swSelectOptionDefault
myFeatureCollection.Add swSelMgr.GetSelectedObject(swSelMgr.GetSelectedObjectCount)
swModel.Extension.SelectByID2 mySelStr, "EXTSKETCHPOINT", _
0, 0, 0, True, 0, Nothing, swSelectOptionDefault
Exit Do
End If
Set swFeat = swFeat.GetNextFeature
Loop
Set NewObjToSelect = Nothing
'MsgBox myFeatureCollection.Count
If myFeatureCollection.Count > 4 Then
MsgBox "Error: more than three planes before origin in design tree!"
Exit Sub
End If
For i = 1 To myFeatureCollection.Count
If GeneralSelObj Is myFeatureCollection.Item(i) Then
Set NewObjToSelect = myFeatureCollection.Item((i Mod myFeatureCollection.Count) + 1)
'Use of Mod above cycles back to first item if last item matches.
End If
Next
If NewObjToSelect Is Nothing Then
Set NewObjToSelect = myFeatureCollection.Item(myFeatureCollection.Count)
End If
bRet = NewObjToSelect.Select(True): Debug.Assert bRet
End Sub
'-------------------------------------------------
Just pick your two entities for mating and run one of these macros. When there is a possibility of flipping alignment the macro will ask you with a message box whether you want to keep the current alignment or flip it. I figured the current would be most common, so I made the default be "Yes", which you can select by hitting the spacebar, Return key, or clicking "yes" with the mouse.