Création Macro Enregistrement MEP PDF

vos questions concernant les API SolidWorks

Création Macro Enregistrement MEP PDF

Messagepar kiksystem » Jeu 22 Sep 2016, 8:54

Bonjour à tous,

Je souhaiterai créer une mise en plan qui enregistre la mise en plan active au format PDF mais avec un nouveau nom.

Le format serai le suivant:

Pour la pièce TOTO, la mise en plan PDF s'appelle TOTO_"Indice"_"Format de la feuille"_"Numéro de Page"_"Nombre de Page"

Par exemple:

- pour un pièces D092758218, avec aucun indice au format A3 et avec une seul page il faut écrire: D092758218___A3_1_1
- pour un pièces D092758220, avec _un indice B au format A2 et avec 2 pages il faut écrire pour la première page : D092758220_B_A2_1_2 et D092758220_B_A2_1_2.

Alors j'essaie de mon côté depuis pas mal de temps à retrouver toutes ces infos dans le cartouche et dans les propriétés du fichier. Mais à chaque fois que j'ajoute un espion sur un objet dans mes macros j'ai "<Aucune Variable>... Evil

Du coup pour le moment j'ai ça pour l'enregistrement du PDF:

Code: Tout sélectionner
Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Dim texte As String
Dim appsolid, dessolid As Object



Set swApp = _
Application.SldWorks
Set appsolid = GetObject(, "SldWorks.Application")
Set dessolid = appsolid.ActiveDoc
texte = dessolid.GetPathName()
texte = Replace(texte, "SLDDRW", "pdf")
Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
Part.ClearSelection2 True
longstatus = Part.SaveAs3(texte, 0, 0)
End Sub


Merci pour votre aide en attendant je creuse un peu le sujet... Mais sans espion je ne comprends pas comment je peux savoir où sont stockées mes infos tels que le format de la page, le nombre de pages, et extraire les indices du cartouches...

C'est un gros projet je trouve mais un gain de temps fabuleux pour une affaire de plus de 1000 pièces par exemple!

Merci à vous et bonne journée
kiksystem
Ewok SolidWorks
 
Messages: 8
Inscription: Jeu 23 Mai 2013, 14:02

Re: Création Macro Enregistrement MEP PDF

Messagepar CLLC » Ven 23 Sep 2016, 9:48

Bonjour

Le but en effet est de récupérer les info, puis de les ajouter au nom du fichier pour l'enregistrement.

Tu peux trouver les info relatives a la feuille ici:

http://help.solidworks.com/2012/English ... ple_VB.htm
Code: Tout sélectionner
' Get current sheet properties

    vSheetProps = swSheet.GetProperties

   
    ' Current sheet properties

    Debug.Print "Name = " + swSheet.GetName

    Debug.Print "  TemplateName              = " & swSheet.GetTemplateName

    Debug.Print "  PaperSize                 = " & vSheetProps(0)

    Debug.Print "  TemplateIn                = " & vSheetProps(1)

    Debug.Print "  Scale1                    = " & vSheetProps(2)

    Debug.Print "  scale2                    = " & vSheetProps(3)

    Debug.Print "  FirstAngle                = " & vSheetProps(4)

    Debug.Print "  Width                     = " & vSheetProps(5)

    Debug.Print "  Height                    = " & vSheetProps(6)



après tu peux chercher sur l'aide SW pour trouver les info.
https://www.google.fr/webhp?sourceid=chrome-instant&rlz=1C1KMZB_enFR627FR627&ion=1&espv=2&ie=UTF-8#q=solidworks+api+help+(vba)+example+get+sheet+properties

Ensuite trouver le moyen d'enregistrer une pdf une feuille spécifique:

Code: Tout sélectionner
Option Explicit
 
Sub main()
 
 
    Dim swApp               As SldWorks.SldWorks
    Dim swModel             As SldWorks.ModelDoc2
    Dim swDrawDoc           As SldWorks.DrawingDoc
    Dim swModelDocExt       As SldWorks.ModelDocExtension
    Dim swExportPDFData     As SldWorks.ExportPdfData
    Dim boolstatus          As Boolean
    Dim filename            As String
    Dim lErrors             As Long
    Dim lWarnings           As Long
    Dim strSheetName()      As String
    Dim varSheetName        As Variant
 
    ' Path to which to save PDF file of drawing
    filename = "C:\xxxxx.PDF"
   
    Set swApp = Application.SldWorks
    swApp.Visible = True
 
    Set swModel = swApp.ActiveDoc
    Set swDrawDoc = swModel
    Set swModelDocExt = swModel.Extension
 
    Set swExportPDFData = swApp.GetExportFileData(swExportDataFileType_e.swExportPDFData)
   
    ReDim strSheetName(0)
    Dim s As Variant
    For Each s In swDrawDoc.GetSheetNames
        If Not UCase(s) Like "*FLAT*" Then
            strSheetName(UBound(strSheetName)) = s
            ReDim Preserve strSheetName(UBound(strSheetName) + 1)
        End If
    Next s
   
    varSheetName = strSheetName
    If swExportPDFData Is Nothing Then MsgBox "Nothing"
    boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, varSheetName)
   
boolstatus = swModelDocExt.SaveAs(filename, 0, 0, swExportPDFData, lErrors, lWarnings)
 
End Sub
CLLC
Padawan SolidWorks
 
Messages: 68
Inscription: Ven 06 Juin 2014, 9:42

Re: Création Macro Enregistrement MEP PDF

Messagepar kiksystem » Lun 26 Sep 2016, 7:59

C'est bon problème résolue! :)

C'est génial le temps gagné!

Code: Tout sélectionner
Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long
Dim test As Long

'-----------------------
Dim FeuilleActive As String
Dim TotalFeuilles As String
Dim Nomfeuille As Variant
'-----------------------
Dim IndiceA As String
'-----------------------
Dim IndiceB As String
'-----------------------
Dim IndiceC As String

Dim swModel As Object
Dim swDraw As Object
Dim swDrawModel    As SldWorks.ModelDoc2
Dim swSheet As Object


Sub main()

'-------------------------------------------------
Dim swApp As SldWorks.SldWorks
    Dim swModel As ModelDoc2
    Dim swDwg As DrawingDoc
    Dim swSht As Sheet
    Dim sThisSheet As String
    Dim sSheetNames As Variant
    Dim iSheets As Integer
    Dim j As Integer
   
   
    Set swApp = GetObject(, "SldWorks.Application")
    Set swModel = swApp.ActiveDoc
    Set swpdf = swModel
   
    Set swSht = swpdf.GetCurrentSheet
    sThisSheet = swSht.GetName
   
    iSheets = swpdf.GetSheetCount
    sSheetNames = swpdf.GetSheetNames
    For j = LBound(sSheetNames) To UBound(sSheetNames)
            swpdf.ActivateSheet sSheetNames(j)
   
'---------------------------------------------------








Debug.Print "--------------------------"
Dim texte As String
Dim appsolid, dessolid As Object
Dim myModelView As Object


Set swApp = _
Application.SldWorks
Set appsolid = GetObject(, "SldWorks.Application")
Set dessolid = appsolid.ActiveDoc
Set Part = swApp.ActiveDoc
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swSheet = swDraw.GetCurrentSheet
Set myModelView = Part.ActiveView
Set swDrawModel = swApp.ActiveDoc

    Nomfeuille = swSheet.GetName
    Nomfeuille = swDraw.GetSheetNames
    Dim SheetNumber As Long
    Dim I As Integer
    For I = 1 To UBound(Nomfeuille) + 1
    If swSheet.GetName = Nomfeuille(I - 1) Then
    FeuilleActive = I
    Exit For
    End If
    Next I
    Debug.Print "Feuille n°" & FeuilleActive
    Debug.Print "Texte = " & swModel.GetPathName
    Debug.Print " NomFeuille = " & swSheet.GetName
    Debug.Print " Totalfeuilles = " & swModel.GetSheetCount
    swApp.ActivateDoc2 "Pièce1", False, longstatus

    TotalFeuilles = swModel.GetSheetCount








Set swApp = _
Application.SldWorks

Set Part = swApp.ActiveDoc
Set myModelView = Part.ActiveView

texte = dessolid.GetPathName()
texte = Replace(texte, "SLDDRW", "SLDPRT")
swApp.ActivateDoc2 texte, False, longstatus
Set Part = swApp.ActiveDoc

Set swModel = swApp.ActiveDoc

'-----------------------------------------

Debug.Print "IndiceA = " & swModel.CustomInfo2("", "DESCRIPTION INDICE A")

IndiceA = swModel.CustomInfo2("", "DESCRIPTION INDICE A")

'-----------------------------------------

Debug.Print "IndiceB = " & swModel.CustomInfo2("", "DESCRIPTION INDICE B")

IndiceB = swModel.CustomInfo2("", "DESCRIPTION INDICE B")


'-----------------------------------------

Debug.Print "IndiceC = " & swModel.CustomInfo2("", "DESCRIPTION INDICE C")

IndiceC = swModel.CustomInfo2("", "DESCRIPTION INDICE C")



texte = dessolid.GetPathName()
texte = Replace(texte, "SLDPRT", "SLDDRW")
swApp.ActivateDoc2 texte, False, longstatus
Set Part = swApp.ActiveDoc
Set myModelView = Part.ActiveView

Nomfeuille = swSheet.GetName

'-----------------
If IndiceA = "" Then
IndiceA = "_"
Else: IndiceA = Replace(IndiceA, IndiceA, "A")
    End If
'-----------------
If IndiceB = "" Then
Else: IndiceB = Replace(IndiceB, IndiceB, "B")
IndiceA = ""
    End If
'----------------
If IndiceC = "" Then
Else: IndiceC = Replace(IndiceC, IndiceC, "C")
IndiceA = ""
IndiceB = ""
    End If
'---------------

texte = dessolid.GetPathName()
Nomfeuille = Replace(Nomfeuille, " ", "")
texte = Replace(texte, ".SLDDRW", "_" & IndiceA & IndiceB & IndiceC & "_" & Nomfeuille & "_" & FeuilleActive & "_" & TotalFeuilles & ".pdf")
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
Part.ClearSelection2 True

Dim swExportpdfData As SldWorks.ExportPdfData
Set swExportpdfData = swApp.GetExportFileData(1)

Dim boolstatus As Boolean
boolstatus = swExportpdfData.SetSheets(swExportDataSheetsToExport_e.swExportData_ExportCurrentSheet, Nothing)
 
boolstatus = swDrawModel.Extension.SaveAs(texte, 0, 1, swExportpdfData, 0, 0)
 
Next j
   
End Sub
kiksystem
Ewok SolidWorks
 
Messages: 8
Inscription: Jeu 23 Mai 2013, 14:02


Retourner vers Questions générales sur les API

 


  • Articles en relation
    Réponses
    Vus
    Dernier message

Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 2 invités

banniere