Oh! , I hadn't even noticed that the AI had allowed itself to modify my code! But it will teach me not to reread! I had just asked the AI to add comments in the code:
To understand the macro years later...
To help the " uninitiated " understand how it works and how it works in a global way.
I completely agree with you about the " On Error ", it also makes my little heart bleed... And I much prefer a good old one debug.printand step-by-step tests to analyze my codes...
Of course not, she herself doesn't seem to me to be very constant in her hallucinations and conversational follow-ups (goldfish syndrome probably).
Here is the code commented with the messages to the user:
Option Explicit
Dim PrtPath As String
Dim AsmPath As String
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swDrawModel As SldWorks.ModelDoc2
Dim swDrawModelDocExt As ModelDocExtension
Dim swDrawCustProp As CustomPropertyManager
Dim swDrawDoc As SldWorks.DrawingDoc
Dim swDrawView As SldWorks.View
Dim DrawVal As String
Dim DrawRevision As String
Dim DrawBool As Boolean
Dim swRefModel As SldWorks.ModelDoc2
Dim swRefPath As String
Dim swRefModelDocExt As ModelDocExtension
Dim swRefCustProp As CustomPropertyManager
Dim RefReturn As Integer
Dim RefBool As Boolean
Dim RefVal As String
Dim RefRevision As String
Dim RefDocType As swDocumentTypes_e
Dim FileError As Long
Dim FileWarning As Long
Set swApp = Application.SldWorks
Set swDrawModel = swApp.ActiveDoc
'Vérifie que le document actif ne soit pas vide
If swDrawModel Is Nothing Then
swApp.SendMsgToUser2 "Ouvrir un fichier mise en plan", swMbWarning, swMbOk
Exit Sub
End If
'Vérifie que le document est une mise en plan
If swDrawModel.GetType <> swDocDRAWING Then 'swDocASSEMBLY, swDocPART
swApp.SendMsgToUser2 "Ouvrir un fichier mise en plan", swMbWarning, swMbOk
Exit Sub
Else
'Utilise la fonction RefDocTypeSearch
RefDocType = RefDocTypeSearch(swDrawModel.GetPathName)
'Ouvre le document en fonction de son type
Select Case RefDocType
Case swDocPART
Set swRefModel = swApp.OpenDoc6(PrtPath, swDocPART, swOpenDocOptions_Silent, "", FileError, FileWarning)
Debug.Print "PrtPath = " & PrtPath
Debug.Print "FileError = " & FileError
Debug.Print "FileWarning = " & FileWarning
Case swDocASSEMBLY
Set swRefModel = swApp.OpenDoc6(AsmPath, swDocASSEMBLY, swOpenDocOptions_Silent, "", FileError, FileWarning)
Debug.Print "AsmPath = " & AsmPath
Debug.Print "FileError = " & FileError
Debug.Print "FileWarning = " & FileWarning
End Select
'Vérifie que le fichier ouvert n'est pas vide
If Not swRefModel Is Nothing Then
swRefPath = swRefModel.GetPathName
'Vérifie que le fichier existe
If IsFileExist(swRefModel.GetPathName) Then
Set swDrawModelDocExt = swDrawModel.Extension
Set swDrawCustProp = swDrawModelDocExt.CustomPropertyManager("")
'Lecture de la propriété "Révision" de la mise en plan
DrawBool = swDrawCustProp.Get4("Révision", False, DrawVal, DrawRevision)
Debug.Print "DrawBool = " & DrawBool
Debug.Print "DrawRevision = " & DrawRevision
Set swRefModelDocExt = swRefModel.Extension
Set swRefCustProp = swRefModelDocExt.CustomPropertyManager("")
'Modifie la propriété "Révision" du document lié à la mise en plan
RefReturn = swRefCustProp.Set("Révision", DrawRevision)
Debug.Print "RefReturn = " & RefReturn
'Vérifie la propriété "Révision" du document lié à la mise en plan
RefBool = swRefCustProp.Get4("Révision", False, RefVal, RefRevision)
Debug.Print "RefModelPath = " & swRefModel.GetPathName
Debug.Print "RefBool = " & RefBool
Debug.Print "RefRevision = " & RefRevision
'Envoie du message de réussite
swApp.SendMsgToUser2 "Le fichier : " & swRefModel.GetPathName & " à été modifié" & vbCrLf & vbCrLf & "Voici les résultats :" & vbCrLf & "La propriété révision de la mise en plan : " & DrawRevision & vbCrLf & "La propriété révision du document : " & RefRevision, swMbWarning, swMbOk
Else
swApp.SendMsgToUser2 "Le fichier lié à la mise en plan n'existe pas", swMbWarning, swMbOk
Exit Sub
End If
Else
swApp.SendMsgToUser2 "Le fichier lié à la mise en plan est vide", swMbWarning, swMbOk
Exit Sub
End If
End If
End Sub
'Créée le cheminn pour une pièce et un assemblage et envoie le type de document à partir du chemin de la mise en plan
Function RefDocTypeSearch(DrawPath As String) As swDocumentTypes_e
Dim DrawPathLow As String
'Transforme l'ensemble des caractères du chemin en minuscule
DrawPathLow = LCase(DrawPath)
Debug.Print "DrawPath = " & DrawPath
Debug.Print "DrawPathLow = " & DrawPathLow
'Remplace l'extension de la mise en plan pour créer un chemin d'une pièce et d'un assemblage
PrtPath = Replace(DrawPathLow, "slddrw", "sldprt")
AsmPath = Replace(DrawPathLow, "slddrw", "sldasm")
'Vérifie si les chemins existent en renvoi le type de document
If IsFileExist(PrtPath) Then
RefDocTypeSearch = swDocPART
Exit Function
End If
If IsFileExist(AsmPath) Then
RefDocTypeSearch = swDocASSEMBLY
End If
End Function
Function IsFileExist(FullName As String) As Boolean
'Vérifie l'existence d'un fichier
IsFileExist = Dir(FullName) <> ""
End Function
, I hadn't even noticed that the AI had allowed itself to modify my code!
