Hello
I would like to know if anyone has a Macro that allows you to fill in the custom properties of a part with information present in a text file (.txt, .ini or other)
I found this discussion, but the solution proposed by Filipe Wenceslau seems to be written in a different language than VBA
Initially I wanted to do this from an excel but the KeyManager license is causing me problems
For my part I have this in 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
To read:
To write:
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
I also have this snippet of code to write in a csv.
For the reading part I'll let you do some research, it's possible but I have nothing at hand:
'*** 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
Or again:
https://www.codestack.net/solidworks-api/document/assembly/components/export-positions/
Or also:
https://chandoo.org/forum/threads/how-to-read-data-from-a-csv-file-and-write-the-same-in-the-active-worksheet-using-macro.37896/
Hoping to have put you on the right track for your needs.
Thank you sbadenis
I'm trying to modify your first code to adapt it to my needs.
for the moment, the code stops on Dim oXML As MSXML2. DOMDocument: An undefined user-defined type.
The form does not open yet. Is the purpose of the form to choose the XML file? Personally, I don't want a dialog box, everything must happen automatically. I prefer to write the path of the xml in the macro
No, my code asked me a question, but it's in my code.
Have you added the reference to MicrosoftXML 3.0?
Otherwise I found this example tested and approved:
' 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:
The purpose of this xml file for me was precisely to have a dialog box with different saved options depending on the choice of customization of the "user"
EDIT: The initial topic that made me write the 1st macro and the tests above:
https://www.lynkoa.com/forum/solidworks/macro-vba-pour-ecrire-et-lire-un-fichier-xml
I enabled xml3, and now it's stuck a little further, after CommandButtonExec.SetFocus in userform : error 424: object required
Indeed, my goal may be too far from this macro to modify it. If someone else has something else to offer, the subject remains open.
Just get inspired by the last 2 macrso read and write in the post above it's functional and no need for anything else.
After the xml format can be modified with some searches in csv or xls or other format.
For my use the xml suited me very well. Depending on your needs you should be able to adapt these last 2 macros
Write who you create the directory if non-existent, the file Essai.xml and who writes the 3 options for my case (to be tested and then replaced by your values)
You can then check the existence of the file and its contents.
Then if you press play it displays you in via debug the lines contained in the xml file.
After all, it obviously depends on the amount of data and the form of what you want stored in your file, for your use xml may not be the most appropriate.
Well, I think it's beyond my level.
The xml suits me well because this file will be created by a web app.
In the xml there will be between 10 and ... Let's say 40 max line, with a custom property name, and a numeric value for each property.
The custom properties already exist in my SW document, the macro must update the value based on xml, without requiring any validation from the user (we consider that the xml file is present in the place specified in the macro)
Starting from scratch, how much (ladleful) working time can such a development take?
It all depends on your level.
For my part, as a beginner as well, I would say between 3 hours and 1 day approximately.
I guess the xml will be created by the web app.
So you just have to read the xml file, retrieve all the variables and store them in an array for example, then you have to modify the part or assembly with the recovered properties.
Break down your code for each desired function and then try to put it together. At the beginning it's complicated and little by little we get there.
For the properties, is it custom or configuration-specific properties?
If you're a beginner, then I can be considered ignorant. Variable, declaration, array loop... I don't understand a thing. I look in vain for tutorials for beginners.
This is for custom properties.
For everything that tutorials start with tutorials in Excel to learn variables, loops, arrays...
For my part, I started 2-3 years ago with the one that is very good for learning the basics of VBA:
https://www.excel-pratique.com/fr/vba/
For solidworks and the VBA there is this site (in English but understandable):
https://thecadcoder.com/vba/vba-Introduction/
For your macro post us an example of xml file and part (If you want to protect your part post an example with the same properties even if the shape has nothing to do with it)
And I'll see if I have time if it's complicated. If you try, you can't. Start small and you will progress and if necessary you can ask questions about here.
Great thanks for the vba xls tutorial. I didn't think I'd learn so many things that are also in sw. It's the basic grammar that I was missing. And that's just the beginning!
Shall I go back;)
Hello again
I worked a little bit on the links, and I started by starting with the simplest: 4 lines in an excel.
Here's my 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
It pretty much works. The macro will read the first 4 rows, delete the property if it already exists, and recreate it with the values in the array. the opening of the painting is invisible, it seems to close at the end.
BUT, from time to time, I get runtime error 1004: the 'selection' method of the object '_Global' failed just as we started to act on the properties of the SW file. I don't understand where it comes from.
Sometimes it's another error message. Sometimes the excel file gets stuck in read-only. In short, it's not stable.
My next improvements will be to make a loop to process all the non-empty rows of the excel table, and make a version of this macro to integrate into the excel file for a "manual" method of updating properties.
Without the excel file and a part, even empty, but with the desired properties, it's complicated to answer.
On this error here is a lead:
https://fr.teamaftermarket.com/303-vba-1004-error
Maybe you're pointing to an empty or non-existent cell. Or this error 1004, if assigned to SW may be due to a non-existent property and therefore impossible to delete. It would be good to dig deeper to understand why.
Otherwise to ignore it you can add an "On error next" on the previous line which could help.
If it detects an error on the line following the on errror next, it ignores the row in error and moves on to the next one.
2 links on this order:
https://docs.microsoft.com/fr-fr/dotnet/visual-basic/language-reference/statements/on-error-statement
https://www.educba.com/vba-on-error-resume-next/
See also this topic to help you debug your macro:
https://www.lynkoa.com/forum/3d/incomprehension-exportation-fichier-excel?page=1