Bonjour,
Je suis en train de réfléchir à un système permettant de vérifier la nomenclature d'une machine. L'arborescence de la machine est structurée en sous-ensembles, regroupés dans des dossiers "fonction" dans l'arbre de création.
Dans l'idéal, je souhaiterais pouvoir exporter sous Excel la nomenclature de la machine, en respectant les regroupements en dossiers de l'assemblage. Je n'ai pas trouvé de moyen de le faire directement,peut-être qu'il serait possible de le faire via VBA ? Qu'en pensez-vous ?
Merci d'avance !
Bonjour. La macro ci-dessous exportera dans un fichier Excel l'arborescence incluant les dossiers tel que:
TopLevelAsm1 > Asm3-1 > Part4-1
TopLevelAsm1 > Folder1 > Asm2-1
TopLevelAsm1 > Folder1 > Asm2-1 > Part1-1
Option Explicit
Dim FilePath As String
Sub main()
FilePath = "C:\Temp\myBOM.TSV"
If Dir(FilePath) <> "" Then Kill FilePath
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
TraverseAssyFeatures swModel, Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1, InStrRev(swModel.GetPathName, ".") - InStrRev(swModel.GetPathName, "\") - 1)
End Sub
Sub TraverseAssyFeatures(ByVal swModel As SldWorks.ModelDoc2, ByRef Rep As String)
Dim swComp As SldWorks.Component2
Dim swCompModel As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature
Dim swEntity As SldWorks.Entity
Set swFeat = swModel.FirstFeature
While Not swFeat Is Nothing
Set swEntity = swFeat
If swEntity.GetType = swSelectType_e.swSelFTRFOLDER Then
If InStr(swFeat.Name, "EndTag") = 0 Then
Rep = Rep & " > " & swFeat.Name
Else
Rep = Left(Rep, InStrRev(Rep, " > ") - 1)
End If
End If
If swEntity.GetType = swSelectType_e.swSelCOMPONENTS Then
WriteIntoFile Rep & " > " & swFeat.Name
If swModel.GetType = swDocumentTypes_e.swDocASSEMBLY Then
Set swComp = swFeat.GetSpecificFeature2
swComp.SetSuppression2 swComponentSuppressionState_e.swComponentFullyResolved
Set swCompModel = swComp.GetModelDoc2
swCompModel.ShowConfiguration2 swComp.ReferencedConfiguration
TraverseAssyFeatures swCompModel, Rep & " > " & swFeat.Name
End If
End If
Set swFeat = swFeat.GetNextFeature
Wend
End Sub
Sub WriteIntoFile(logSTR As String)
Dim My_fileNum As Integer
My_fileNum = FreeFile
Open FilePath For Append As #My_fileNum
Print #My_fileNum, logSTR
Close #My_fileNum
End Sub
4 « J'aime »
Bonjour,
Merci beaucoup !
J'ai voulu tester ça, mais j'ai une erreur 91 sur la ligne suivante :
swCompModel.ShowConfiguration2 swComp.ReferencedConfiguration
variable objet ou variable de bloc with non définie
le fichier est créé mais il n'y a qu'une ligne dedans
Avez-vous une idée de l'origine du problème ? Merci d'avance !
Cette ligne n'est pas forcément nécessaire si les pièces n'ont qu'une seule config (ou sont sauvegardées dans la config utilisée dans l'assemblage). Donc tu peux la retirer.
Toutefois ca ne devrait pas causer une erreur. Vérifie que le composant est valide avec :
If swModel.GetType = swDocumentTypes_e.swDocASSEMBLY Then
Set swComp = swFeat.GetSpecificFeature2
If swComp is Nothing then Debug.print "Problème comp avec: " & swFeat.Name
Set swCompModel = swComp.GetModelDoc2
If swCompModel is Nothing then Debug.print "Problème modèle avec: " & swFeat.Name
If Not swCompModel is Nothing then
'Debug.Print "Config Name: " & swComp.ReferencedConfiguration
'swCompModel.ShowConfiguration2 swComp.ReferencedConfiguration
TraverseAssyFeatures swCompModel, Rep & " > " & swFeat.Name
End If
End If
Si tu peux m'envoyer l'assemblage avec la pièce qui pose problème, je regarderai ca.
1 « J'aime »
J'ai la même erreur (91) sur la ligne
Set swCompModel = swComp.GetModelDoc2
En shuntant les lignes de ce bloc mon fichier est bien généré.
Ce bloc permet de traiter les sous-assemblages. Si l'assemblage n'as pas de sous assemblages, tu peux le laisser désactivé, ou utiliser :
If swModel.GetType = swDocumentTypes_e.swDocASSEMBLY Then
Set swComp = swFeat.GetSpecificFeature2
If swComp is Nothing then Debug.print "Problème comp avec: " & swFeat.Name
If Not swComp is Nothing then
Set swCompModel = swComp.GetModelDoc2
If swCompModel is Nothing then Debug.print "Problème modèle avec: " & swFeat.Name
If Not swCompModel is Nothing then
'Debug.Print "Config Name: " & swComp.ReferencedConfiguration
'swCompModel.ShowConfiguration2 swComp.ReferencedConfiguration
TraverseAssyFeatures swCompModel, Rep & " > " & swFeat.Name
End If
End If
End If
Sinon:
Qu'est ce que dis la fenêtre "immediate"? (Menu View > Immediate)
Je ne peux pas vraiment d'aider plus sans avoir les fichiers.
Je n'ai pas trouvé la fenêtre "immediate"... Est-ce qu'il s'agit de la fenêtre d'éxécution de VBA?
D'après ce que j'ai vu, l'erreur se produit sur la première pièce du premier sous-ensemble dans le premier dossier de l'arborescence ("Probleme comp avec : 23495-4364-2")
Le dossier et le sous-ensemble apparaissent bien dans le fichier, mais pas la pièce.
Cette fenêtre:
Encore une fois: "Je ne peux pas vraiment d'aider plus sans avoir les fichiers."
Désolé je ne peux pas envoyer mon assemblage tel quel pour des questions de confidentialité. Je pense que je vais faire des essais avec un assemblage de test, si je ne m'en sors pas je t'enverrai ça pour approfondir.
Merci pour ton aide en tout cas !
Je n'ai pas besoin du design des pièces.
Fais une copie de l'assemblage, ouvre chacune des pièces, effaces les fonctions, enregistre.
voir fichier ci joint. D'ailleurs tu peux vérifier avec cet assemblage que ca fonctionne.
asm.zip
Bonjour,
La macro donnée au début de la discussion marche très bien, il faut juste régler tous les composants sur résolus avant de la lancer sinon ça bug car les composants allégés ne sont pas accessibles d'ou le message d'erreur "variable objet ou variable de bloc with non définie".
Cordialement,
2 « J'aime »
Merci d.roger.
Original code modifié pour inclure:
swComp.SetSuppression2 swComponentSuppressionState_e.swComponentFullyResolved
Après: Set swComp = ...
1 « J'aime »
Merci d.roger et JeromeP !
Malheureusement j'ai toujours un message d'erreur lors de l'éxécution de la macro, que ce soit après avoir passé toutes les pièces en résolu ou avec l'ajout de la ligne (ça plante sur la ligne en question).
Cela dit , ça fonctionne au début car j'ai tout de même une douzaine de lignes dans le fichier TSV.
Je vais faire des essais avec des pièces "from scratch" pour voir si j'ai les mêmes problèmes, je vous tiens au courant !
Est ce que tu as le même problème avec l'assemblage attaché en pièce jointe 3 messages avant?
Oui, l'exécution bloque sur la ligne suivante :
swComp.SetSuppression2 swComponentSuppressionState_e.swComponentFullyResolved
En mode débogage, je vois que la valeur de swComponentSuppressionState_e.swComponentFullyResolved est 2.
Je viens de faire un essais avec des pièces vierges, la macro s'éxécute convenablement.
Pensez-vous que ce problème puisse être lié à un paramétrage des pièces ou à l'utilisation du PDM ?
Oui, cela vient probablement du PDM, pour tester fait un obtenir dernière version sur tous tes fichiers pour les mettre dans ton cache local ...
Les macros faites pour travailler avec le PDM ne se construisent pas du tout de la même façon, il faut s'appuyer sur les API Epdm pour se connecter au coffre-fort, obtenir le fichier en cache local, etc ... Ce n'est plus tout à fait le même boulot ...
1 « J'aime »
La valeur de 2 pour swComponentSuppressionState_e.swComponentFullyResolved est normal.
Le problème avec SetSuppression2 peut aussi venir du PDM. Tu peux essayer swComp.SetSuppression2 swComponentSuppressionState_e.swComponentResolved
J'ai fait "obtenir dernière version" sur tous les fichiers (et modifié la ligne de code deJeromeP), ça exporte bien mais ça plante sur le 1er sous-ensemble de l'arborescence.