Bonjour
Je voudrais savoir si quelqu'un à sous le coude une Macro qui permette de remplir les propriétés personnalisées d'une pièce avec des info présentes dans un fichier texte (.txt , .ini ou autre)
J'ai trouvé cette discussion, mais le solution proposée par Filipe Venceslau semble être écrite dans une autre langage que le VBA
Initialement je voulais faire ca depuis un excel mais la licenceKeyManager me pose des problèmes
Pour ma part j'ai ça en xml:
Option Explicit
'Ajouter la référence à MicrosoftXML v3.0
' Ajout déclaration pour vérif type de documents
Global Const nomfichierXML = "SaveMacroIndice.xml"
Global sPathXML, sPathNameXML As String
Global FileTyp As Long
Global Source As String
Global FichierXml As String
Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swAssembly As SldWorks.AssemblyDoc
Dim Designation As String
Dim Compteur As String
Dim OldIndice As String
Global Indice As String
Dim Filename As String
Dim Filepath As String
Dim File As String
Dim Extension As String
Dim path As String
Dim fso As Object
Dim bRet As Boolean
Dim PathMep As String
Dim swCustProp As CustomPropertyManager
Dim swDocType As Variant
Dim fileerror As Long
Dim filewarning As Long
Dim doc As SldWorks.ModelDoc2
Sub main()
Set swApp = Application.SldWorks
sPathXML = Environ("USERPROFILE") & "\.SaveMacroSldworks\"
sPathNameXML = sPathXML & nomfichierXML
Debug.Print sPathXML & nomfichierXML
'On vérifie si le dossier de sauvegarde existe sinon crétion de ce dossier
If Dir(sPathXML, vbDirectory + vbHidden) = "" Then
Debug.Print "Création du dossier: " & sPathXML
MkDir sPathXML
End If
FichierXml = sPathXML & nomfichierXML
Debug.Print "Fichier xml:" & FichierXml
' on affiche le useforms
UserformOptionsMacro.Show
End Sub
'Ci dessous le userform pour la lecture:
'Initialisation du formulaire
Private Sub UserForm_Initialize()
'position du userform par rapport à la fenêtre (1= centré/fenêtre 2= centré écran, 3=angle en haut à gauche)
'Me.StartUpPosition = 0
Me.StartUpPosition = 2 - CenterScreen
'UserformOptionsMacro.Left = Activewindow.Left + Activewindow.Width / 2 - UserformOptionsMacro.Width / 2
'initialisation du userform
CommandButtonExec.SetFocus
'On parcours le fichier xml pour récupérer les valeures sauvegardées.
Debug.Print "Fichier xml:" & FichierXml
If Dir(FichierXml) = "" Then
Debug.Print "Pas de fichier xml trouvé -> les valeures par défaut seront sélectionnées"
CheckBoxLectureSeule = True
CheckBoxCouleur = True
CheckBoxDesignation = True
CheckBoxCacherPlan = True
CheckBoxCacherPièce = True
CheckBoxRevision = False
Else
Debug.Print "Fichier xml trouvé -> les valeures sauvegardées seront sélectionnées"
Dim oXML As MSXML2.DOMDocument
Dim oNode As MSXML2.IXMLDOMNode
Set oXML = New MSXML2.DOMDocument
oXML.async = False
oXML.Load FichierXml
For Each oNode In oXML.documentElement.childNodes
For Each osubnode In oNode.childNodes
Debug.Print " - " & oNode.baseName, "=" & osubnode.Text
If oNode.baseName = "CheckBoxLectureSeule" Then CheckBoxLectureSeule = osubnode.Text
If oNode.baseName = "CheckBoxCouleur" Then CheckBoxCouleur = osubnode.Text
If oNode.baseName = "CheckBoxDesignation" Then CheckBoxDesignation = osubnode.Text
If oNode.baseName = "CheckBoxCacherPlan" Then CheckBoxCacherPlan = osubnode.Text
If oNode.baseName = "CheckBoxCacherPièce" Then CheckBoxCacherPièce = osubnode.Text
If oNode.baseName = "CheckBoxRevision" Then CheckBoxRevision = osubnode.Text
Next
Next
End If
End Sub
Pour lire:
Pour écrire:
Sub CreationCompleteXML() 'Création du fichier xml de sauvegardes des paramètres du menu options
Dim oXML As Object
Dim oNode As Object
Dim root As Object
Dim elem As Object
Dim rel As Object
Set oXML = New MSXML2.DOMDocument
Set oNode = oXML.createProcessingInstruction("xml", "version=""1.0"" encoding=""ISO-8859-1""")
oXML.appendChild oNode
With oXML.appendChild(oXML.createElement("OPTIONS"))
.appendChild oXML.createTextNode(vbCrLf)
.appendChild oXML.createTextNode(vbTab)
With .appendChild(oXML.createElement("CheckBoxLectureSeule"))
.Text = IIf(UserformOptionsMacro.CheckBoxLectureSeule.Value = 0, "False", "True")
End With
.appendChild oXML.createTextNode(vbCrLf)
.appendChild oXML.createTextNode(vbCrLf)
.appendChild oXML.createTextNode(vbTab)
With .appendChild(oXML.createElement("CheckBoxCacherPièce"))
.Text = IIf(UserformOptionsMacro.CheckBoxCacherPièce.Value = 0, "False", "True")
End With
.appendChild oXML.createTextNode(vbCrLf)
.appendChild oXML.createTextNode(vbTab)
With .appendChild(oXML.createElement("CheckBoxCacherPlan"))
.Text = IIf(UserformOptionsMacro.CheckBoxCacherPlan.Value = 0, "False", "True")
End With
.appendChild oXML.createTextNode(vbCrLf)
.appendChild oXML.createTextNode(vbTab)
With .appendChild(oXML.createElement("CheckBoxDesignation"))
.Text = IIf(UserformOptionsMacro.CheckBoxDesignation.Value = 0, "False", "True")
End With
.appendChild oXML.createTextNode(vbCrLf)
.appendChild oXML.createTextNode(vbTab)
With .appendChild(oXML.createElement("CheckBoxCouleur"))
.Text = IIf(UserformOptionsMacro.CheckBoxCouleur.Value = 0, "False", "True")
End With
.appendChild oXML.createTextNode(vbCrLf)
.appendChild oXML.createTextNode(vbTab)
With .appendChild(oXML.createElement("CheckBoxRevision"))
.Text = IIf(UserformOptionsMacro.CheckBoxRevision.Value = 0, "False", "True")
End With
.appendChild oXML.createTextNode(vbCrLf)
End With
oXML.Save FichierXml
End Sub
J'ai également ce bout de code pour écrire dans un csv.
Pour la partie lecture je te laisse faire des recherche, c'est possible mais j'ai rien sous la main:
'*** Macro à utiliser dans un assemblage afin de récuperer dans le bloc note un fichier texte avec la liste de toutes les pièces exclus de la nomenclature***
Sub main()
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim bRet As Boolean
Dim MyPath As String
Dim MyFolder As String
Set swApp = Application.SldWorks
Set Assembly = swApp.ActiveDoc
Set myAsy = Assembly
Set swModel = swApp.ActiveDoc
'**********Chemin d'export MEP**********
'*******Récup chemin existant***********
MyFolder = CurDir$
Debug.Print "Current Folder = " & MyFolder
soutputfile = MyFolder & "\Exclu.txt"
Debug.Print soutputfile
Set fso = CreateObject("Scripting.FileSystemObject")
'On créer le fichier .txt
Set FileList = fso.CreateTextFile(soutputfile, 8, -2)
myCmps = myAsy.GetComponents(False)
'On boucle sur tous lec composants
For i = 0 To UBound(myCmps)
Set myCmp = myCmps(i)
'On écrit le nom de chaque pièce ou assemblage excle de la nomenclature
If myCmp.ExcludeFromBOM Then
FileList.Write myCmp.Name2 & vbCrLf
End If
Next i
Ou encore:
https://www.codestack.net/solidworks-api/document/assembly/components/export-positions/
Ou aussi:
https://chandoo.org/forum/threads/how-to-read-data-from-a-csv-file-and-write-the-same-in-the-active-worksheet-using-macro.37896/
En espérant t'avoir mis sur la bonne piste pour ton besoin.
Merci sbadenis
J'essaie de modifier ton premier code pour l'adapter à mon besoin.
pour le moment, le code s'arrête sur Dim oXML As MSXML2.DOMDocument : type défini par l'utilisateur non défini.
le formulaire ne s'ouvre pas encore. est ce que le but du formulaire est de choisit le fichier xml? perso, je ne veux pas de boite de dialogue, tout doit se passer automatiquement. je préfère écrir le chemin du xml dans la macro
Non mon code me posait une question mais c'est dans mon code.
As tu bien ajouté la référence a MicrosoftXML 3.0 ?
Sinon j'ai retrouvé cet exemple testé et approuvé:
' Add a reference to Microsoft Scripting Runtime (click Tools > References > Browse > C:\windows\system32\scrrun.dll.
Sub ecrire()
'Exemple XML attribute: <Counter name="Incrementing0" Version="1" id="Incrementing0" Auto="0" AutoName="" type="1" RangeCounter="False" RangeDate="23/12/2019">
Dim swApp As SldWorks.SldWorks
Dim sPathName As String
Dim fso As Scripting.FileSystemObject
Dim XMLfile As Scripting.TextStream
Set swApp = Application.SldWorks
sPath = Environ("USERPROFILE") & "\Essai\"
sPathName = sPath & "Essai.xml"
Debug.Print sPathName
'On vérifie si le dossier existe sinon on le créé
If Dir(sPath, vbDirectory + vbHidden) = "" Then
'If Dir(sPath) = "" Then
Debug.Print "Création du dossier: " & sPath
MkDir sPath
End If
'sPathName = sPathName + ".xml"
Set fso = CreateObject("Scripting.FileSystemObject")
Set XMLfile = fso.CreateTextFile(sPathName, True, -1)
XMLfile.WriteLine "<OPTIONS>"
XMLfile.WriteLine " <Option 1=" & Chr(34) & True & Chr(34) & ">"
XMLfile.WriteLine " <Option 2=" & Chr(34) & True & Chr(34) & ">"
XMLfile.WriteLine " <Option 3=" & Chr(34) & False & Chr(34) & ">"
XMLfile.WriteLine "</OPTIONS>"
XMLfile.Close
End Sub
Sub lire()
Dim swApp As SldWorks.SldWorks
Dim sPathName As String
Dim fso As Scripting.FileSystemObject
Dim XMLfile As Scripting.TextStream
Set swApp = Application.SldWorks
sPath = Environ("USERPROFILE") & "\Essai\"
sPathName = sPath & "Essai.xml"
Set fso = CreateObject("Scripting.FileSystemObject")
'Ajouter la gestion d'erreur si fichier introuvable
Set XMLfile = fso.OpenTextFile(sPathName, ForReading, True, TristateFalse)
'Read till the end
Do Until XMLfile.AtEndOfStream
Debug.Print "Printing line " & XMLfile.Line
Debug.Print XMLfile.ReadLine 'Print a line from the file
Loop
XMLfile.Close
End Sub
Edit:
Le but de ce fichier xml pour moi était justement d'avoir une boite de dialogue avec différentes options de sauvegardé en fonction du choix du personnalisation du "user"
EDIT: Le sujet initial qui m'avais fais écrire la 1ère macro et les test ci-dessus:
https://www.lynkoa.com/forum/solidworks/macro-vba-pour-ecrire-et-lire-un-fichier-xml
j'ai activé xml3, et maintenant ça coince un peu plus loin, aprés CommandButtonExec.SetFocus dans userform : erreur 424 : objet requis
En effet, mon objectif est peut etre trop loin de cette macro pour la modifier. Si quelqu'un a autre chose à proposer, le sujet reste ouvert.
Inspire toi juste des 2 dernières macrso lire et écrire dans le poste ci-dessus c'est fonctionnel et pas besoin d'autre chose.
Après le format xml peut être modifier avec quelques recherches en csv ou xls ou autre format.
Pour mon utilisation le xml m'allait très bien. Suivant ton besoin tu devrait pouvoir adapter ces 2 dernières macros
Ecrire qui te créer le répertoire si non existant, le fichier Essai.xml et qui ecrit les 3 options pour mon cas (à tester puis remplacer par tes valeurs)
Tu peux ensuite vérifier l'existence du fichier et de son contenu.
Ensuite si tu appuie sur lire il t'affiche dans via debug les lignes contenues dans le fichier xml.
Après tout dépend évidement de la quanité de données et la forme de ce que tu veux stockées dans ton fichier, pour ton utilisation le xml est peut être pas le plus approprié.
Bon, je pense que ça dépasse mon niveau.
Le xml me convient bien car ce fichier sera créé par une appli web.
Dans le xml il y aura entre 10 et ... disons 40 ligne maxi, avec un nom de propriété personnalisées, et une valeur numérique pour chaque propriété.
Les propriétés personnalisées existent déjà dans mon document SW, la macro doit mettre à jour la valeur sur la base su xml, sans demander aucune validation à l'utilisateur (on considère que le fichier xml est bien présent à l'endroit spécifié dans la macro)
En partant de rien, combien de temps de travail (à la louche) peut prendre un tel développement ?
Tout dépend de ton niveau.
Pour ma part en tant que débutant également, je dirais entre 3h et 1 journée environ.
Je suppose que le xml sera créer par l'appli web.
Il suffit donc de lire le fichier xml de récupérer toutes les variables et de les stocker dans une array par exemple, puis il faut modifier la pièce ou assemblage avec les propriétés récupérés.
Décompose ton code pour chaque fonction désiré et ensuite tu essaie de la rassembler. Au début c'est compliqué et petit à petit on y arrive.
Pour les propriétés c'est des propriétés personnalisé ou spécifique à la configurations?
Si tu est débutant, alors on peut considérer que je suis ignorant. Variable, déclaration, boucle array... je n'y comprends rien. je cherche en vain des tuto pour débutant.
c'est pour des propriétés personnalisées.
Pour tout ce qui tuto commence par des tuto sous Excel afin d'apprendre les variable, boucle, array...
Pour ma part j'ai commencé il y a 2-3 ans avec celui qui est très bien pour apprendre les bases du VBA:
https://www.excel-pratique.com/fr/vba/
Pour solidworks et le VBA il y a ce site (en anglais mais compréhensible):
https://thecadcoder.com/vba/vba-Introduction/
Pour ta macro poste nous un exemple de fichier xml et de pièce (Si tu veux protéger ta pièce poste un exemple avec les mêmes propriétés même si la forme n'a rien à voir)
Et je regarderais si j'ai le temps si c'est compliqué. Si on essai, pas on y arrive pas. Commence petit et tu progressera et au besoin tu peux poser des questions sur ici.
Super merci pour le tuto vba xls. Je pensais pas que je aprendrais autant de choses qui se trouvent aussi dans sw. C'est la grammaire de base qui me manquait. et c'est que le début !
J'y retourne ;)
Rebonjour
J'ai un peu potassé les liens, et je me suis lancé en commancant par le plus simple : lescture de 4 lignes dans un excel.
voici mon code
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim retval As String
' dim ajouté selon https://www.lynkoa.com/en/forum/mod%C3%A9lisation-volumique-3d/lecture-dune-valeur-dans-excel-via-sw-et-r%C3%A9cup%C3%A9ration-dune-r%C3%A9f%C3%A9rence
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim exSheet As Excel.Worksheet
Dim i As Integer
'On ouvre l'aplication Excel
Set xlApp = New Excel.Application
xlApp.Visible = False
'On ouvre le fichier Excel
Set xlWB = xlApp.Workbooks.Open("C:\Users\nouveau\Documents\Patrons_sur_mesure\Test_macros\Edit Custom Properties.xlsx")
Set exSheet = xlWB.ActiveSheet
xlApp.Visible = False
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
retval = swModel.DeleteCustomInfo(Cells(1, 1))
retval = swModel.AddCustomInfo2(Cells(1, 1), swCustomInfoText, Cells(1, 2))
retval = swModel.DeleteCustomInfo(Cells(2, 1))
retval = swModel.AddCustomInfo2(Cells(2, 1), swCustomInfoText, Cells(2, 2))
retval = swModel.DeleteCustomInfo(Cells(3, 1))
retval = swModel.AddCustomInfo2(Cells(3, 1), swCustomInfoText, Cells(3, 2))
retval = swModel.DeleteCustomInfo(Cells(4, 1))
retval = swModel.AddCustomInfo2(Cells(4, 1), swCustomInfoText, Cells(4, 2))
'fermeture de Excel
xlWB.Close
xlApp.Quit
Set exSheet = Nothing
Set xlWB = Nothing
Set xlApp = Nothing
End Sub
Ca fonctionne a peu près. La macro va bien lire les 4 première lignes, supprime la propriété si elle existe deja, et la recréé avec les valeur dans le tableau. l'ouverture du tableau est invisible, il semble se refermer à la fin.
MAIS, de temps en temps, j'ai une erreur d'exécution 1004 : la méthode 'selection' de l'objet '_Global' à échoué au moment ou on commence a agir sur les propriétées du fichier SW. Je ne comprends pas d'ou ça vient.
Parfois c'est un autre message d'erreur. Parfois le ficher excel reste bloqué en lecture seule. bref, c'est pas stable.
Mes prochaines améliorations consisteront à faire une boucle pour traiter toutes les lignes non vide du tableau excel, et faire une version de cette macro à intégrer dans le fichier excel pour une méthode "manuelle" de mise a jour des propriétées.
Sans le fichier excel et une pièce même vide mais avec les propriétés souhaités c'est compliqué de répondre.
Sur cette erreur voici une piste:
https://fr.teamaftermarket.com/303-vba-1004-error
Peut être que tu pointe vers une cellule vide ou inexistante. Ou bien cette erreur 1004, si attribué à SW est peut être du a une propriété inexistante et donc impossible à effacer. Ce serait bien d'approfondir pour comprendre pourquoi.
Sinon pour l'ignorer on peut ajouter un "On error next" sur la ligne précédente qui pourrait aider.
Si il détecte une erreur sur la ligne suivant le on errror next, il ignore la ligne en erreur et passe à la suivante.
2 liens sur cette commande:
https://docs.microsoft.com/fr-fr/dotnet/visual-basic/language-reference/statements/on-error-statement
https://www.educba.com/vba-on-error-resume-next/
Voir aussi ce sujet pour t'aider à debuger ta macro:
https://www.lynkoa.com/forum/3d/incomprehension-exportation-fichier-excel?page=1