Checking Files with a Solidworks VBA Loop

Hello, I still need help, I'm an intern in a company and I don't understand much about the loop system how to put them on properly

My goal is to retrieve the name of the file, check it (description, property, reference) once this step finishes checking if there are other parts/assembly in the parent file if yes it redoes the check for each subfile "part" or "assembly", if not no subfiles, it goes back up and goes to the next part, then does the same procedure again for each file

I already have all the commands for the info but then it's how to get it put in a loop

Thank you for your help.

If any other questions ask me

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

I'm reposting my question because I validated it without meaning to

And since I don't know if we can answer after validation, I apologize.

Thank you again for your help

Hello

If you want to save time, there is a tool in the myCADtools suite that allows you to do this.

You can create reports to list all the files that are inconsistent based on their filename property values, ... and even correct mistakes.

This is the Integration tool: https://help.visiativ.com/mycadtools/2022/fr/Integration.html

You can test myCADtools free of charge for 30 days to get an idea

https://www.lynkoa.com/mycadtools

Philippe

 

1st remark no need to put msgboxes to see the value of a variable, just do a debug.print (see the principle for excel but remains the same in Sw:

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

To see the value of the debug.print you have to do the display, execution window in the vba editor. The value will be displayed in the Execution window. If necessary, launch the code step by step (F8).

Then you will see that the name of  each part or sub-assembly already appears in this window thanks to the debug.print in the TraverseComponents function.

 

And that your code should be applied in this function (TraverseComponents) on the swChildComp object and not in the main on the swmodel which is the main assembly.

To understand when you run your main function it arrives at the TraverseComponents function swRootComp, 1

So he launches the sub of the same name and it is in this sub that he sweeps every part and assembly.

I'll let you look in more detail not too much time to go deeper today.

Send us your final code if you can do it or where you get stuck with the new indications.

 

 

1 Like
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





So I found what I needed with a lot of messed up tests, my tutor is satisfied with the result so thank you for your help anyway, my macro worked this morning^^