Hallo, ik heb een probleem met de macro die ik heb gemaakt.
Het doel van de macro is om automatisch te programmeren op een andere software (alphacam). Maar het houdt geen rekening met configuraties. En aangezien we veel met onderdeel- en assemblageconfiguraties werken, levert dit een probleem op.
Dus als ik naar een meubelconfiguratie ga die ik wil programmeren, neemt deze alle onderdelen mee die alleen op dit meubel actief zijn.
Macro uitvoering:
- Ga door alle stukken in de boom
- Open de kamer
- Ga naar de juiste configuratie die is ingeschakeld in de assembly
- Sla op onder de kamer met de naam van de actieve configuratie,
- Sluit de kamer
- Opent de nieuwe kameropslag
- Verwijder alle configuraties behalve de actieve configuratie
- Bespaart (en zou de kamer moeten sluiten, maar doet dat niet)
- Ga verder met een ander onderdeel in de assemblage en begin opnieuw.
- Aan het eind sluit hij alle open kamers.
Als ik de macro stap voor stap uitvoer, gaat alles goed. Maar als ik het alleen loslaat, zal het de ene keer werken en de andere keer niet. Soms worden de configuraties volledig uit de assembly verwijderd terwijl dat niet zou moeten, en soms is het de assembly die het opslaat.
Alsof de macro te snel ging? Ik heb geprobeerd wachttijden of slaapstand van maximaal 30 seconden in te stellen en het werkt niet, alsof het niet het juiste bestand heeft geactiveerd om eraan te werken.
Heeft u een oplossing?
Ik ben een beginner in VBA, ik maak mijn macro's door te graven in forums, en daar probeer ik te kijken, ik kan het niet vinden.
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
