Hallo, ich brauche noch Hilfe, ich bin Praktikant in einer Firma und verstehe nicht viel über das Schlaufensystem, wie man sie richtig anlegt
Mein Ziel ist es, den Namen der Datei abzurufen und ihn zu überprüfen (Beschreibung, Eigenschaft, Referenz), sobald dieser Schritt abgeschlossen ist, um zu überprüfen, ob es andere Teile / Baugruppen in der übergeordneten Datei gibt, wenn ja, wird die Prüfung für jede Unterdatei "Teil" oder "Baugruppe" wiederholt, wenn keine Unterdateien, Es geht zurück nach oben und geht zum nächsten Teil, dann führt es das gleiche Verfahren für jede Datei erneut aus
Ich habe bereits alle Befehle für die Info, aber dann geht es darum, wie man sie in eine Schleife bringt
Danke für Ihre Hilfe.
Wenn Sie noch Fragen haben, fragen Sie mich
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
Ich poste meine Frage erneut, weil ich sie validiert habe, ohne es zu wollen
Und da ich nicht weiß, ob wir nach der Bestätigung antworten können, entschuldige ich mich.
Nochmals vielen Dank für Ihre Hilfe