Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim val As String
Dim valout As String
Dim bool As Boolean
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim nNbrProps As Long
Dim vPropNames As Variant
Dim K As Long
Set cusPropMgr = swModelDocExt.CustomPropertyManager("")
nNbrProps = cusPropMgr.Count
vPropNames = cusPropMgr.GetNames
For K = 0 To nNbrProps - 1
bool = cusPropMgr.Get4(vPropNames(K), False, val, valout)
MsgBox vPropNames(K) & " - " & val & " - " & valout
Next K
End Sub
Hello everyone and thank you for your responsiveness. Mine is not so good because I'm very busy at the moment...
I had noticed the different posts, but when in my room I have the custom property "Finishing" and I want a msgbox "RAL9010" when I run my macro, I can't do it...
If you want to control Solidworks from Excel you have tothink about declaring SolidWorks in Excel with a "CreateObject" and putting the necessary references in your macro. The macro in the first post works and displays an msgbox including the "Property Name - Text Expression - Evaluated Value" for each property in the customize tab.
Sub Macro1()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim val As String
Dim valout As String
Dim bool As Boolean
Set swApp = CreateObject("SldWorks.Application")
swApp.Visible = True
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim nNbrProps As Long
Dim vPropNames As Variant
Dim K As Long
Set cusPropMgr = swModelDocExt.CustomPropertyManager("")
nNbrProps = cusPropMgr.Count
vPropNames = cusPropMgr.GetNames
For K = 0 To nNbrProps - 1
bool = cusPropMgr.Get4(vPropNames(K), False, val, valout)
MsgBox vPropNames(K) & " - " & val & " - " & valout
Next K
End Sub
Set swCustProp = swConfig.CustomPropertyManager
boolstatus = swCustProp.Get5("xxx", False, ValOut, ResolvedValOut, WasResolved) 'Changer "xxx" par le nom de la propriété du fichier 3D
I agree with Cyril.f, here is an example to read the values "property name - Text expression - Value evaluated" for each property of the active config:
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim config As SldWorks.Configuration
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim lRetVal As Long
Dim vPropNames As Variant
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim nNbrProps As Long
Dim j As Long
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set config = swModel.GetActiveConfiguration
Set cusPropMgr = config.CustomPropertyManager
nNbrProps = cusPropMgr.Count
vPropNames = cusPropMgr.GetNames
For j = 0 To nNbrProps - 1
lRetVal = cusPropMgr.Get5(vPropNames(j), False, ValOut, ResolvedValOut, wasResolved)
Debug.Print vPropNames(j) & ", " & ValOut & ", " & ResolvedValOut
Next j
End Sub
I had a code that I had made under SW2014 that also worked wonderfully but that doesn't work anymore in SW2016.
Here is the code at issue:
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModelDoc As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swPackAndGo As SldWorks.PackAndGo
Dim openFile As String
Dim myFileName As String
Dim pgFileNames As Variant
Dim pgFileStatus As Variant
Dim pgSetFileNames() As String
Dim pgGetFileNames As Variant
Dim pgDocumentStatus As Variant
Dim status As Boolean
Dim warnings As Long
Dim errors As Long
Dim i As Long
Dim j As Long
Dim namesCount As Long
Dim myPath As String
Dim statuses As Variant
Public Chemin, OldFile As String
Public Ligne1, DernligneASM
Sub ListerOldFichiers()
Dim Fichier As String
Range("A2:B1000") = "" 'Vidage des cellules
Chemin = CheminUser
OldFile = Dir(Chemin & "*.sldasm")
'Appel de la progressbar
UserForm1.Show vbModeless
UserForm1.ProgressBar1.Value = 0
Dim ProgressBar, barre
UserForm1.ProgressBar1.Value = 10
'Ecrire les noms de fichiers dans colone A
Ligne1 = 2 'Départ pour rentrer les noms de fichiers
Do While OldFile <> ""
Cells(Ligne1, 1) = OldFile
OldFile = Dir()
Ligne1 = Ligne1 + 1
Loop
DernligneASM = Range("a65536").End(xlUp).Row
Dim Dernligne2
Dernligne2 = Range("a65536").End(xlUp).Row + 1
OldFile = Dir(Chemin & "*.sldprt")
Do While OldFile <> ""
Cells(Dernligne2, 1) = OldFile
OldFile = Dir()
Dernligne2 = Dernligne2 + 1
Loop
UserForm1.ProgressBar1.Value = 50
Dim Dernligne3
Dernligne3 = Range("a65536").End(xlUp).Row
Ligne1 = 2
For Ligne1 = Ligne1 To Dernligne3
Dim DSO As DSOFile.OleDocumentProperties
Dim File1, OldDes, k, PropName, Compteur
File1 = Cells(Ligne1, 1).Value
Set DSO = New DSOFile.OleDocumentProperties
DSO.Open sfilename:=Chemin & File1
Compteur = DSO.CustomProperties.Count
If Compteur <> 0 Then
For k = 1 To Compteur - 1
PropName = DSO.CustomProperties.Item(k).Name
If PropName = "Designation-1" Then
OldDes = DSO.CustomProperties.Item("Designation-1").Value
Cells(Ligne1, 2) = OldDes
End If
Next k
End If
DSO.Save
DSO.Close
Next
'Fini de remplir et Decharger l'userform
barre = 100
UserForm1.ProgressBar1.Value = barre
Unload UserForm1
ProgressBar = 0 'Réinitialisation
MsgBox "Remplissez la colonne des Nouveaux noms a attribuer puis cliquez sur ''Renommer''"
End Sub
The "DSO. CustomProperties.Count" no longer works... from what I could see, it would be the DSO part that is no longer taken into account. But I don't know what to replace it with...
There you have it: http://www.lynkoa.com/forum/solidworks/r%C3%A9cupererecrire-propri%C3%A9t%C3%A9s-personalis%C3%A9s-avec-excel-sans-methode-dso-inactive-depuis
The examples above allow you to retrieve the custom properties of the "Customize" tab, if you also want to retrieve those of the "Configuration specific" tab for each configuration then you can see an example on the following link: http://help.solidworks.com/2013/English/api/sldworksapi/Get_Custom_Properties_Example_VB.htm