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
Het ideaal zou zijn om uw code (of stukjes code) te posten via de toegewezen tag:
Kies dan voor VBscrip.
Dan is het makkelijker om je te helpen.
Als ik het goed heb begrepen van een assemblage, wilt u elk onderdeel of subassemblage analyseren door te controleren of de beschrijving, eigenschap en referentie bestaan, of goed geïnformeerd zijn?
Wat doe je als het niet het geval is een simpele msgbox of moet je ook een rapport maken waarbij de onderdelen, samenstellingen niet of slecht geïnformeerd zijn?
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
Ja dat klopt, ik moet elke keer "de vloer" controleren en als het goed is, controleer ik wat er in zit door te controleren of wat erin zit voldoet en dat er naar alles wordt verwezen en als het goed is, ga ik terug naar boven en ga ik verder naar de volgende kamer enz,
En als hij een inconsistentie vindt, zou ik graag willen dat hij me vertelt dat er een fout is, msgbox "Inconsistentie .... enz., ik stop de macro"
en zodra de gebruiker de fout heeft gecorrigeerd, start hij de macro opnieuw op
