Witam, mam problem z utworzonym przeze mnie makrem.
Celem makra jest automatyczne programowanie na innym oprogramowaniu (alphacam). Ale nie bierze pod uwagę konfiguracji. A ponieważ dużo pracujemy z konfiguracjami części i zespołów, powoduje to problem.
Więc kiedy przechodzę do konfiguracji mebli, którą chcę zaprogramować, pobiera ona wszystkie części, które są aktywne tylko na tym meblu.
Wykonywanie makr:
- Przejrzyj wszystkie elementy w drzewie
- Otwórz pokój
- Przejdź do poprawnej konfiguracji, która jest włączona w zestawie
- Zapisz pod pokojem z nazwą aktywnej konfiguracji,
- Zamknij pokój
- Otwiera nowy zapis pokoju
- Usuń wszystkie konfiguracje z wyjątkiem aktywnej konfiguracji
- Zapisuje (i powinien zamknąć pokój, ale tego nie robi)
- Przejdź do innej części w zespole i zacznij od nowa.
- Na koniec zamyka wszystkie otwarte pokoje.
Kiedy uruchamiam makro krok po kroku, wszystko idzie dobrze. Ale kiedy pozwalam mu odejść samemu, czasami to zadziała, a innym razem nie. Czasami całkowicie usunie konfiguracje z zestawu, gdy nie powinien, a czasami jest to zestaw, który jest zapisywany jako.
Jakby makro szło za szybko? Próbowałem ustawić czas oczekiwania lub uśpienia do 30 sekund i nie działa, tak jakby nie aktywował odpowiedniego pliku do pracy na nim.
Czy masz rozwiązanie?
Jestem początkującym w VBA, tworzę makra, grzebiąc na forach i tam staram się szukać, ale nie mogę tego znaleźć.
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
