Hello world
when I import and save a *.step assembly as a Solidworks assembly with all its parts separated in a folder, the properties are not editable
I created a macro to copy the properties, delete the properties, paste the properties
everything works unless the type of property is a formula-type equation (like matter for example)
here is my code, which I would run via Mycadtool Integration to loop on all assembly and part files
Is there something that I would have missed in the macro to copy the formula and not the result of the formula
in grey the non-modifiable properties
in white the one I added
If I add for the test (I don't have a file with this type: formula in the steps, I do it for all cases) a formula its result is copied but not the formula
C-HC Screws (4)_Vis C-HC-M3-10.SLDPRT (137.4 KB)
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim Part As Object
Dim vPropNames As Variant
Dim vPropTypes As Variant
Dim vPropValues As Variant
Dim resolved As Variant
Dim linkProp As Variant
Dim i As String
Dim j As Integer
Dim Ligne As Integer
Dim custPropType As Long
Dim lRetVal As Long
Dim retval As Long
Dim Nb_espaces As Integer
Sub Step_proprietes()
'Les step importés ont des propriétés non modifiables
'01-Liste les propriétés et les copie
'02-Supprimme les propriétés
'03-Ajouter les propriétés
'https://help.solidworks.com/2023/english/api/sldworksapi/Get_Custom_Properties_of_Referenced_Part_Example_VB.htm?verRedirect=1
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set Part = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
If Part.GetType = 3 Then Exit Sub '1 = Part, 2 = Assembly, 3 = Drawing
If swCustProp.Count = 0 Then Exit Sub
'01-Liste les propriétés et les copie
Ligne = swCustProp.Count
Debug.Print "Nb propriétés : " & Ligne
lRetVal = swCustProp.GetAll3(vPropNames, vPropTypes, vPropValues, resolved, linkProp)
Dim TABLEAU() As String
ReDim TABLEAU(1 To Ligne, 1 To 3) As String
Debug.Print "N° | Nom" & Space(16) & " | Type | Valeur"
For j = 0 To Ligne - 1
custPropType = swCustProp.GetType2(vPropNames(j))
If j + 1 < 10 Then i = "0" & j + 1
Debug.Print i & " | " & vPropNames(j) & Space(19 - (Len(vPropNames(j)))) & " | " & custPropType & Space(6 - (Len(custPropType))) & " | " & vPropValues(j)
TABLEAU(j + 1, 1) = vPropNames(j)
TABLEAU(j + 1, 2) = custPropType
TABLEAU(j + 1, 3) = vPropValues(j)
Next j
'02-Supprimme les propriétés
For j = 1 To Ligne
swCustProp.Delete TABLEAU(j, 1)
Next j
'03-Ajouter les propriétés
'Problème avec les équations seul le résultat est copié pas la formule
'swCustomInfoDate 64
'swCustomInfoDouble 5
'swCustomInfoNumber 3
'swCustomInfoText 30
'swCustomInfoUnknown 0
'swCustomInfoYesOrNo 11
For j = 1 To Ligne
retval = swCustProp.Add2(TABLEAU(j, 1), TABLEAU(j, 2), TABLEAU(j, 3))
Next j
'Supprime le tableau
Erase TABLEAU
End Sub
You get the evaluated value of the property, you should get the /Expression value of the property see this topic:
The properties concerned:
Debug.Print indent & "Value/Text Expression: " & prpVal
Debug.Print indent & "Evaluated Value: " & prpResVal
1 Like
Hello
As sbadenis says, With Get6, you'll get the value of the expression back
1 Like
I don't know how to write the macro
I tried this but it only gives a bellow; table expected on the line
"custPropType = swCustProp.GetType2(FieldName(j))"
Dim FieldName As String
Dim UseCached As Boolean
Dim ValOut As String
Dim ResolvedValOut As String
Dim WasResolved As Boolean
Dim LinkToProperty As Boolean
Dim value As Long
'Les step importés ont des propriétés non modifiables
'01-Liste les propriétés et les copie
'02-Supprime les propriétés
'03-Ajouter les propriétés
'https://help.solidworks.com/2023/english/api/sldworksapi/Get_Custom_Properties_of_Referenced_Part_Example_VB.htm?verRedirect=1
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set Part = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
If Part.GetType = 3 Then Exit Sub '1 = Part, 2 = Assembly, 3 = Drawing
If swCustProp.Count = 0 Then Exit Sub
'01-Liste les propriétés et les copie
Ligne = swCustProp.Count
Debug.Print "Nb propriétés : " & Ligne
'lRetVal = swCustProp.GetAll3(vPropNames, vPropTypes, vPropValues, resolved, linkProp)
'''value = swCustProp.GetAll3(PropNames, PropTypes, PropValues, resolved, PropLink)
value = swCustProp.Get6(FieldName, UseCached, ValOut, ResolvedValOut, WasResolved, LinkToProperty)
Dim TABLEAU() As String
ReDim TABLEAU(1 To Ligne, 1 To 3) As String
Debug.Print "N° | Nom" & Space(16) & " | Type | Valeur"
For j = 0 To Ligne - 1
'custPropType = swCustProp.GetType2(vPropNames(j))
custPropType = swCustProp.GetType2(FieldName(j))
If j + 1 < 10 Then i = "0" & j + 1
'Debug.Print i & " | " & vPropNames(j) & Space(19 - (Len(vPropNames(j)))) & " | " & custPropType & Space(6 - (Len(custPropType))) & " | " & vPropValues(j)
Debug.Print FieldName(j) & " " & UseCached(j) & " " & ValOut(j) & " " & ResolvedValOut(j) & " " & WasResolved(j) & " " & LinkToProperty
'TABLEAU(j + 1, 1) = vPropNames(j)
'TABLEAU(j + 1, 2) = custPropType
'TABLEAU(j + 1, 3) = vPropValues(j)
TABLEAU(j + 1, 1) = FieldName(j)
TABLEAU(j + 1, 2) = vPropTypes(j)
TABLEAU(j + 1, 3) = ValOut(j)
Next j
Fieldname is the name of the property to enter (not output) just implement with the previous code, you got the name with getall, use get6 to get the expression
1 Like
I have a lot of trouble with macros
I don't understand among other things why (Len(custPropType)) doesn't return the correct value
for a type: number it returns 4 while the result is 3 i.e. 1 in length???
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim Part As Object
Dim i As String
Dim j As Integer
Dim ligne As Integer
Dim custPropType As Long
Dim Nb_espaces As Integer
Dim PropNames As Variant
Dim PropTypes As Variant
Dim PropValues As Variant
Dim resolved As Variant
Dim PropLink As Variant
'Dim FieldName As String
Dim UseCached As Boolean
Dim valout As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim LinkToProperty As Boolean
Dim value As Long
Sub Step_proprietes()
'Les step importés ont des propriétés non modifiables
'01-Liste les propriétés et les copie
'02-Supprime les propriétés
'03-Ajouter les propriétés
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set Part = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
If Part.GetType = 3 Then Exit Sub '1 = Part, 2 = Assembly, 3 = Drawing
If swCustProp.Count = 0 Then Exit Sub
'01-Liste les propriétés et les copie
ligne = swCustProp.Count
Debug.Print "Nb propriétés : " & ligne
value = swCustProp.GetAll3(PropNames, PropTypes, PropValues, resolved, PropLink)
Dim TABLEAU() As String
ReDim TABLEAU(1 To ligne, 1 To 3) As String
Debug.Print "N° | Nom" & Space(16) & " | Type | Valeur"
For j = 0 To ligne - 1
custPropType = swCustProp.GetType2(PropNames(j))
If j + 1 < 10 Then i = "0" & j + 1
value = swCustProp.Get6(PropNames(j), UseCached, valout, ResolvedValOut, wasResolved, LinkToProperty)
'Debug.Print vPropNames(j) & " " & custPropType & " " & UseCached & " " & valout & " " & ResolvedValOut & " " & wasResolved & " " & LinkToProperty
Debug.Print i & " | " & PropNames(j) & Space(19 - (Len(PropNames(j)))) & " | " & custPropType & Space(6 - (Len(custPropType))) & " | " & valout
Debug.Print Len(PropNames(j)) & " " & (Len(custPropType))
TABLEAU(j + 1, 1) = PropNames(j)
TABLEAU(j + 1, 2) = custPropType
TABLEAU(j + 1, 3) = valout
Next j
'02-Supprime les propriétés
For j = 1 To ligne
swCustProp.Delete TABLEAU(j, 1)
Next j
'03-Ajouter les propriétés
'Le type 'équation' est transformé en 'texte'
'Si len(custPropType) compte n'importe quoi
'swCustomInfoDate 64
'swCustomInfoDouble 5
'swCustomInfoNumber 3
'swCustomInfoText 30
'swCustomInfoUnknown 0
'swCustomInfoYesOrNo 11
For j = 1 To ligne
value = swCustProp.Add2(TABLEAU(j, 1), TABLEAU(j, 2), TABLEAU(j, 3))
Next j
'Supprime le tableau
Erase TABLEAU
End Sub
Enclosed is a screenshot,
I used get5 (2016 version)
Delete getall, it's not much use, use instead, getnames
1 Like
For the number
Did you choose " number " correctly in the property table, for me the value returned is correct
yes I put number but len must count the number of characters but the number property returns the number 3 it finds 4 digits ???
I just saw this function, it's neither 4 nor 3 but a 1, since it processes strings, so for a relevant result you'll have to use (or convert into) string
If you have an idea I don't understand how to do it
I simply used
Dim custproptype as string
Since vba uses a stand-alone conversion system,
There is also the cstr(integer) function
Len(cstr(custproptype) )
I advise the second method, if ever the property is used elsewhere, better preserve the consistency of the types 
Great everything works thanks to the help of all of you
Here's the macro
to be modified according to the comments for those who wish
We will notice that the type 'equation' is transformed into 'text' but it still works
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim Part As Object
Dim i As String
Dim j As Integer
Dim ligne As Integer
Dim custPropType As Long
Dim Nb_espaces As Integer
Dim PropNames As Variant
Dim PropTypes As Variant
Dim PropValues As Variant
Dim resolved As Variant
Dim PropLink As Variant
'Dim FieldName As String
Dim UseCached As Boolean
Dim valout As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim LinkToProperty As Boolean
Dim value As Long
Sub Step_proprietes()
'Les step importés ont des propriétés non modifiables
'01-Liste les propriétés et les copie
'02-Supprime les propriétés
'03-Ajouter les propriétés
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set Part = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
If Part.GetType = 3 Then Exit Sub '1 = Part, 2 = Assembly, 3 = Drawing
If swCustProp.Count = 0 Then Exit Sub
'01-Liste les propriétés et les copie
ligne = swCustProp.Count
Debug.Print "Nb propriétés : " & ligne
value = swCustProp.GetAll3(PropNames, PropTypes, PropValues, resolved, PropLink)
Dim TABLEAU() As String
ReDim TABLEAU(1 To ligne, 1 To 3) As String
Debug.Print "N° | Nom" & Space(16) & " | Type | Valeur"
For j = 0 To ligne - 1
custPropType = swCustProp.GetType2(PropNames(j))
If j + 1 < 10 Then i = "0" & j + 1
value = swCustProp.Get6(PropNames(j), UseCached, valout, ResolvedValOut, wasResolved, LinkToProperty)
'Debug.Print vPropNames(j) & " " & custPropType & " " & UseCached & " " & valout & " " & ResolvedValOut & " " & wasResolved & " " & LinkToProperty
Debug.Print i & " | " & PropNames(j) & Space(19 - (Len(PropNames(j)))) & " | " & custPropType & Space(4 - (Len(CStr(custPropType)))) & " | " & valout
TABLEAU(j + 1, 1) = PropNames(j)
TABLEAU(j + 1, 2) = custPropType
TABLEAU(j + 1, 3) = valout
Next j
'02-Supprime les propriétés
For j = 1 To ligne
swCustProp.Delete TABLEAU(j, 1)
Next j
'03-Ajouter les propriétés
'Le type 'équation' est transformé en 'texte'
'swCustomInfoDate 64
'swCustomInfoDouble 5
'swCustomInfoNumber 3
'swCustomInfoText 30
'swCustomInfoUnknown 0
'swCustomInfoYesOrNo 11
For j = 1 To ligne
value = swCustProp.Add2(TABLEAU(j, 1), TABLEAU(j, 2), TABLEAU(j, 3))
Next j
'Supprime le tableau
Erase TABLEAU
End Sub
