API : Récupérer une propriété personnalisée d'une pièce depuis une mise en plan

fmaisonneuve_1 · Février 28, 2018, 8:14

Bonjour,

Je recherche à attribuer à ma variable "TypePiece" la valeur de la propriété "Type" (quand elle existe).

J'ai déjà trouver quelques sujets sur le forum ou ailleurs mais aucun n'as porté ses fruits...

Ma macro se lance quand la vue de la pièce est sélectionnée.

La finalité c'est de pouvoir dissocier les pièces avec la propriété type=PROFILE et celle sans propriété type pour pouvoir créer une annotation automatique adaptée.

Cordialement,

Function Attache_PrivateAnnotation(swModel As SldWorks.ModelDoc2, selView As SldWorks.View, Position As Variant)
    Dim Note As Object
    Dim Annotation As Object
    Dim TextFormat As Object
    Dim Namev As String
    Dim strAnnot As String
    Dim TypePiece As String
     
     Set SWmoddoc = swApp.ActiveDoc
     TypePiece = SWmoddoc.GetCustomInfoValue("", "Type")
     MsgBox (TypePiece)
     
     
     
    'Namev = selView.GetName2()  ' on recupere le nom de la vue
    'la synthaxe pour obtenir une propriété est $PRP:"NomPropriete"
    ' on rentre les annotations ligne par ligne avec possibilité de faire des tests sur chaque pour avoir comme resultat l'annotation complete en variable
    ''strAnnot = "Rep: " + "$PRP:""" + Namev + "_NUM""" + vbNewLine
    'strAnnot = strAnnot + "Qt: " + "$PRP:""" + Namev + "_QT""" + vbNewLine
    'strAnnot = strAnnot + "Ep: $PRPSHEET:""Epaisseur"" "
    'If BOM_ReadPropertie(swModel, "", Namev + "Epaisseur") <> "" Then ' si la piece a une epaisseur
    'strAnnot = strAnnot + "Ep: " + "$PRP:""" + Namev + "Epaisseur""" + vbNewLine  'on ajoute l'epaisseur
    'End If
    Set Note = swModel.InsertNote(strAnnot) 'insertion de l'annotation
    If Not Note Is Nothing Then 'si elle est créée
       Note.Angle = 0 ' angle de zero
       boolstatus = Note.SetBalloon(0, 0) 'pas d'encadrement
       Set Annotation = Note.GetAnnotation() 'on recupere l'annotation pour la formater autrement
       If Not Annotation Is Nothing Then 'si elle est créée
          longstatus = Annotation.SetLeader2(False, 0, True, False, False, False)   'format de l'annotation (pas de fleche...)
          boolstatus = Annotation.SetPosition(Position(0), Position(1), Position(2))    'on récupere les coordonnées du variant Position
          boolstatus = Annotation.SetTextFormat(0, True, TextFormat)    'Format du text
       End If
    End If
End Function

Cyril.f · Février 28, 2018, 10:51

Bonjour,

La propriété est une donnée provenant du 3D, il faut donc obtenir les propriétés de ce fichier en récupérant le nom du fichier rattaché à la vue l'ouvrir puis lire la propriété.

En gros il faut passer par swView.GetReferencedModelName et swView.ReferencedConfiguration s'il y a des fichiers à configuration.

Ensuite, activer le modèle (puisque déjà ouvert en arrière plan) et traiter la récupération de la propriété.

fmaisonneuve_1 · Mars 2, 2018, 12:42

Merci de votre réponse,

Pour bien comprendre la démarche, j'ai réalisé une petite macro qui à pour objectif de me donner le Type de pièce dans une MsgBox. En utilisant la fonction swView.GetReferencedModelName, je récupère le nom et le chemin du fichier qui appartient à la vue sélectionnée dans ma mise en plan. Mais je ne parviens toujours pas à retrouver ma propriété.

Sub main()

Dim swApp       As SldWorks.SldWorks
Dim swModel     As SldWorks.ModelDoc2
Dim swDraw      As SldWorks.DrawingDoc
Dim swSelMgr    As SldWorks.SelectionMgr
Dim swView      As SldWorks.View

Dim Fichier   As String
Dim Type_Piece  As String


Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swSelMgr = swModel.SelectionManager
Set swView = swSelMgr.GetSelectedObject6(1, -1)

Fichier = swView.GetReferencedModelName
MsgBox (Fichier)

Type_Piece = Fichier.GetCustomInfoValue("", "Type")
MsgBox (Type_Piece)

End Sub

Cyril.f · Mars 2, 2018, 1:51

Bonjour,

Il faut ajouter grosso modo ça à la suite:

Dim swCustProp                  As CustomPropertyManager
Dim swConfig                    As SldWorks.Configuration
Dim boolstatus                  As Boolean
Dim WasResolved                 As Boolean
Dim ValOut                      As String
Dim ResolvedValOut              As String


Set swModel = swApp.ActivateDoc3(Fichier, True, swOpenDocOptions_Silent, nErrors)
Set swModel = swApp.ActiveDoc
Set swConfig = swModel.GetActiveConfiguration
Set swCustProp = swConfig.CustomPropertyManager
boolstatus = swCustProp.Get5("Type", False, ValOut, ResolvedValOut, WasResolved)
Debug.print ResolvedValOut

Pour rebasculer sur le plan à la fin et continuer le traitement il faudra ajouter les deux lignes ci-dessous dans le code final.

swApp.CloseDoc (Fichier)
Set swModel = swApp.ActiveDoc

fmaisonneuve_1 · Mars 2, 2018, 2:37

Je comprend la logique de votre code, mais la macro ne se lance pas, VBA n'aime pas le "nErrors". Il m'indique une erreur de compilation "Type d'argument ByRef incompatible". Comme si ma variable swModel n'est pas du type attendu.

Cyril.f · Mars 2, 2018, 2:47

Din nErrors as Long

fmaisonneuve_1 · Mars 2, 2018, 2:48

Mais oui, je suis con.

Maintenant, la macro se lance, mais dans ma MsgBox ou je suis sensé afficher la propriété "Type", je n'ai rien...

Cyril.f · Mars 2, 2018, 3:10

Il faut appeler la variable ResolvedValOut ou la stocker dans une autre variable de type string

fmaisonneuve_1 · Mars 2, 2018, 3:12

Oui, j'ai écrit ça :

boolstatus = swCustProp.Get5("Type", False, ValOut, ResolvedValOut, WasResolved)
swApp.CloseDoc (Fichier)

MsgBox (ResolvedValOut)

Cyril.f · Mars 2, 2018, 3:15

Le fichier utilisé contient-il une valeur en face de la propriété Type ou pas? J'ai testé avec le code ci-dessous avec une autre propriété de nos fichiers et pas de problèmes.

Sub main()

Dim swApp       As SldWorks.SldWorks
Dim swModel     As SldWorks.ModelDoc2
Dim swDraw      As SldWorks.DrawingDoc
Dim swSelMgr    As SldWorks.SelectionMgr
Dim swView      As SldWorks.View
Dim swCustProp                  As CustomPropertyManager
Dim swConfig                    As SldWorks.Configuration
Dim boolstatus                  As Boolean
Dim WasResolved                 As Boolean
Dim ValOut                      As String
Dim ResolvedValOut              As String
Dim nErrors As Long
Dim Fichier   As String
Dim Type_Piece  As String

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swSelMgr = swModel.SelectionManager
Set swView = swSelMgr.GetSelectedObject6(1, -1)

Fichier = swView.GetReferencedModelName

Set swModel = swApp.ActivateDoc3(Fichier, True, swOpenDocOptions_Silent, nErrors)
Set swModel = swApp.ActiveDoc
Set swConfig = swModel.GetActiveConfiguration
Set swCustProp = swConfig.CustomPropertyManager
boolstatus = swCustProp.Get5("Reference", False, ValOut, ResolvedValOut, WasResolved)
swApp.CloseDoc (Fichier)

MsgBox (ResolvedValOut)

End Sub

fmaisonneuve_1 · Mars 2, 2018, 3:32

Idem, ma MsgBox est vide.

J'ai pourtant bien la propriété "Type" dans ma pièce.

capture_20180302png.png

Cyril.f · Mars 2, 2018, 3:36

Essaye plutôt ce code alors:

Sub main()

Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim swDraw          As SldWorks.DrawingDoc
Dim swSelMgr        As SldWorks.SelectionMgr
Dim swView          As SldWorks.View
Dim swCustProp      As CustomPropertyManager
Dim swModelDocExt   As ModelDocExtension
Dim boolstatus      As Boolean
Dim WasResolved     As Boolean
Dim ValOut          As String
Dim ResolvedValOut  As String
Dim nErrors         As Long
Dim Fichier         As String
Dim Type_Piece      As String

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swSelMgr = swModel.SelectionManager
Set swView = swSelMgr.GetSelectedObject6(1, -1)

Fichier = swView.GetReferencedModelName

Set swModel = swApp.ActivateDoc3(Fichier, True, swOpenDocOptions_Silent, nErrors)
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")

boolstatus = swCustProp.Get5("Type", False, ValOut, ResolvedValOut, WasResolved)
swApp.CloseDoc (Fichier)

MsgBox (ResolvedValOut)


End Sub

Le code proposé avant allait chercher les informations dans l'onglet spécifique à la configuration. Ce code va chercher dans "Personnaliser".

fmaisonneuve_1 · Mars 2, 2018, 3:42

Nickel !

Merci.