Hello, I'm having a problem with the macro I created.
The purpose of the macro is for automatic programming on another software (alphacam). But it does not take into account configurations. And since we work a lot with part and assembly configurations, this causes a problem.
So when I go to a furniture configuration that I want to program, it takes all the parts that are only active on this furniture.
Macro execution:
- Go through all the pieces in the tree
- Open the room
- Go to the correct config that is enabled in the assembly
- Save under the room with the name of the active config,
- Close the room
- Opens the new room save
- Delete all config except the active config
- Saves (and should close the room but doesn't)
- Move on to another part in the assembly and start again.
- At the end he closes all the open rooms.
When I run the macro step by step, everything goes well. But when I let it go alone, some times it will work and other times not. Sometimes it will completely delete the configurations from the assembly when it shouldn't, and sometimes it's the assembly that it saves as.
As if the macro was going too fast? I tried to set waits or sleep of up to 30sec and it doesn't work, as if it didn't activate the right file to work on it.
Do you have a solution?
I'm a beginner in VBA, I make my macros by digging into forums, and there I try to look I can't find it.
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
