Sprawdzanie plików za pomocą pętli VBA SolidWorks

Witam, nadal potrzebuję pomocy, jestem stażystą w firmie i niewiele rozumiem z systemu pętli, jak je prawidłowo założyć

Moim celem jest pobranie nazwy pliku, sprawdzenie go (opis, właściwość, odniesienie) po zakończeniu tego kroku sprawdzania, czy w pliku nadrzędnym znajdują się inne części/złożenie, jeśli tak, ponawia sprawdzanie dla każdego podzbioru "część" lub "zespół", jeśli nie ma żadnych podplików, Wraca do góry i przechodzi do następnej części, a następnie ponownie wykonuje tę samą procedurę dla każdego pliku

Mam już wszystkie polecenia dotyczące informacji, ale potem jest jak umieścić to w pętli

Dziękuję za pomoc.

Jeśli masz inne pytania, zadaj mi

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

Publikuję ponownie moje pytanie, ponieważ potwierdziłem je bez zamiaru

A ponieważ nie wiem, czy możemy odpowiedzieć po walidacji, przepraszam.

Jeszcze raz dziękuję za pomoc

Witam

Jeśli chcesz zaoszczędzić czas, w pakiecie myCADtools znajduje się narzędzie, które Ci to umożliwia.

Możesz tworzyć raporty, aby wyświetlić listę wszystkich plików, które są niespójne na podstawie ich wartości właściwości nazwy pliku, ... a nawet poprawiać błędy.

To jest narzędzie do integracji: https://help.visiativ.com/mycadtools/2022/fr/Integration.html

Możesz przetestować myCADtools bezpłatnie przez 30 dni, aby uzyskać pomysł

https://www.lynkoa.com/mycadtools

Philippe

 

1. uwaga nie trzeba wkładać msgbox, aby zobaczyć wartość zmiennej, wystarczy zrobić debug.print (zobacz zasadę dla excela, ale pozostaje taka sama w Sw:

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

Aby zobaczyć wartość debug.print, musisz wykonać okno wyświetlania, wykonywania w edytorze vba. Wartość zostanie wyświetlona w oknie Wykonanie. W razie potrzeby uruchom kod krok po kroku (F8).

Wtedy zobaczysz, że nazwa  każdej części lub podzespołu pojawia się już w tym oknie dzięki debug.print w funkcji TraverseComponents.

 

I że twój kod powinien być zastosowany w tej funkcji (TraverseComponents) na obiekcie swChildComp, a nie w main na swmodel, który jest głównym zestawem.

Aby zrozumieć, po uruchomieniu funkcji main dociera ona do funkcji TraverseComponents swRootComp, 1

Wystrzeliwuje więc łódź podwodną o tej samej nazwie i to właśnie w tej łodzi podwodnej zamiata każdą część i zespół.

Pozwolę Ci przyjrzeć się bardziej szczegółowo, nie za dużo czasu na zagłębienie się dzisiaj.

Wyślij nam swój ostateczny kod, jeśli możesz to zrobić lub gdzie utkniesz z nowymi wskazaniami.

 

 

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





Więc znalazłem to, czego potrzebowałem z wieloma niepomieszanymi testami, mój nauczyciel jest zadowolony z wyniku, więc i tak dziękuję za pomoc, moje makro działało dziś rano^^