Hallo
Ik zou graag willen weten of iemand een macro heeft waarmee u de aangepaste eigenschappen van een onderdeel kunt invullen met informatie die aanwezig is in een tekstbestand (.txt, .ini of andere)
Ik heb deze discussie gevonden, maar de oplossing voorgesteld door Filipe Wenceslau lijkt in een andere taal te zijn geschreven dan VBA
In eerste instantie wilde ik dit vanuit een excel doen, maar de KeyManager-licentie levert me problemen op
Van mijn kant heb ik dit 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
Lees:
Schrijven:
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
Ik heb ook een stukje code om in een csv te schrijven.
Voor het leesgedeelte laat ik je wat onderzoek doen, het is mogelijk maar ik heb niets bij de 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
Of nog een keer:
https://www.codestack.net/solidworks-api/document/assembly/components/export-positions/
Of ook:
https://chandoo.org/forum/threads/how-to-read-data-from-a-csv-file-and-write-the-same-in-the-active-worksheet-using-macro.37896/
In de hoop u op het juiste spoor te hebben gezet voor uw behoeften.
Dank je wel sbadenis
Ik probeer uw eerste code aan te passen om deze aan mijn behoeften aan te passen.
op dit moment stopt de code op Dim oXML As MSXML2. DOMDocument: Een ongedefinieerd, door de gebruiker gedefinieerd type.
Het formulier wordt nog niet geopend. Is het doel van het formulier om het XML-bestand te kiezen? Persoonlijk wil ik geen dialoogvenster, alles moet automatisch gebeuren. Ik geef er de voorkeur aan om het pad van de xml in de macro te schrijven
Nee, mijn code stelde me een vraag, maar het staat in mijn code.
Heb je de verwijzing naar MicrosoftXML 3.0 toegevoegd?
Anders vond ik dit voorbeeld getest en goedgekeurd:
' 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
Bewerken:
Het doel van dit xml-bestand voor mij was juist om een dialoogvenster te hebben met verschillende opgeslagen opties, afhankelijk van de keuze van aanpassing van de "gebruiker"
EDIT: Het eerste onderwerp dat me deed schrijven van de 1e macro en de tests hierboven:
https://www.lynkoa.com/forum/solidworks/macro-vba-pour-ecrire-et-lire-un-fichier-xml
Ik heb xml3 ingeschakeld, en nu zit het een beetje verder vast, na CommandButtonExec.SetFocus in userform : error 424: object vereist
Inderdaad, mijn doel is misschien te ver van deze macro om het te wijzigen. Als iemand anders iets anders te bieden heeft, blijft het onderwerp open.
Laat je inspireren door de laatste 2 maanden, lees en schrijf in de post hierboven, het is functioneel en er is niets anders nodig.
Na het xml-formaat kan worden gewijzigd met sommige zoekopdrachten in csv of xls of een ander formaat.
Voor mijn gebruik beviel de xml mij heel goed. Afhankelijk van uw behoeften zou u in staat moeten zijn om deze laatste 2 macro's aan te passen
Schrijf wie je de directory maakt als deze niet bestaat, het bestand Essai.xml en wie schrijft de 3 opties voor mijn geval (te testen en vervolgens te vervangen door uw waarden)
U kunt dan het bestaan van het bestand en de inhoud ervan controleren.
Als u vervolgens op play drukt, wordt u weergegeven via debug de regels in het xml-bestand.
Het hangt immers natuurlijk af van de hoeveelheid gegevens en de vorm van wat u in uw bestand wilt opslaan, voor uw gebruik is xml misschien niet het meest geschikt.
Nou, ik denk dat het mijn niveau te boven gaat.
De xml bevalt me goed omdat dit bestand door een web-app wordt gemaakt.
In de xml zullen er tussen de 10 en ... Laten we zeggen een regel van maximaal 40, met een aangepaste eigenschapsnaam en een numerieke waarde voor elke eigenschap.
De aangepaste eigenschappen bestaan al in mijn SW-document, de macro moet de waarde bijwerken op basis van xml, zonder dat er enige validatie van de gebruiker nodig is (we gaan ervan uit dat het xml-bestand aanwezig is op de plaats die in de macro is opgegeven)
Van nul beginnen, hoeveel (pollepelige) werktijd kan zo'n ontwikkeling in beslag nemen?
Het hangt allemaal af van je niveau.
Van mijn kant, ook als beginner, zou ik zeggen tussen de 3 uur en 1 dag ongeveer.
Ik denk dat de xml zal worden gemaakt door de web-app.
Je hoeft dus alleen maar het xml-bestand te lezen, alle variabelen op te halen en ze bijvoorbeeld in een array op te slaan, dan moet je het onderdeel of de assemblage aanpassen met de herstelde eigenschappen.
Splits uw code op voor elke gewenste functie en probeer deze vervolgens samen te stellen. In het begin is het ingewikkeld en beetje bij beetje komen we er wel.
Zijn het voor de eigenschappen aangepaste of configuratiespecifieke eigenschappen?
Als je een beginner bent, kan ik als onwetend worden beschouwd. Variabele, declaratie, array-lus... Ik begrijp er niets van. Ik zoek tevergeefs naar tutorials voor beginners.
Dit is voor aangepaste eigenschappen.
Voor alles wat tutorials beginnen met tutorials in Excel om variabelen, loops, arrays te leren...
Van mijn kant ben ik 2-3 jaar geleden begonnen met degene die erg goed is om de basis van VBA te leren:
https://www.excel-pratique.com/fr/vba/
Voor solidworks en de VBA is er deze site (in het Engels maar begrijpelijk):
https://thecadcoder.com/vba/vba-Introduction/
Voor uw macro plaatst u ons een voorbeeld van xml-bestand en onderdeel (als u uw onderdeel wilt beschermen, plaatst u een voorbeeld met dezelfde eigenschappen, zelfs als de vorm er niets mee te maken heeft)
En ik zal zien of ik tijd heb als het ingewikkeld is. Als je het probeert, kun je het niet. Begin klein en je zult vooruitgang boeken en indien nodig kun je hier vragen over stellen.
Grote dank voor de vba xls tutorial. Ik had niet gedacht dat ik zoveel dingen zou leren die ook in sw zitten. Het is de basisgrammatica die ik miste. En dat is nog maar het begin!
Zal ik teruggaan;)
Hallo weer
Ik heb een beetje aan de links gewerkt, en ik ben begonnen met de eenvoudigste: 4 regels in een excel.
Hier is mijn 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
Het werkt zo'n beetje. De macro leest de eerste 4 rijen, verwijdert de eigenschap als deze al bestaat en maakt deze opnieuw met de waarden in de array. De opening van het schilderij is onzichtbaar, hij lijkt zich aan het einde te sluiten.
MAAR, van tijd tot tijd, krijg ik runtime error 1004: de 'selectie' methode van het object '_Global' mislukte net toen we begonnen te handelen op de eigenschappen van het SW bestand. Ik begrijp niet waar het vandaan komt.
Soms is het weer een foutmelding. Soms loopt het Excel-bestand vast in alleen-lezen. Kortom, het is niet stabiel.
Mijn volgende verbeteringen zullen zijn om een lus te maken om alle niet-lege rijen van de Excel-tabel te verwerken, en een versie van deze macro te maken om te integreren in het Excel-bestand voor een "handmatige" methode om eigenschappen bij te werken.
Zonder het Excel-bestand en een deel, zelfs leeg, maar met de gewenste eigenschappen, is het ingewikkeld om te beantwoorden.
Op deze fout is hier een lead:
https://fr.teamaftermarket.com/303-vba-1004-error
Misschien wijs je naar een lege of niet-bestaande cel. Of deze fout 1004, indien toegewezen aan SW, kan te wijten zijn aan een niet-bestaande eigenschap en daarom onmogelijk te verwijderen zijn. Het zou goed zijn om dieper te graven om te begrijpen waarom.
Anders, om het te negeren, kunt u een "On error next" toevoegen aan de vorige regel, wat zou kunnen helpen.
Als er een fout wordt gedetecteerd op de regel die volgt op de volgende fout, negeert het de rij met een fout en gaat het verder met de volgende.
2 schakels op deze bestelling:
https://docs.microsoft.com/fr-fr/dotnet/visual-basic/language-reference/statements/on-error-statement
https://www.educba.com/vba-on-error-resume-next/
Zie ook dit onderwerp om u te helpen bij het opsporen van fouten in uw macro:
https://www.lynkoa.com/forum/3d/incomprehension-exportation-fichier-excel?page=1