Hallo, ich habe ein Problem mit dem Makro, das ich erstellt habe.
Der Zweck des Makros ist die automatische Programmierung auf einer anderen Software (alphacam). Konfigurationen werden jedoch nicht berücksichtigt. Und da wir viel mit Teile- und Baugruppenkonfigurationen arbeiten, führt dies zu einem Problem.
Wenn ich also zu einer Möbelkonfiguration gehe, die ich programmieren möchte, nimmt es alle Teile, die nur an diesem Möbel aktiv sind.
Ausführung von Makros:
- Gehen Sie alle Teile im Baum durch
- Öffnen Sie den Raum
- Wechseln Sie zur richtigen Konfiguration, die in der Assembly aktiviert ist
- Speichern Sie unter dem Raum mit dem Namen der aktiven Konfiguration,
- Schließen Sie den Raum
- Öffnet den neuen Raumstand
- Löschen Sie alle Konfigurationen mit Ausnahme der aktiven Konfiguration.
- Speichert (und sollte den Raum schließen, tut es aber nicht)
- Wechseln Sie zu einem anderen Teil in der Baugruppe, und beginnen Sie erneut.
- Am Ende schließt er alle offenen Räume.
Wenn ich das Makro Schritt für Schritt ausführe, läuft alles gut. Aber wenn ich es alleine lasse, wird es manchmal funktionieren und manchmal nicht. Manchmal werden die Konfigurationen vollständig aus der Assembly gelöscht, wenn dies nicht der Fall sein sollte, und manchmal ist es die Assembly, in der sie gespeichert wird.
Als ob das Makro zu schnell ginge? Ich habe versucht, Wartezeiten oder Ruhezustand von bis zu 30 Sekunden einzustellen, und es funktioniert nicht, als ob es nicht die richtige Datei aktiviert hätte, um daran zu arbeiten.
Haben Sie eine Lösung?
Ich bin ein Anfänger in VBA, ich mache meine Makros, indem ich in Foren wühle, und dort versuche ich zu suchen, aber ich kann es nicht finden.
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
