Oh! , ich hatte nicht einmal bemerkt, dass die KI sich erlaubt hatte, meinen Code zu verändern! Aber es wird mir beibringen, nicht noch einmal zu lesen! Ich hatte die KI gerade gebeten, Kommentare in den Code einzufügen:
Um das Makro Jahre später zu verstehen...
Um den " Uneingeweihten " zu helfen, zu verstehen, wie es funktioniert und wie es global funktioniert.
Ich stimme dir mit dem " On Error " vollkommen zu, es lässt auch mein kleines Herz bluten... Und ich bevorzuge viel lieber einen guten alten und debug.printSchritt-für-Schritt-Tests, um meine Codes zu analysieren...
Natürlich nicht, sie selbst scheint mir nicht sehr konstant in ihren Halluzinationen und Gesprächen zu sein (wahrscheinlich Goldfisch-Syndrom).
Hier ist der Code, der mit den Nachrichten an den Nutzer kommentiert wurde:
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
, ich hatte nicht einmal bemerkt, dass die KI sich erlaubt hatte, meinen Code zu verändern!
