change properties of assemblies and parts from an excel list

[Hellric]

Hello,
I'ts my 1st post, i'm French and noob in VBA so please be friendly and understanding

i need to change properties of a lot of files because my clients often change their minds and decide that their shelves would look better in blue rather than red for example.

I imagined an excel table in which I list the solidworks files (drawings).
In this table I would name the colors that I no longer want and those that would replace them.
example:

Red => Blue
Green => Yellow
Purple => Black

Same for materials.

Steel => Aluminum
...

3 for each.

When i finish writing the list of solidworks files, finishes and materials, i run the macro.
Solidworks opens the 1st file in the list, opens the assembly of the first page of the drawing, searches in "FINITION", "FINITION2", "FINITION3", "MATIERE_PRINCIPALE", MATIERE_PRINCIPALE2" and "MATIERE_PRINCIPALE3" to replace finish and material.
After that, check if this fil is a part or assembly, if it's an assembly, open every sub assembly and part one by one to apply the same.
Then, close every part or assembly and run another macro to export as PDF, DXF and STEP (i aready have this macro) in a folder that I specified in my excel table.

Phew! that's it, we made a line!
next line...
until the end of the list in the excel table.
a progress bar would be nice, error messages in case of file not found too (a color on the line of the excel table for example)
Attention, for the change of material for the parts, it is not necessary to change the property but the material if however it would be to change.

I know it's a lot of work. I tried by myself by doing research on different forums, I found pieces of code that I tried to assemble but I can't.
below the macro to do what I want but for only the open document.

I obviously forgot things but it's already long enough, I'll answer all your questions if you have any.
Thank you in advance for taking the time to read me, I don't just want to have this table but to understand how it works and why I made these choices in the programming to be able to be more independent for the next few times.

[Hellric]

Code: Select all

Dim MAT1 As String
Dim MAT2 As String
Dim MAT3 As String
Dim MATA1 As String
Dim MATA2 As String
Dim MATA3 As String
Dim MATB1 As String
Dim MATB2 As String
Dim MATB3 As String
Dim FIN1 As String
Dim FIN2 As String
Dim FIN3 As String
Dim FINA1 As String
Dim FINA2 As String
Dim FINA3 As String
Dim FINB1 As String
Dim FINB2 As String
Dim FINB3 As String
Dim Pathname As String
Dim X As Boolean
Dim swApp As SldWorks.SldWorks
Dim SWmoddoc As SldWorks.ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim val As String
Dim valout As String
Dim bool As Boolean
Dim CODE As String
Dim nErrors             As Long
Dim nWarnings           As Long
Dim retval As Boolean

Private Sub TEXTBOXMATA1_Change()

End Sub

Private Sub TEXTBOXMATA2_Change()

End Sub

Private Sub TEXTBOXMATA3_Change()

End Sub

Private Sub TEXTBOXMATB1_Change()

End Sub

Private Sub TEXTBOXMATB2_Change()

End Sub

Private Sub TEXTBOXMATB3_Change()

End Sub

Private Sub TEXTBOXFINA1_Change()

End Sub

Private Sub TEXTBOXFINA2_Change()

End Sub

Private Sub TEXTBOXFINA3_Change()

End Sub

Private Sub TEXTBOXFINB1_Change()

End Sub

Private Sub TEXTBOXFINB2_Change()

End Sub

Private Sub TEXTBOXFINB3_Change()

End Sub

' Bouton effacer
Private Sub Effacer_Click()

Unload UserForm1

UserForm1.Show (0)

End Sub

' Bouton cacher
Private Sub Cacher_Click()

Me.Hide

End Sub


' BOUTON END
Private Sub Fin_Click()

End

End Sub
' APPLIQUER
Private Sub Appliquer_Click()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")

'obtient le chemin complet du document actif, y compris le nom du fichier :
Pathname = UCase(swModel.GetPathName)

'vérification qu'on n'est pas sur un drw = 2D :
If Right(Pathname, 3) = "DRW" Then
    MesgBOX = MsgBox("Macro à lancer uniquement depuis une pièce ou un assemblage", vbMsgBoxSetForeground, "Enregistrer-sous ")
    Exit Sub
    ElseIf Right(Pathname, 3) = "PRT" Then
        DRWPath = Replace(Pathname, "PRT", "DRW")
    ElseIf Right(Pathname, 3) = "ASM" Then
        DRWPath = Replace(Pathname, "ASM", "DRW")
End If

MATA1 = TEXTBOXMATA1.Value
MATA2 = TEXTBOXMATA2.Value
MATA3 = TEXTBOXMATA3.Value
MATB1 = TEXTBOXMATB1.Value
MATB2 = TEXTBOXMATB2.Value
MATB3 = TEXTBOXMATB3.Value
FINA1 = TEXTBOXFINA1.Value
FINA2 = TEXTBOXFINA2.Value
FINA3 = TEXTBOXFINA3.Value
FINB1 = TEXTBOXFINB1.Value
FINB2 = TEXTBOXFINB2.Value
FINB3 = TEXTBOXFINB3.Value

'récupère la propriété personnalisée MATIERE_PRINCIPALE :

bool = swCustProp.Get4("MATIERE_PRINCIPALE", False, MAT1, valout)

Select Case MAT1

Case MATA1
MAT1 = MATB1

Case MATA2
MAT1 = MATB2

Case MATA3
MAT1 = MATB3

End Select

'modifie la propriété personnalisée MATIERE_PRINCIPALE :

retval = swModel.AddCustomInfo3("", "MATIERE_PRINCIPALE", 30, MAT1)
swModel.CustomInfo("MATIERE_PRINCIPALE") = MAT1

'récupère la propriété personnalisée MATIERE_PRINCIPALE2 :

bool = swCustProp.Get4("MATIERE_PRINCIPALE2", False, MAT2, valout)

Select Case MAT2

Case MATA1
MAT2 = MATB1

Case MATA2
MAT2 = MATB2

Case MATA3
MAT2 = MATB3

End Select

'modifie la propriété personnalisée MATIERE_PRINCIPALE2 :

retval = swModel.AddCustomInfo3("", "MATIERE_PRINCIPALE2", 30, MAT2)
swModel.CustomInfo("MATIERE_PRINCIPALE2") = MAT2

'récupère la propriété personnalisée MATIERE_PRINCIPALE3 :

bool = swCustProp.Get4("MATIERE_PRINCIPALE3", False, MAT3, valout)

Select Case MAT3

Case MATA1
MAT3 = MATB1

Case MATA2
MAT3 = MATB2

Case MATA3
MAT3 = MATB3

End Select

'modifie la propriété personnalisée MATIERE_PRINCIPALE3 :

retval = swModel.AddCustomInfo3("", "MATIERE_PRINCIPALE3", 30, MAT3)
swModel.CustomInfo("MATIERE_PRINCIPALE3") = MAT3

'récupère la propriété personnalisée FINITION :

bool = swCustProp.Get4("FINITION", False, FIN1, valout)

Select Case FIN1

Case FINA1
FIN1 = FINB1

Case FINA2
FIN1 = MATB2

Case FINA3
FIN1 = FINB3

End Select

'modifie la propriété personnalisée FINITION :

retval = swModel.AddCustomInfo3("", "FINITION", 30, FIN1)
swModel.CustomInfo("FINITION") = FIN1

'récupère la propriété personnalisée FINITION2 :

bool = swCustProp.Get4("FINITION2", False, FIN2, valout)

Select Case FIN2

Case FINA1
FIN2 = FINB1

Case FINA2
FIN2 = FINB2

Case FINA3
FIN2 = FINB3

End Select

'modifie la propriété personnalisée FINITION2 :

retval = swModel.AddCustomInfo3("", "FINITION2", 30, FIN2)
swModel.CustomInfo("FINITION2") = FIN2

'récupère la propriété personnalisée FINITION3 :

bool = swCustProp.Get4("FINITION3", False, FIN3, valout)

Select Case FIN3

Case FINA1
FIN3 = FINB1

Case FINA2
FIN3 = FINB2

Case FINA3
FIN3 = FINB3

End Select

'modifie la propriété personnalisée FINITION3 :

retval = swModel.AddCustomInfo3("", "FINITION3", 30, FIN3)
swModel.CustomInfo("FINITION3") = FIN3

End Sub

[sloworks]

Hi, check out SWie:
https://sloworks.fi/muut/

[Hellric]

Hi, check out SWie:
https://sloworks.fi/muut/

Thank you for your answer, but Swie doesn't work for me, it said "an activeX component cannot create an object"

stopped at:
"Set swApp = CreateObject("SldWorks.Application.31")"

Does your vba only work with parts slddrw? or also with the slddrw of assemblies?

How should i modify this VBA to open sub assembly and parts and modify custom properties of each of them?

I'm afraid I'm not experienced enough in VBA to fully understand your SWie.

[andrmollo]

Hi,
if you are on SolidWorks subscription (so that you can requests a Document Manger license key) and if you have Excel 64bit you can use this macro from Codestack:
https://www.codestack.net/solidworks-do ... functions/

You will have to specify the path to all your files: assemblies, sub-assemblies and parts but it will be order of magnitude quicker than open every single file and it is almost a turn-key solution.

I was able to able to add a property to 500 or so files in a couple of seconds.

[AlexLachance]

Hey @Hellric, welcome to the forums. No worries, they don't judge the frenchies like us over here!

@josh and @gupta9665 are some of the best people to answer your question imo! You've already got the whole thing built, so what you want to add shouldn't be too much of a struggle imo. There's a bunch of awesome people here with a lot of knowledge to help.

[gupta9665]

Thank you for your answer, but Swie doesn't work for me, it said "an activeX component cannot create an object"

stopped at:
"Set swApp = CreateObject("SldWorks.Application.31")"

What is your current SW version? The 31 in the line above is for 2023 version (23 +8). Add 8 to last 2 digits of your version and replace 31 with that value. And then make sure that macro/excel is referencing to the correct version of SW>

[sloworks]

Hi, no need to modify the code, just select correct SW-version (cell I1)

Clipboard01.jpg (10.02 KiB) Viewed 2164 times

Only reason that selection is there is that some of us have more than one SW-version installed on the same pc and then you want/need to define what version you want to use with SWie, otherwise you can use older SWie 2018 without this selection. There is own sheet to handle parts and assemblies. SWie does not know if the file is subassembly or something, it just reads files in defined folder and custom properties you want.

Among the downloads there is text file "SWie-versions explained", that explains, surprisingly, what different version are for :-) There is also version that is used only with drawings and some special versions that has been requested.

References, yes, as always with macros, they might need fix, follow this guide: https://www.codestack.net/solidworks-ap ... eferences/