API: Enregistrer un plan en pdf avec une propriété personnalisée d'une pièce 3D

Bonjour,

Pour la partie enregistrement en PDF tous ce passe bien si le nom du fichier enregistré en PDF et le même que la mise en plan.

Malheureusement, aujourd'hui je dois changer la macro qui fonctionne parfaitement.

Pour cela le fichier enregistré donc le PDF doit être renommé en utilisant une propriété de la pièce. Nom de la propriété ENREGISTREMENT.

Je fais déjà appel à cette propriété dans le cartouche de la mise en plan sans problème.

Mais lors de l'enregistrement le nom de fichier et $PRPSHEET:"ENREGISTREMENT" et non EN2-A-000-12-A.

Je ne sais pas si je suis bien clair !

Cordialement,

Bonjour,

Peux-tu mettre à disposition le code pour analyse plus une copie d'écran des propriétés de ta mise en plan ?

Cordialement,

cette macro recupère le modèle utiliser dans la mise en plan, ainsi que la configuration activé du composant

l'ouvre recupère la propriété test lié à la configuration

et enregistre le plan en PDF dans le même chemin que le composant avec comme nom, la valeur de la propriété

 

en espérant avoir répondu à ta demande

 

 

 

Option Explicit
Dim swApp               As SldWorks.SldWorks
Dim swModel             As SldWorks.ModelDoc2
Dim swDraw              As SldWorks.DrawingDoc
Dim cusPropMgr          As SldWorks.CustomPropertyManager
Dim swView              As SldWorks.View
Dim swModelDocExt       As SldWorks.ModelDocExtension
Dim config              As SldWorks.Configuration
Dim Nameproperties      As String
Dim Lerrors             As Long
Dim Lwarnings           As Long
Dim configname          As String
Dim lRetVal             As Long
Dim ValOut              As String
Dim ResolvedValOut      As String
Dim wasResolved         As Boolean
Dim strRefModelPath     As String
Dim NamePlan            As String
Dim chemin              As String


Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    If swModel.GetType = 3 Then
    Set swDraw = swModel
    Set swView = swDraw.GetFirstView
    NamePlan = swModel.GetTitle
    'BOUCLE POUR RECUPERER LE MODELE
    Do While Not swView Is Nothing
        strRefModelPath = swView.GetReferencedModelName 'recupere le chemin complet du fichier
        configname = swView.ReferencedConfiguration 'recupere la configuration de la vue
        If strRefModelPath <> "" Then
                chemin = Left(strRefModelPath, InStrRev(strRefModelPath, "\") - 1) 'recupere le chemin sans le nom de fichier
                swApp.ActivateDoc (strRefModelPath)
                Set swModel = swApp.ActiveDoc
                swModel.ShowConfiguration2 (configname) 'affiche la configuration du plan
                Set config = swModel.GetActiveConfiguration 'recupere la configuration active du composant 
                Set cusPropMgr = config.CustomPropertyManager
                Nameproperties = CopyCustProps("TEST") 'recupere la valeur de la proprieté test qui est spécifique à la configuration
            Exit Do
        End If
        Set swView = swView.GetNextView
    Loop

    Else
    MsgBox "Veuillez activer une mise en plan", vbInformation, "Erreur type de document"
    End If
        'reactivation du plan
        swApp.ActivateDoc NamePlan
        Set swModel = swApp.ActiveDoc
        Set swModelDocExt = swModel.Extension
        'définition du noma d'enregistrement
        NamePlan = chemin & "\" & Nameproperties & ".pdf"
        'enregistrement pdf
         wasResolved = swModelDocExt.SaveAs(NamePlan, 0, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, Lerrors, Lwarnings)
End Sub

Function CopyCustProps(PropertyName) As String
lRetVal = cusPropMgr.Get5(PropertyName, False, ValOut, ResolvedValOut, wasResolved)
CopyCustProps = ResolvedValOut
End Function

4 « J'aime »

Bonjour,

Même demande que d.roger. Si la propriété est utilisée dans le plan il est plus simple de boucler dans les notes du cartouche que de récupérer les informations via une vue et le 3D qui y est rattaché (pour peu qu'il y ait différentes vue avec différents modèles rattachés ça devient vite compliqué).

En gros:

Const cProp =  "$PRPSHEET:""ENREGISTREMENT"""
Dim sFilename as string

Set swDraw = swModel
Set swView = swDraw.GetFirstView 'Active le fond de plan
Set swNote = swView.GetFirstNote
swModel.ClearSelection2 (True)
Do While Not swNote Is Nothing
    Set swAnn = swNote.GetAnnotation
    If swNote.PropertyLinkedText = cProp Then
        sFilename = swNote.GetText 'ajouter le traitement pour formater correctement le nom d'enregistrement
    End If
    Set swNote = swNote.GetNext
Loop


 

1 « J'aime »

Bonjour,

Merci pour vos réponses.

gdm j'ai une erreur "compilation : variable non définie" avec "swSaveAsOptions_e"

Bien entendu d.roger ci-dessous la partie code pour l'enregistrement.

Cyril.f oui la propriété et utilisée dans la mise en plan, j'ai créeée une Note avec le Nom de l'attribut "INFO_QUALITE05"

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
' ajout controle du bon fichier
If Part Is Nothing Then
    MsgBox "Aucun fichier n'est actuellement ouvert."
    Exit Sub ' If no model is currently loaded, then exit
End If
' Determine the document type. If the document is a drawing, then send a message to the user.
If (Part.GetType <> 3) Then '1Part 2Assembly 3Document
    MsgBox "Cette macro ne s'applique que sur une mise en plan"
    Exit Sub
End If
File = Part.GetPathName
If File = "" Then
    MsgBox "Cette macro necessite que le fichier soit préalablement enregistré"
    Exit Sub
End If

Chemin = Left(File, InStrRev(File, "\"))
NomFichier = Part.GetCustomInfoValue("", "ENREGISREMENT")

Set swModelDocExt = Part.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
Set swdraw = Part
vSheetNames = swdraw.GetSheetNames
Dim i As Long
Dim j As Long
j = 0
ReDim strSheetName(UBound(vSheetNames))
For i = 0 To UBound(vSheetNames)
    If InStr(vSheetNames(i), "Plan") <> 0 Then
        strSheetName(j) = vSheetNames(i)
        j = j + 1
    End If
Next
varSheetName = strSheetName
If swExportPDFData Is Nothing Then MsgBox "Nothing"
boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, varSheetName)

'Ajout pour propriete de la piece
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swdraw = swModel
Set swview = swdraw.GetFirstView
Set swview = swview.GetNextView
v = swview.GetVisibleComponents
Set comp = v(0)
Set swmod = comp.GetModelDoc2
Propname = swmod.GetCustomInfoNames
Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")
Debug.Print swmod.GetCustomInfoValue(config, "DESCRIPTION")

'ENREGISTREMENT
boolstatus = swModelDocExt.SaveAs(Chemin & "\" & NomFichier & "" & swmod.GetCustomInfoValue(config, "INFO_QUALITE05") & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings)


proprietes_mep.png

il faut activer la référence en pièce jointe

 

ou remplacer swSaveAsOptions_e.swSaveAsOptions_Silent par 1 dans le code

 


ref.jpg

Merci gdm, c'est OK pour ce passage en remplacent par 1 dans le code je suis sous Solidworks 2013.

Il reste une autre erreur d'exécution '438': Propriété ou méthode non gérée ^par cet objet au niveau de lRetVal = cusPropMgr.Get5(PropertyName, False, ValOut, ResolvedValOut, wasResolved)

Cordialement,

La fonction Get5 n'existait pas encore pour la version 2013, à remplacer par Get4 et forcément il faut changer le nombre d'arguments de la fonction !!!

Merci d.roger ça marche mieux !

Même si malheureusement je ne comprends pas tout de la macro je vais la reprendre quand j'aurais un peu plus de temps.

Dans tous les cas elle fait le job merci à vous.