CAD Forum

Code: Select all

Option Explicit
Sub main()
    
    Dim swApp       As SldWorks.SldWorks
    Dim swModel     As SldWorks.ModelDoc2
    Dim swSelMgr    As SldWorks.SelectionMgr
    Dim swComponent As SldWorks.Component2
    Dim Path        As String
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Then Exit Sub
    
    ' Get the selected component feature or entity
    Set swSelMgr = swModel.SelectionManager
    Set swComponent = swSelMgr.GetSelectedObjectsComponent4(1, -1)
    
    If Not swComponent Is Nothing Then
        Path = swComponent.GetPathName
    Else
        Path = swModel.GetPathName
    End If
    
    Shell "C:\Windows\explorer.exe /select," & Path, vbMaximizedFocus
    
End Sub