Vérifier des fichiers avec une boucle en vba Solidworks

Bonjour, j'ai encore besoin d'aide, je suis stagiaire dans uen boite et je comprend peu le système de boucle comment bien les mettres

Mon objectif est de récupérer le nom du fichier, le vérifier( description, propriété, référence) une fois cette étape finit vérifier si il y a d'autre pièces/assemblage dans le fichier parents si oui ça refais la vérif pour chaque sous fichier "pièce" ou "assemblage" , si non pas de sous fichiers, il remonte et passe à la pièce suivante, puis refaire la même procédure a chaque fichiers

J'ai déjà toutes les commandes pour les infos mais du coup c'est comment le faire mettre dans une boucle

Merci de vôtre aide.

Si d'autre questions demandez moi

Option Explicit

Const RechercheDeLaPosition = True


Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swAssy As SldWorks.AssemblyDoc
    Dim swConf As SldWorks.Configuration
    Dim swRootComp As SldWorks.Component2
    Dim Nom
    Dim fileName As String
    Dim compte As Long
    Dim caractere  As String
    Dim Position As Single
    Dim Resultat1 As String
    Dim Position2 As Single
    Dim caractere2 As String
    Dim resultat3 As String
    Dim cusPropMgr As SldWorks.CustomPropertyManager
    Dim swModelDocExt As SldWorks.ModelDocExtension
    Dim ContrôleVF As Boolean
    Dim ValOut As String
    Dim WasResolved As Boolean
    Dim ResolvedValOut As String
    Dim LinkToProperty As Boolean
    Dim ValeurDesc, ValeurRéférence
    Dim REF_Et_la_DESC As String
    
Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)
    Dim vChildComp As Variant
    Dim swChildComp As SldWorks.Component2
    Dim swCompConfig As SldWorks.Configuration
    Dim sPadStr As String
    Dim i As Long
    
    sPadStr = ""
    For i = 0 To nLevel - 1
        sPadStr = sPadStr + "  "
    Next i
    
    vChildComp = swComp.GetChildren
    
    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
            TraverseComponent swChildComp, nLevel + 1
        Debug.Print sPadStr & swChildComp.Name2 '& " <" & swChildComp.ReferencedConfiguration & ">"
    Next i
    
End Sub
Sub main()

    Set swApp = CreateObject("SldWorks.Application")
        Set swModel = swApp.ActiveDoc
        
        
  '---- Affiche le chemin d'accès et le nom du fichier
   If MsgBox("Le nom du fichier est :" & vbCrLf & vbCrLf & swModel.GetPathName, vbOKCancel, "Vérification") = vbOK Then
   End If
                       Set swModelDocExt = swModel.Extension
             Set cusPropMgr = swModelDocExt.CustomPropertyManager("")
             
    
    
 '---------------------------------------------------------------
 '----Récupération de la valeur donné correspondante au Nom De La Propriété---
 '---------------------Afficher la valeur------------------------
 '---------------------------------------------------------------
    ValeurDesc = swModel.GetCustomInfoValue("", "description")
    If MsgBox("Le nom du fichier est :" & vbCrLf & vbCrLf & ValeurDesc, vbOKOnly, "Vérification") = vbOK Then
        End If
        ValeurRéférence = swModel.GetCustomInfoValue("", "référence")
    If MsgBox("La référence est :" & vbCrLf & vbCrLf & ValeurRéférence, vbOKOnly, "Vérification") = vbOK Then
        End If

        REF_Et_la_DESC = ValeurRéférence & "_" & ValeurDesc
         If REF_Et_la_DESC = resultat3 Then
            MsgBox "La description est identique au nom :" & vbCrLf & vbCrLf & REF_Et_la_DESC & vbCrLf & vbCrLf & resultat3, vbQuestion, "Vérification"
             MsgBox "Vous pouvez continuer"
         Else
        MsgBox "Les valeurs ne sont pas cohérentes avec le nom de fichier référencé"
         MsgBox "Veuillez vérifier les informations"
         End If
        
    
           
            
                 '---- Cherche le dernière "\" dans le chemain d'accès du fichier-----
                           caractere = "\"
                           Position = InStrRev(swModel.GetPathName, caractere)
                  'Afficher seulement le nom du fichier + l'extension
                           Resultat1 = Mid(swModel.GetPathName, Position + 1)
                  '---- Cherche le dernier "." dans resultat1 pour ensuite retirer l'extension et afficher que le nom du fichier-
                           caractere2 = "."
                           Position2 = InStrRev(Resultat1, caractere2)
                  'MsgBox Left(Resultat1, Position2 - 1)
                           resultat3 = Left(Resultat1, Position2 - 1)
                  '---- On cherche la référence puis on vérifie qu'elle fait moins de 50 chr
        
                  ' va traiter la longueur de notre demande de vérification du caractère
                    If Len(resultat3) >= 50 Then
                          MsgBox "Votre Nom de fichier est trop long !"
                          MsgBox "Veuillez modifier le nom !"
                    End If
            
 
           Nom = swModel.GetPathName
    ' Ouvre l'assemblage si il n'est pas déjà ouvert
    fileName = Nom
    'Set swModel = swApp.OpenDoc6(fileName, swDocumentTypes_e.swDocASSEMBLY, swOpenDocOptions_e.swOpenDocOptions_Silent, "", errors, warnings)
    Set swConf = swModel.GetActiveConfiguration
    Set swRootComp = swConf.GetRootComponent3(True)
        Debug.Print "Chemin et Nom du Fichier = " & swModel.GetPathName
    ' Traverse components
    TraverseComponent swRootComp, 1

    End Sub

Je reposte ma question car je l'ai validé sans le vouloir

Et comme je sais pas si l'on peut répondre après validation, je m'excuse.

Merci encore de vôtre aide

Bonjour,

Si tu veux gagner du temps, il existe un outil dans la suite myCADtools qui permet de faire cela.

Tu peux créer des rapports pour lister tous les fichiers qui sont incohérent en fonction de leurs valeurs de propriété du nom de fichier, ... et même corriger les erreurs.

Il s'agit de l'outil Integration : https://help.visiativ.com/mycadtools/2022/fr/Integration.html

Tu peux test myCADtools gratuitement pendant 30 jours pour te faire une idée

https://www.lynkoa.com/mycadtools

Philippe

 

1ère remarque pas besoin de mettre des msgbox pour voir la valeur d'une variable, il suffit de faire un debug.print (voir le principe pour excel mais reste le mêm dans Sw:

https://fr.teamaftermarket.com/348-vba-debug-print

Pour voir la valeur du debug.print il faut faire affichage, fenêtre exécution dans l'éditeur vba. La valeure s'affichera dans la fenêtre exécution. Au besoin lancer le code en pas à pas (F8).

Ensuite tu verras que le nom de  chaque pièces ou sous assemblage apparait déjà dans cette fenêtre grâce au debug.print dans la fonction TraverseComponents.

 

Et que ton code devrait être appliqué dans cette fonction (TraverseComponents) sur l'objet swChildComp et pas dans le main sur le swmodel qui est l'assemblage principal.

Pour bien comprendre quand tu lance ta fonction main il arrive à la fonction TraverseComponents swRootComp, 1

Il lance donc le sub du même nom et c'est dans ce sub qu'il balaie chaque pièce et assemblage.

Je te laisse regarder plus en détail pas trop le temps d'approfondir aujourd'hui.

Poste nous ton code final si tu y arrive ou là ou tu bloque avec les nouvelles indications.

 

 

1 « J'aime »
Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swConf As SldWorks.Configuration
Dim swRootComp As SldWorks.Component2
Dim Nom
Dim fileName As String
Dim compte As Long
Dim caractere  As String
Dim Position As Single
Dim Resultat1 As String
Dim Position2 As Single
Dim caractere2 As String
Dim NomSansSuffixe As String
'Dim cusPropMgr As SldWorks.CustomPropertyManager
'Dim swModelDocExt As SldWorks.ModelDocExtension
Dim ContrôleVF As Boolean
Dim ValOut As String
Dim WasResolved As Boolean
Dim ResolvedValOut As String
Dim LinkToProperty As Boolean
Dim ValeurDesc, ValeurRéférence
Dim REF_Et_DESC As String
    
' Balaye les sous-élément de l'élément swComp, contrôle que l'élément de base est conforme
' Renvoie true si OK
Function TraverseComponent(swComp As SldWorks.Component2, nLevel As Long) As Boolean
    Dim vChildComp As Variant
    Dim swChildComp As SldWorks.Component2
    Dim swCompConfig As SldWorks.Configuration
    Dim sPadStr As String
    Dim i As Long
    
    Debug.Print "Chemin et Nom du Fichier = " & swComp.GetPathName
    
    If TestElementConforme(swComp) = True Then
        
        
        sPadStr = ""
        For i = 0 To nLevel - 1
            sPadStr = sPadStr + "  "
        Next i
        
        ' Récupère la liste des sous-éléments
        vChildComp = swComp.GetChildren
        
        ' Parcours la liste des osus éléments et demande le contrôle pour chacun
        For i = 0 To UBound(vChildComp)
            Set swChildComp = vChildComp(i)
            If TraverseComponent(swChildComp, nLevel + 1) = False Then
                TraverseComponent = False
                MsgBox "On sort de la position 1 :" & nLevel
                End
            End If
            
            'Debug.Print sPadStr & swChildComp.Name2 '& " <" & swChildComp.ReferencedConfiguration & ">"
        Next i
        TraverseComponent = True
    Else
        TraverseComponent = False
        MsgBox "On sort de la position 2"
    End If

End Function


Sub main()

    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
                        
    '---- Affiche le chemin d'accès et le nom du fichier
    MsgBox "Le nom du fichier est :" & vbCrLf & vbCrLf & swModel.GetPathName, vbOKCancel, "Vérification"

    'Nom = swModel.GetPathName
    ' Ouvre l'assemblage si il n'est pas déjà ouvert
    'fileName = Nom
    
    Set swConf = swModel.GetActiveConfiguration
    Set swRootComp = swConf.GetRootComponent3(True)
    'Debug.Print "Chemin et Nom du Fichier = " & swModel.GetPathName
        ' Traverse components
    If (swRootComp Is Nothing) Then
        MsgBox "Aucun élément trouvé"
    Else
        If TraverseComponent(swRootComp, 1) = True Then
            MsgBox "Vérification OK"
        End If
        
    End If
    
End Sub
    
' effectue un certain nombre de contrôles, renvoie true si OK
Function TestElementConforme(swTestComp As SldWorks.Component2) As Boolean
    
    '---- Récupère le nom fichier sans le chemin et sans suffixe
    '---- Cherche le dernier "\" dans le chemain d'accès du fichier -----
    Position = InStrRev(swModel.GetPathName, "\")
                  
    ' Récupère seulement le nom du fichier + l'extension
    Resultat1 = Mid(swModel.GetPathName, Position + 1)
                  
    '---- Cherche le dernier "." dans resultat1 pour ensuite retirer l'extension et afficher que le nom du fichier
    Position2 = InStrRev(Resultat1, ".")
                  
    'MsgBox Left(Resultat1, Position2 - 1)
    NomSansSuffixe = Left(Resultat1, Position2 - 1)
                  
    
    '---------------------------------------------------------------
    '----Récupération de la valeur donné correspondante au Nom De La Propriété---
    '---------------------Afficher la valeur------------------------
    '---------------------------------------------------------------
    
    ValeurRéférence = swModel.GetCustomInfoValue("", "référence")
    'MsgBox "La référence est :" & vbCrLf & vbCrLf & ValeurRéférence, vbOKOnly, "Vérification"
    
    If ValeurRéférence <> "" Then
    
        ValeurDesc = swModel.GetCustomInfoValue("", "description")
        'MsgBox "Le nom du fichier est :" & vbCrLf & vbCrLf & ValeurDesc, vbOKOnly, "Vérification"
                       

        REF_Et_DESC = ValeurRéférence & "_" & ValeurDesc
             
        If REF_Et_DESC = NomSansSuffixe Then
            
            'MsgBox "La description est identique au nom :" & vbCrLf & vbCrLf & REF_Et_DESC & vbCrLf & vbCrLf & NomSansSuffixe, vbQuestion, "Vérification"
            'MsgBox "Vous pouvez continuer"
        
        Else
            
            MsgBox "Les valeurs ne sont pas cohérentes avec le nom de fichier référencé" & vbCrLf & vbCrLf & "Veuillez vérifier votre fichier" & vbCrLf & vbCrLf & NomSansSuffixe
            TestElementConforme = False
            MsgBox "On sort de la position 3"
            End
        
        End If
    End If
            
    ' Vérifie que le nom de fichier ne dépasse pas 50 caractères
    If Len(NomSansSuffixe) > 50 Then
        MsgBox "Votre Nom de fichier est trop long !" & vbCrLf & vbCrLf & "Veuillez vérifier votre fichier" & vbCrLf & vbCrLf & NomSansSuffixe
        TestElementConforme = False
        MsgBox "On sort de la position 4"
        End
    End If
                                     
    TestElementConforme = True
                  
End Function





J'ai donc trouvé ce qui me fallait avec pas mal de test foireux, mon tuteur est satisfait du résultat donc merci de vôtre aide quand même, ma macro a fonctionné ce matin ^^