Solidworks step vba modifier propriétés

ll1 · Novembre 4, 2022, 8:09

Salut tout le monde
quand je j’importe et enregistre un assemblage *.step en assemblage Solidworks avec toutes ses pièces séparées dans un dossier, les propriétés ne sont pas modifiables

j’ai créé une macro pour copier les propriétés, supprimer les propriétés, coller les propriétés
tout fonctionne sauf si le type de propriété est une équation de type formule (du genre matière par ex)

voici mon code, que j’exécuterais via Mycadtool Intégration pour boucler sur tous les fichiers assemblage et pièce

y a t il un truc qui m’aurait échappé dans la macro pour recopier la formule et pas le résultat de la formule

en gris les propriétés non modifiable
en blanc celle que j’ai rajouté
si je rajoute pour l’essai (je n’ai pas de fichier avec ce type : formule dans les step, je le fais pour tous les cas) une formule son résultat est copié mais pas la formule

Vis C-HC (4)_Vis C-Hc-M3-10.SLDPRT (137,4 Ko)

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

sbadenis · Novembre 4, 2022, 10:19

Tu récupère la valeur évaluée de la propriété, il faudrait récupérer la valeur /Expression de la propriété voir ce sujet:

Les propriétés concernés:
Debug.Print indent & "Value/Text Expression: " & prpVal
Debug.Print indent & "Evaluated Value: " & prpResVal

Lynkoa15 · Novembre 4, 2022, 10:30

Bonjour
Comme le dit sbadenis, Avec Get6, tu récupéreras la valeur de l’expression

ll1 · Novembre 4, 2022, 11:15

je ne sais pas comment ecrire la macro
j’ai essayé ca mais ca ne donne qu’un beug ; tableau attendu à la ligne
« 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

Lynkoa15 · Novembre 4, 2022, 12:51

Fieldname est le nom de la propriété a entrer (non pas sortie) y’a qu’a implémenter avec le code précédent, t’as récupéré le nom avec getall, utilise get6 pour récupérer l’expression

ll1 · Novembre 4, 2022, 1:43

j’ai beaucoup de mal avec les macros

je ne comprend pas entre autre pourquoi (Len(custPropType)) ne renvoie pas la valeur correct
pour un type : nombre il renvoie 4 alors que le resultat est 3 soit 1 de longeur ???

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

Lynkoa15 · Novembre 4, 2022, 1:55

Ci joint une capture,
J’ai utilisé get5 (version 2016)
Supprimer getall, ça serve pas grand chose, utilisez a la place, getnames

Lynkoa15 · Novembre 4, 2022, 2:04

Pour le nombre
Avez-vous bien choisi « nombre » dans le tableau des propriétés, pour moi la valeur retourné est correcte
Capture2

ll1 · Novembre 4, 2022, 2:10

oui j’ai mis nombre mais len doit compter le nombre de caracteres or la propriété nombre renvoie le chiffre 3 il trouve 4 chiffres ???

Lynkoa15 · Novembre 4, 2022, 2:24

Je viens de voir cette fonction, ce n’est ni 4 ni 3 mais un 1,vue que ça traite les chaînes caractères, donc pour un résultat pertinent va falloir utiliser (ou convertir en) string

ll1 · Novembre 4, 2022, 2:25

Si tu as une idée moi je ne comprends pas comment faire

Lynkoa15 · Novembre 4, 2022, 2:28

J’ai simplement utilisé
Dim custproptype as string
Vue que vba utilise un système de conversion autonome,
Il ya aussi la fonction cstr(integer)
Len(cstr(custproptype) )
Je conseil la deuxième méthode,si jamais la propriété est utilisée autre part, mieux préserver la consistance des types

ll1 · Novembre 4, 2022, 2:41

Super tout fonctionne grâce à votre aide à tous

voici la macro
à modifier suivant les commentaires pour ceux qui le souhaite
On remarquera que le type ‹ équation › est transformé en ‹ texte › mais bon ça fonctionne quand même

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

Lynkoa15 · Novembre 5, 2022, 3:43