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
