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
Tak, zgadza się, za każdym razem muszę sprawdzać "podłogę" i jeśli jest dobra, sprawdzam, co zawiera, sprawdzając, czy to, co jest w środku, jest zgodne i czy wszystko jest odniesione, a jeśli jest dobrze, wracam na górę i przechodzę do następnego pokoju itp.,
A jeśli znajdzie niespójność, chciałbym, żeby powiedział mi, że jest błąd, msgbox "Niespójność .... itd., zatrzymuję makro"
a gdy Użytkownik poprawi błąd, ponownie uruchamia makro
