Witam
Chciałbym wiedzieć, czy ktoś ma makro, które pozwala wypełnić niestandardowe właściwości części informacjami zawartymi w pliku tekstowym (.txt, .ini lub innym)
Znalazłem tę dyskusję, ale rozwiązanie zaproponowane przez Filipe Wenceslaua wydaje się być napisane w innym języku niż VBA
Początkowo chciałem to zrobić z Excela, ale licencja KeyManager sprawia mi problemy
Ze swojej strony mam to w 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
Czytaj:
Pisać:
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
Mam też ten fragment kodu do napisania w pliku csv.
W części do czytania pozwolę Ci zrobić rozeznanie, jest to możliwe, ale nie mam nic pod ręką:
'*** 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
Albo znowu:
https://www.codestack.net/solidworks-api/document/assembly/components/export-positions/
Lub również:
https://chandoo.org/forum/threads/how-to-read-data-from-a-csv-file-and-write-the-same-in-the-active-worksheet-using-macro.37896/
Mam nadzieję, że skierowałeś Cię na właściwą drogę dla Twoich potrzeb.
Dziękuję sbadenis
Próbuję zmodyfikować Twój pierwszy kod, aby dostosować go do moich potrzeb.
w tej chwili kod zatrzymuje się na Dim oXML As MSXML2. DOMDocument: niezdefiniowany typ zdefiniowany przez użytkownika.
Formularz jeszcze się nie otwiera. Czy celem formularza jest wybór pliku XML? Osobiście nie chcę okna dialogowego, wszystko musi dziać się automatycznie. Wolę wpisać ścieżkę xml w makrze
Nie, mój kod zadał mi pytanie, ale jest ono w moim kodzie.
Czy dodano odniesienie do języka MicrosoftXML 3.0?
W przeciwnym razie znalazłem ten przykład przetestowany i zatwierdzony:
' 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
Redagować:
Celem tego pliku xml było dla mnie właśnie posiadanie okna dialogowego z różnymi zapisanymi opcjami w zależności od wyboru personalizacji "użytkownika"
EDIT: Początkowy temat, który skłonił mnie do napisania 1. makra i powyższych testów:
https://www.lynkoa.com/forum/solidworks/macro-vba-pour-ecrire-et-lire-un-fichier-xml
Włączyłem xml3, a teraz utknął trochę dalej, po CommandButtonExec.SetFocus w formularzu użytkownika : błąd 424: wymagany obiekt
Rzeczywiście, mój cel może być zbyt odległy od tego makra, aby je modyfikować. Jeśli ktoś inny ma coś jeszcze do zaoferowania, temat pozostaje otwarty.
Po prostu zainspiruj się ostatnimi 2 macrso, przeczytaj i napisz w poście powyżej, jest funkcjonalny i nie potrzebujesz niczego więcej.
Po formacie xml można go zmodyfikować za pomocą niektórych wyszukiwań w formacie csv lub xls lub innym.
Do mojego użytku xml bardzo mi odpowiadał. W zależności od potrzeb powinieneś być w stanie dostosować te 2 ostatnie makra
Napisz, kto tworzy katalog, jeśli go nie ma, plik Essai.xml i kto zapisuje 3 opcje dla mojego przypadku (do przetestowania, a następnie zastąpienia przez twoje wartości)
Następnie możesz sprawdzić istnienie pliku i jego zawartość.
Następnie, jeśli naciśniesz przycisk odtwarzania, wyświetli Cię w trybie debugowania linii zawartych w pliku xml.
W końcu zależy to oczywiście od ilości danych i formy tego, co chcesz przechowywać w swoim pliku, dla twojego użytku xml może nie być najbardziej odpowiedni.
Cóż, myślę, że to wykracza poza mój poziom.
XML mi odpowiada, ponieważ ten plik zostanie utworzony przez aplikację internetową.
W xml będzie od 10 do ... Powiedzmy, że maksymalnie 40 wiersz z nazwą właściwości niestandardowej i wartością liczbową dla każdej właściwości.
Właściwości niestandardowe już istnieją w moim dokumencie SW, makro musi aktualizować wartość na podstawie xml, bez konieczności walidacji ze strony użytkownika (uważamy, że plik xml znajduje się w miejscu określonym w makrze)
Zaczynając od zera, ile (chochli) czasu pracy może zająć taki rozwój?
Wszystko zależy od Twojego poziomu.
Ze swojej strony, jako początkujący, powiedziałbym, że około 3 godzin i 1 dzień.
Domyślam się, że xml zostanie utworzony przez aplikację internetową.
Musisz więc tylko odczytać plik xml, pobrać wszystkie zmienne i zapisać je na przykład w tablicy, a następnie zmodyfikować część lub zespół za pomocą odzyskanych właściwości.
Podziel swój kod dla każdej żądanej funkcji, a następnie spróbuj złożyć go razem. Na początku jest to skomplikowane i krok po kroku do tego dochodzimy.
W przypadku właściwości, czy są to właściwości niestandardowe, czy specyficzne dla konfiguracji?
Jeśli jesteś początkującym, to mogę być uważany za ignoranta. Zmienna, deklaracja, pętla tablicowa... Nic nie rozumiem. Na próżno szukam tutoriali dla początkujących.
Dotyczy to właściwości niestandardowych.
Do wszystkiego, co samouczki zaczynają się od samouczków w programie Excel, aby nauczyć się zmiennych, pętli, tablic...
Ze swojej strony zacząłem 2-3 lata temu od tego, który jest bardzo dobry do nauki podstaw VBA:
https://www.excel-pratique.com/fr/vba/
Dla solidworks i VBA dostępna jest ta strona (w języku angielskim, ale zrozumiała):
https://thecadcoder.com/vba/vba-Introduction/
Dla swojego makra opublikuj nam przykład pliku xml i części (Jeśli chcesz chronić swoją część, opublikuj przykład z tymi samymi właściwościami, nawet jeśli kształt nie ma z tym nic wspólnego)
I zobaczę, czy starczy mi czasu, jeśli to skomplikowane. Jeśli spróbujesz, nie możesz. Zacznij od małych kroków, a będziesz się rozwijać, a jeśli to konieczne, możesz zadawać pytania na ten temat.
Wielkie dzięki za samouczek vba xls. Nie sądziłam, że nauczę się tylu rzeczy, które są również w sw. To podstawowa gramatyka, której mi brakowało. A to dopiero początek!
Czy mam tam wrócić;)
Witam ponownie
Popracowałem trochę nad linkami i zacząłem od najprostszego: 4 linijek w excelu.
Oto mój kod
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
To całkiem w zasadzie działa. Makro odczyta pierwsze 4 wiersze, usunie właściwość, jeśli już istnieje, i utworzy ją ponownie z wartościami w tablicy. Otwór obrazu jest niewidoczny, wydaje się, że zamyka się na końcu.
ALE od czasu do czasu pojawia się błąd wykonania 1004: metoda "wyboru" obiektu "_Global" nie powiodła się w momencie, gdy zaczęliśmy działać na właściwościach pliku SW. Nie rozumiem, skąd to się bierze.
Czasami jest to kolejny komunikat o błędzie. Czasami plik Excela utknął w trybie tylko do odczytu. Krótko mówiąc, nie jest stabilny.
Moimi następnymi ulepszeniami będzie utworzenie pętli do przetwarzania wszystkich niepustych wierszy tabeli Excela i stworzenie wersji tego makra do zintegrowania z plikiem Excela w celu uzyskania "ręcznej" metody aktualizacji właściwości.
Bez pliku Excela i części, nawet pustej, ale o pożądanych właściwościach, trudno jest odpowiedzieć.
Na temat tego błędu znajduje się trop:
https://fr.teamaftermarket.com/303-vba-1004-error
Być może wskazujesz na pustą lub nieistniejącą komórkę. Albo ten błąd 1004, jeśli jest przypisany do SW, może być spowodowany nieistniejącą właściwością i dlatego nie można go usunąć. Dobrze byłoby kopać głębiej, aby zrozumieć, dlaczego.
W przeciwnym razie, aby go zignorować, możesz dodać "W przypadku błędu następny" w poprzednim wierszu, co może pomóc.
Jeśli wykryje błąd w wierszu następującym po następnym błędzie on, ignoruje błędny wiersz i przechodzi do następnego.
2 linki w tym zamówieniu:
https://docs.microsoft.com/fr-fr/dotnet/visual-basic/language-reference/statements/on-error-statement
https://www.educba.com/vba-on-error-resume-next/
Zapoznaj się również z tym tematem, aby uzyskać pomoc w debugowaniu makra:
https://www.lynkoa.com/forum/3d/incomprehension-exportation-fichier-excel?page=1