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
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
1 « J'aime »
Bonjour
Comme le dit sbadenis, Avec Get6, tu récupéreras la valeur de l’expression
1 « J'aime »
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
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
1 « J'aime »
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
Ci joint une capture,
J’ai utilisé get5 (version 2016)
Supprimer getall, ça serve pas grand chose, utilisez a la place, getnames
1 « J'aime »
Pour le nombre
Avez-vous bien choisi « nombre » dans le tableau des propriétés, pour moi la valeur retourné est correcte
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 ???
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
Si tu as une idée moi je ne comprends pas comment faire
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 
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
