Macro solidworks (Vba) Part selection from an assembly

Out of category
1

Hello

I have a macro that from an assembly, opens the selected part and then applies a certain processing to it.

This macro works very well if in the assembly I select a face of the part to be processed.

On the other hand, I would like to add the possibility to apply this processing by selecting the part from the Feature manager as well (without removing the current possibility from a face in the 3D)

Does anyone have a concrete example or idea of the function to use?

 

Below is the current code (cleaned):

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc

                Dim swSelMgr As SldWorks.SelectionMgr
                Dim swCompEnt As SldWorks.Entity
                Dim swPartFeat As SldWorks.Feature
                Dim swCompModel As SldWorks.ModelDoc2
                Dim swPartEnt As SldWorks.Entity
                Dim swConfigMgr As SldWorks.ConfigurationManager
                Dim swModelDocExt As SldWorks.ModelDocExtension
                Dim nRetval As Long
                Set swSelMgr = swModel.SelectionManager
                Dim CurSelCount As Long
                CurSelCount = swSelMgr.GetSelectedObjectCount
                Set swCompEnt = swSelMgr.GetSelectedObject6(1, 0)
                Set swComp = swSelMgr.GetSelectedObjectsComponent3(1, 0)
                Set swCompModel = swComp.GetModelDoc
                Set swConfigMgr = swCompModel.ConfigurationManager
                Set swCompModelConfig = swConfigMgr.ActiveConfiguration
                Set swModelDocExt = swCompModel.Extension
                Set swPartEnt = swModelDocExt.GetCorrespondingEntity(swCompEnt)
                Set swCompModel = swApp.ActivateDoc2(swCompModel.GetPathName, True, nRetval): Debug.Assert 0 = nRetval
                Dim swConfig As SldWorks.Configuration
                Set swModel = swApp.ActiveDoc
                swModel.ShowConfiguration2 (swComp.ReferencedConfiguration)
                Debug.Print "File = " + swModel.GetPathName
                Debug.Print "  Component       = " + swComp.Name2 + " <" + swComp.ReferencedConfiguration + ">" + " [" + swComp.GetPathName + "]"
                Debug.Print "  Model           = " + swCompModel.GetPathName + " <" + swCompModelConfig.Name + ">"
End Sub

 

2

Hello

Something like the following maybe:

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim Model As ModelDoc2
Dim CompModel As ModelDoc2
Dim swChildComp As SldWorks.Component2
Dim SelectedObject As Object
Dim NbrSelections As Long
Dim i As Long

Sub main()

    Set swApp = Application.SldWorks
    Set Model = swApp.ActiveDoc

    Dim SelMgr As SelectionMgr
    Set SelMgr = Model.SelectionManager
        
    NbrSelections = SelMgr.GetSelectedObjectCount2(-1)
        
    For i = 1 To NbrSelections
        Set SelectedObject = SelMgr.GetSelectedObject6(i, -1)
        Debug.Print "Type object : " & SelMgr.GetSelectedObjectType3(i, -1)
        If SelMgr.GetSelectedObjectType3(i, -1) = 20 Then
            Set swChildComp = SelectedObject
            Set CompModel = swChildComp.GetModelDoc2
            
            Debug.Print "1 - Nom : " & swChildComp.Name
            Debug.Print "1 - Chemin : " & CompModel.GetPathName
            Debug.Print "1 - Titre : " & CompModel.GetTitle
        ElseIf SelMgr.GetSelectedObjectType3(i, -1) = 2 Then
            Set swChildComp = SelMgr.GetSelectedObjectsComponent3(1, 0)
            Set CompModel = swChildComp.GetModelDoc2
            
            Debug.Print "2 - Nom : " & swChildComp.Name
            Debug.Print "2 - Chemin : " & CompModel.GetPathName
            Debug.Print "2 - Titre : " & CompModel.GetTitle
        End If
    Next i
    
End Sub

Kind regards

2 Likes
3

Perfectly functional answer @d.roger !

I just finished adapting it to my code successfully.

Thank you.