Macro enregistrement et suppression de config

Bonjour je rencontre un problème avec la macro que j’ai créé.

Le but de la macro est pour la programmation automatique sur un autre logiciel (alphacam). Mais celui-ci ne prend pas un compte les configurations. Et comme nous travaillons beaucoup avec les configurations pièces et assemblages cela cause un problème.

Donc quand je vais sur une config de meuble que je veux programmer il me prend toutes pièces qui est uniquement active sur ce meuble.

Exécution de la macro :

  • Parcours toutes les pièces dans l’arbre
  • Ouvre la pièce
  • Va sur la bonne config qui est active dans l’assemblage
  • Enregistre-sous la pièce avec le nom de la config active,
  • Ferme la pièce
  • Ouvre la nouvelle pièce enregistrer
  • Supprime toutes les config sauf la config active
  • Enregistre (et devrais fermer la pièce mais ne le fait pas)
  • Passe à une autre pièce dans l’assemblage et recommence.
  • A la fin il ferme toutes les pièces ouvertes.

Quand j’exécute la macro pas à pas tout ce passe bien. Mais quand je laisse faire tout seul certaine fois ça va marcher et d’autre fois non. Parfois il va complètement supprimer les configurations de l’assemblage alors qu’il ne devrait pas, et parfois c’est l’assemblage qu’il enregistre sous.

Comme si la macro allait trop vite ? j’ai essayé de mettre des attentes ou des sleep allant jusqu’à 30sec et ça ne fonctionne pas, comme s’il n’activait pas le bon fichier pour travailler dessus.

Est-ce que vous auriez une solution ?

Je suis débutant en VBA je fais mes macros en piochant dans des forums, et là j’ai beau chercher je n’arrive pas à trouver.

            If swModel.GetType = SwConst.swDocASSEMBLY Then


            
            Set swApp = Application.SldWorks
            Set swModel = swApp.ActiveDoc
            
            If swModel Is Nothing Then
                MsgBox "Aucun document actif."
                Exit Sub
            End If
            
            If Not swModel.GetType = SwConst.swDocASSEMBLY Then
                MsgBox "Le document actif n'est pas un assemblage."
                Exit Sub
            End If
            
            Set swAsm = swModel
            Set piecesTraitees = New Collection
            Set configsTraitees = New Collection
            
            'Dim vComps As Variant
            vComps = swAsm.GetComponents(False)
            
            'Dim i As Long
            For i = 0 To UBound(vComps)
                Set swComp = vComps(i)
                
                If swComp.GetSuppression <> SwConst.swComponentSuppressionState_e.swComponentSuppressed Then ' Vérifier si le composant est supprimé
                    pieceNom = swComp.Name
                    
                    If Not PieceTraitee(piecesTraitees, pieceNom) Then
                        If Not PieceOuverte(pieceNom) Then
                            If Not swPart Is Nothing Then
                                swApp.CloseDoc swPart.GetPathName
                                Set swPart = Nothing
                            End If
                            
                            swComp.Select4 False, Nothing, False ' Désélectionne le composant précédent
                            swComp.Select4 True, Nothing, False ' Sélectionne le composant actuel
                            
                            ' Ouvrir la pièce
                            Set swPart = swApp.OpenDoc6(swComp.GetPathName, SwConst.swDocPART, SwConst.swOpenDocOptions_Silent, "", 0, 0)

                            
                            If Not swPart Is Nothing Then ' Vérifier si swPart est défini
                                If swPart.GetType = SwConst.swDocPART Then
                                    Set configMgr = swPart.ConfigurationManager
                                    configName = swComp.ReferencedConfiguration
                                                    
                                    fonctionNom = "Débit STD"
                                                    
                                    If FonctionExiste(swPart, fonctionNom) Then
                                        'MsgBox "C'est une pièce"
                                                        
                                        ' Extraire le nom de la pièce depuis l'arbre de l'assemblage
                                        pieceNom = CleanPieceName(swComp.GetPathName)
                                        'Debug.Print "Nom de la pièce: " & pieceNom
                                                        
                                        ' Extraire le nom de la configuration sans les caractères "-"
                                        'configNom = GetConfigurationName(pieceNom)
                                        'Debug.Print "Nom de la configuration: " & configName
                                                        
                                        ' Vérifier si la configuration a déjà été traitée
                                        If Not ConfigurationTraitee(configsTraitees, configName) Then
                                            ' Ajouter la configuration à la collection des configurations traitées
                                            configsTraitees.Add configName
                                                            
                                            ' Activer la configuration souhaitée
                                            If ActivateConfiguration(swPart, configName) Then
                                                ' La pièce a été ouverte dans la configuration spécifiée
                                                swPart.Visible = True
                                                swModel.ShowConfiguration2 configName
                                                swApp.ActivateDoc2 swPart.GetPathName, False, swDocPART


                                               'Dim NomConfig As String
                                               NomConfig = ActiveConfig
                                    
                                                'Dim longstatus As Long, longwarnings As Long
                                                
                                                Set swApp = Application.SldWorks
                                                
                                                Set Part = swApp.ActiveDoc
                

                                                boolstatus = Part.SaveAs3(LblCheminALPHACAM & configName & ".sldprt", 0, 2)
                                                
                                                
                                                swApp.CloseDoc swPart.GetPathName

                                                Set swModel = swApp.OpenDoc6(LblCheminALPHACAM & configName & ".sldprt", swDocPART, swOpenDocOptions_Silent, "", 0, 0)


                                            
                                            'On Supprime toutes les configurations sauf la config Active
                                        
                                            Set swApp = Application.SldWorks
                                            'on récupére le document actif
                                            Set swModel = swApp.ActiveDoc
                                            FilePath = swModel.GetPathName
                                            
                                            
                                                Set swConfigMgr = swModel.ConfigurationManager
                                                'on récupére la configuration active
                                                Set swConfig = swConfigMgr.ActiveConfiguration
                                        
                                                ActivConfig = swConfig.Name              'on récupére de nom de la configation active
                                        
                                                vConfigNameArr = swModel.GetConfigurationNames 'on récupére le nom de toutes les configurations
                                        
                                                For Each vConfigName In vConfigNameArr   'on boucle sur toutes les configurations
                                        
                                                    If Not vConfigName Like ActivConfig Then 'on saute la configuration Active
                                                        swModel.DeleteConfiguration2 (vConfigName) ' on supprime la configuration non Active
                                                
                                                    Else
                                                    End If
                                                Next vConfigName
                                            
                                                'Dim boolstatus As Variant
                                                boolstatus = swModel.EditConfiguration3(ActivConfig, ActivConfig, "", "", 36) 'On change le Nom de la configuration qui sera utilisé dans les Nomenclatures = Nom du Document
                                            
                                                ' On Supprime la tables des configurations si elle existe
                                                Set swModelDocExt = swModel.Extension
                                            
                                                status = swModelDocExt.HasDesignTable    'True Si le document à une Table de Config Sinon=False
                                                If status Then
                                                    swModel.DeleteDesignTable
                                                Else
                                                End If
                                                
                                                'on affiche la configuration active avant le traitement
                                                swModel.ShowConfiguration2 ActivConfig
                                            
                                        
                                                'on force la reconstruction
                                                swModel.ForceRebuild3 False
                                    
        
                                                ' sauvegarde la pièce
                                                 swModel.Save

                                                ' Fermez la pièce
                                                swApp.CloseDoc swPart.GetPathName
                                                
                                            Else
                                                'MsgBox "La configuration spécifiée n'existe pas dans la pièce."
                                                swApp.CloseDoc swPart.GetPathName
                                            End If
                                        Else
                                            'MsgBox "La configuration a déjà été traitée."
                                            swApp.CloseDoc swPart.GetPathName
                                        End If
                                                        
                                    Else
                                        'MsgBox "Ce n'est pas une pièce"
                                        swApp.CloseDoc swPart.GetPathName
                                    End If
                                End If
                            End If
                        Else
                            'MsgBox "La pièce est déjà ouverte dans SolidWorks."
                        End If
                    Else
                        'MsgBox "La pièce a déjà été traitée."
                    End If
                    
                    piecesTraitees.Add pieceNom
                End If
            Next i
            
            If Not swPart Is Nothing Then
                swApp.CloseDoc swPart.GetPathName
                Set swPart = Nothing
            End If
            
            MsgBox "Le parcours des pièces de l'assemblage est terminé."
            
        Dim vModels As Variant
    
        ' Get l'application SolidWorks
        Set swApp = Application.SldWorks
    
        ' Obtenir tous les documents ouverts
        vModels = swApp.GetDocuments
    
        ' Boucle à travers tous les documents
        For i = LBound(vModels) To UBound(vModels)
            Set swModel = vModels(i)
    
            ' Vérifier si le document est une pièce
            If swModel.GetType = swDocPART Then
                ' Fermer le document sans l'enregistrer
                swApp.CloseDoc swModel.GetPathName
            End If
        Next i
            
        End If
        End If
        End If
        
 
 
    FrmPieceAssemblage.Hide
    End

Bonjour;

Merci de poster votre macro dans son intégralité pour que nous puissions la tester dans des conditions « réelles ».
Il faudrait aussi un exemple d’assemblage (ou, au pire, un exemple d’un nom d’une de vos configuration)
Il manque beaucoup de déclaration de variables…

J’ai posté il n’y a pas longtemps une macro relativement similaire (elle ne travail que sur un pièce et pas dans un assemblage .)

Cordialement.

2 Likes

j’ai réalisé la macro avec le poste que vous avez cité justement.

ci joint la macro il faut peut être changer quelques trucs comme des chemins ou nom d’utilisateur PC pour que ça fonctionne chez vous.
c’est un beau bordel dedans (mais ça fonctionne ^^). dans l’assemblage c’est « Alphacam fichier pièce » qu’il faut cocher sur la macro.

ainsi qu’un meuble test

Copie de Enregistre sous + envoie mail.swp (595,5 Ko)

fichier test.zip (27,6 Mo)

personne ? :roll_eyes:

Bonjour,

Petite précision, il n’y a que des bénévoles sur le forum ce qui induit un temps de réponse variable.
En particulier sur cette demande, l’analyse du code demande du temps et sa modification pour la rendre fonctionnelle sur un poste d’un utilisateur différent de votre organisation prend également du temps (lié à l’analyse complète du code et des interactions entre les différents modules de celle-ci).
J’avais commencé à regarder mais par manque de temps je ne suis pas allé bien loin, faut être un peu patient, l’aide va venir.

1 Like

Bonjour,

J’ai commencé à regarder.
En première approche, sur le fichier de test je n’ai aucun problème dans le fonctionnement de la macro en laissant les pauses dans le code (pas testé en les retirant).
En revanche, il y a des appels de fonction qui sont en trop et c’est certainement ça qui rend la macro instable en fonction du cas de figure (beaucoup trop de set swapp et de set swmodel à mon sens).
Je suis en train de regarder pour épurer le code à minima sur Alphacam mais il faudra sérieusement vous pencher sur la simplification des autres fonctions (j’ai également simplifier le formatage du chemin issu du modèle ouvert ainsi que la récupération du nom de l’utilisateur qui utilise la macro).

2 Likes

Bonjour,
effectivement sur ce fichier ça à l’air de fonctionner, j’avais pris un petit fichier sans le tester. c’est vraiment aléatoire en fonction des assemblages. Si vous voulez j’ai un fichier où je suis sûr de reproduire le bug et qui ne fonctionne pas. Mais pour des raison de confidentialité je préfèrerais envoyé cet assemblage en message privé.