Oh! , ik had niet eens gemerkt dat de AI zichzelf had toegestaan mijn code aan te passen! Maar het zal me wel leren om niet opnieuw te lezen! Ik had de AI net gevraagd om opmerkingen toe te voegen aan de code:
Om de macro jaren later te begrijpen...
Om de " oningewijden " te helpen begrijpen hoe het werkt en hoe het op een globale manier werkt.
Ik ben het helemaal met je eens over de " On Error ", het laat mijn kleine hart ook bloeden... En ik geef veel de voorkeur aan een ouderwetse en debug.printstapsgewijze tests om mijn codes te analyseren...
Natuurlijk niet, zij zelf lijkt mij niet erg constant te zijn in haar hallucinaties en gesprekken (waarschijnlijk goldfish-syndroom).
Hier is de code die bij de berichten aan de gebruiker is gereageerd:
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
, ik had niet eens gemerkt dat de AI zichzelf had toegestaan mijn code aan te passen!
