VBA Solidworks, récupérer propriété personnalisé d'une pièce.

js_1207 · Février 2, 2018, 1:07

Bonjour à tous,

Je code pas mal sur VBA excel, et j'aimerai l'utiliser dans SW.

Je souhaiterai extraire les données personnalisé d'une pièce sur un doc excel.

Du coup si qu'elqu'un peut m'aider à juste me faire apparaitre une propriété personnalisé d'une piece en msgbox après je me débouille pour le reste.

Merci d'avance

d.roger · Février 2, 2018, 1:45

Bonjour,

Voir le code ci-dessous :

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

Cordialement,

Cyril.f · Février 2, 2018, 1:46

Bonjour,

Sujet déjà abordé plusieurs fois mais: http://help.solidworks.com/2016/english/api/sldworksapi/Get_Custom_Properties_of_Referenced_Part_Example_VB.htm

d.roger · Février 2, 2018, 2:30

Les exemples ci-dessus permettent de récupérer les propriétés personnalisées de l'onglet "Personnaliser", si tu veux aussi récupérer celles de l'onglet "Spécifiques à la configuration" et ça pour chaque configuration alors tu peux voir un exemple sur le lien suivant : http://help.solidworks.com/2013/English/api/sldworksapi/Get_Custom_Properties_Example_VB.htm

Cordialement,

js_1207 · Février 5, 2018, 11:07

Bonjour à tous et merci pour votre réactivité. La mienne est moin bonne car je suis bien chargé niveau taf en ce moment...

J'avais bien remarqué les différents post, mais quand dans ma pièce j'ai la propriété personalisée "Finition" et que je veux une msgbox "RAL9010" quand j'execute ma macro, je n'y arrive pas...

Cyril.f · Février 5, 2018, 11:48

Bonjour,

Si tu pouvais poster ta macro ça serait plus simple.

d.roger · Février 5, 2018, 12:06

Bonjour,

Si tu souhaites piloter Solidworks depuis Excel il faut penser à déclarer SolidWorks dans Excel par un "CreateObject" et mettre les références nécessaires dans ta macro. La macro du premier post fonctionne et affiche un msgbox comprenant le "nom de la propriété - Expression de texte - Valeur évaluée" pour chaque propriété de l'onglet personnaliser.

Cordialement,

d.roger · Février 5, 2018, 12:17

Donc :

et :

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

donne :

Cordialement,

js_1207 · Février 5, 2018, 1:32

En fait, ça marche très bien c'est juste que j'ai confondu propriété personnailsé et lzq spécifiques à la configuration... quelle nouille pffff

Est-ce possible de faire la même chose avec les spécifiques?

Merci à vous tous!

d.roger · Février 5, 2018, 1:48

Bonjour,

Oui, c'est marqué plus haut :

Les exemples ci-dessus permettent de récupérer les propriétés personnalisées de l'onglet "Personnaliser", si tu veux aussi récupérer celles de l'onglet "Spécifiques à la configuration" et ça pour chaque configuration alors tu peux voir un exemple sur le lien suivant : http://help.solidworks.com/2013/English/api/sldworksapi/Get_Custom_Properties_Example_VB.htm

Cordialement,

js_1207 · Février 5, 2018, 1:52

Au top!!!

une derniere question : je cherche a récuperer la valeur évalué, et non la valeur.

nNumProp = swConfig.GetCustomProperties(vPropName, vPropValue, vPropType)

Merci d'avance

Cyril.f · Février 5, 2018, 3:39

Bonjour,

Pour ma part j'utilise plutôt ça:

Set swCustProp = swConfig.CustomPropertyManager
boolstatus = swCustProp.Get5("xxx", False, ValOut, ResolvedValOut, WasResolved) 'Changer "xxx" par le nom de la propriété du fichier 3D

Valout = Valeur de l'expression

ResolvedValout = Valeur calculée

d.roger · Février 5, 2018, 4:20

Je suis d'accord avec Cyril.f, voici un exemple pour relevé les valeurs "nom de la propriété - Expression de texte - Valeur évaluée" pour chaque propriété de la config active :

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

Cordialement,

d.roger · Février 5, 2018, 4:32

Ou encore, si tu connais le nom de ta config, il y a juste à changer la ligne :

Set cusPropMgr = swModelDocExt.CustomPropertyManager("")

par :

Set cusPropMgr = swModelDocExt.CustomPropertyManager("xxxxxxx")

dans la macro donnée en meilleure réponse, xxxxxxx étant le nom de la config.

Cordialement,

js_1207 · Février 6, 2018, 9:57

Parfait!!! J'ai fini mon programme et ça fonctionne à merveille...

Maintenant je dois regarder pour récuperer les propriété personnalisées de chaque pièces d'un assemblage...

Encore merci à toute l'équipe.

system · Mars 8, 2018, 7:30

Bonjour tout le monde,

J'avais un code que j'avais fait sous SW2014 qui marchait à merveille aussi mais qui ne veut plus en SW2016.

Voici le code en cause :

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

La partie "DSO.CustomProperties.Count" ne fonctionne plus... de ce que j'ai pu voir, ce serait la partie DSO qui n'est plus pris en compte. Mais je ne sais pas par quoi il faut la remplacer...

Merci pour votre aide

d.roger · Mars 8, 2018, 10:03

Bonjour,

Il serait préférable de créer une nouvelle question plutôt que de se mettre à la file d'une question déjà résolue, c'est plus facile ensuite pour retrouver des réponses à des problèmes donné.

Pour ton problème de DSO qui ne fonctionne plus je pense qu'il va te falloir ré-écrire ta macro, voir https://forum.solidworks.com/thread/88676.

Cordialement,

system · Mars 9, 2018, 9:14

Ah désolé... on peut transférer cette échange vers un nouveau sujet ?

Merci pour ta réponse. Quelle est la méthode alors depuis 2015 ?

gt22 · Mars 9, 2018, 9:19

ouvre une autre question merci

@+

system · Mars 9, 2018, 9:43

voilà : http://www.lynkoa.com/forum/solidworks/r%C3%A9cupererecrire-propri%C3%A9t%C3%A9s-personalis%C3%A9s-avec-excel-sans-methode-dso-inactive-depuis