Hallo, ik heb nog steeds hulp nodig, ik ben stagiair in een bedrijf en ik begrijp niet veel van het lussysteem hoe ik ze op de juiste manier moet aantrekken
Mijn doel is om de naam van het bestand op te halen, het te controleren (beschrijving, eigenschap, referentie) zodra deze stap is voltooid om te controleren of er andere onderdelen/assemblage in het bovenliggende bestand zijn, zo ja, het voert de controle opnieuw uit voor elk subbestand "onderdeel" of "assemblage", zo niet geen subbestanden, Het gaat terug naar boven en gaat naar het volgende deel, en voert vervolgens dezelfde procedure opnieuw uit voor elk bestand
Ik heb al alle commando's voor de info, maar dan is het hoe ik het in een lus krijg
Dank u voor uw hulp.
Als er nog andere vragen zijn, stel ze me dan
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
Ik plaats mijn vraag opnieuw omdat ik deze heb gevalideerd zonder dat het de bedoeling was
En aangezien ik niet weet of we na validatie kunnen antwoorden, bied ik mijn excuses aan.
Nogmaals bedankt voor je hulp