Macro solidworks (Vba) Sélection de pièce depuis un assemblage

Out of category
1

Bonjour,

J'ai une macro qui depuis un assemblage, ouvre la pièce de sélectionnée et lui applique ensuite un certain traitement.

Cette macro fonctionne très bien si dans l'assemblage je sélectionne une face de la pièce à traiter.

Par contre je souhaiterais ajouter la possibilité d'appliquer ce traitement en sélectionnant la pièce depuis le Feature manager également (sans enlever la possibilité actuelle depuis une face dans le 3D)

Quelqu'un aurait-il un exemple concret ou une idée de la fonction a utiliser?

 

Ci-dessous le code actuel (épuré):

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

Bonjour,

Quelque chose comme ce qui suit peut-être :

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

Cordialement,

2 « J'aime »
3

Réponse parfaitement fonctionnel @d.roger !

Je viens de finir de l'adapter à mon code avec succès.

Merci.