Enregistrement PDF

Out of category
1

Bonjour,
Je souhaiterais faire un enregistrement PDF de mes mises en plan dans un dossier défini avec une mise en forme défini par les infos de la mise en plan

exemple: Noirmoutier - Bonnotte - MP - Ind C - Date

en gras ce que je remplis dans Solidworks et en italique ce qu'il faudrait rajouter

Dans chaque mise en plan que je fais, j'ai les propriétés suivantes à remplir:

Nom de la propriété
indice               C
Ville                  Noirmoutier
Rue/Quartier    Bonnotte

et je l'enregistre pour l'instant dans un dossier sur mon PC "D:\Téléchargements\Plan PDF\___.PDF".

Si possible plus tard, il faudrait que je remplace ce dossier par un dossier du futur serveur à distance (en passant par un VPN surement) 

Voilà pour l'instant une macro toute simple que j'ai réussi à faire (un miracle que ça marche lol)
Pouvez-vous m'aider à la rédaction de cette macro?

Pour infos, j'ai besoin d'enregistrer toutes les feuilles de ma mise en plan donc généralement entre 4 et 8 feuilles dans le même fichier

Merci d'avance

' ******************************************************************************
' C:\Users\Proprietaire\AppData\Local\Temp\swx1544\Macro1.swb - macro recorded on 11/17/17 by Proprietaire
' ******************************************************************************
Dim swApp As Object

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

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized

' Save As
longstatus = Part.SaveAs3("D:\Téléchargements\Plan PDF\MP.PDF", 0, 0)
End Sub


 


ext_to_pdf.swp
2

Voir ce poste juste en dessous!

http://www.lynkoa.com/forum/mise-en-plan/macro-pdf-enregistrer-sous

3 « J'aime »
3

Pour raccourcir ta recherche voici peut etre la macro qui correspond.

Cdt

 

Macro:

Dim swApp               As Object
Dim Part                As SldWorks.ModelDoc2
Dim swView              As SldWorks.View
Dim swModExt            As SldWorks.ModelDocExtension
Dim Prop                As SldWorks.CustomPropertyManager
Dim swExportPDFData     As SldWorks.ExportPdfData
Dim boolstatus          As Boolean
Dim swModel             As SldWorks.ModelDoc2
Dim swPathName          As String
Dim swPath              As String
Dim swName              As String
Dim ValOut              As String
Dim Att                 As String
Dim OldAtt              As String
Dim iAtt                As Integer
Dim Errors              As Long
Dim Warnings            As Long
Dim oFSO                As Scripting.FileSystemObject
Dim oFld                As Folder
Const swDocDRAWING = 3

Sub main()

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc 'associe part au document en cours
Set oFSO = New Scripting.FileSystemObject


If Part.GetType = swDocDRAWING Then 'verif type document

    Set swModExt = Part.Extension
    Set Prop = swModExt.CustomPropertyManager("")
    iRet = Prop.Set("Bon_Pour", " ")
    
    Part.ForceRebuild3 True

    Set swView = Part.GetFirstView
    'la première vue étant la feuille, passage à la suivante
    Set swView = swView.GetNextView
    'récupération de la pièce
    Set swModel = swView.ReferencedDocument
    Set swModExt = swModel.Extension
    'affectation de "Indice" à "Att"
    Set Prop = swModExt.CustomPropertyManager("")
    boolstatus = Prop.Get3("Indice", False, ValOut, Att)
    If Att = " " Then Att = ""
    
    'récupération du chemin complet
    swPathName = Part.GetPathName
    If swPathName = "" Then
        swApp.SendMsgToUser ("Le fichier de mise en plan n'est pas enregistré, veuillez le faire et recommencer")
        Exit Sub
    End If
    
    'affectation de l'emplacement du dossier
    swPath = Left(swPathName, InStrRev(swPathName, "FABRICATION", , 1))
    swPath = swPath & "C:\..."
    
    'vérification de l'existence du chemin swPath
    If oFSO.FolderExists(swPath) = False Then
        swApp.SendMsgToUser ("Erreur d'enregistrement : vérifier la présence du répertoire : '" & swPath + "'")
        Exit Sub
    End If
    
    'récupération du nom
    swName = Right(swPathName, Len(swPathName) - InStrRev(swPathName, "\"))
    swName = Left(swName, InStrRev(swName, ".") - 1)
    
    swPathName = swPath + swName
    
    'récupération de l'indice précédent
    If Att = "A" Then
        OldAtt = ""
    ElseIf Att = "" Then
        OldAtt = ""
    Else
        iAtt = Asc(Att)
        iAtt = iAtt - 1
        OldAtt = Chr(iAtt)
    End If
    
suite:
    
    'enregistrement dxf
    'swPathName = swPathName & Att + ".dxf" ' ajoute .dxf"
    'Set swModExt = Part.Extension
    'Part.ViewZoomtofit2
    'boolstatus = swModExt.SaveAs(swPathName, 0, 0, swExportPDFData, Errors, Warnings) 'sauvegarde en dxf
    
    'enregistrement pdf
    swPathName = swPath + swName
    swPathName = swPathName & Att + ".pdf" ' ajoute .pdf"
    Set swModExt = Part.Extension
    Part.ViewZoomtofit2
    boolstatus = swModExt.SaveAs(swPathName, 0, 0, swExportPDFData, Errors, Warnings) 'sauvegarde en pdf

    
    
    Else: swApp.SendMsgToUser ("Cette macro fonctionne uniquement avec une mise en plan")
    
End If

Fin:
    
End Sub
2 « J'aime »
4

Bonjour,

Comme pour le post http://www.lynkoa.com/forum/mise-en-plan/macro-pdf-enregistrer-sous, tu dois pouvoir partir de la macro jointe.

Si tu ne veux pas sélectionner le dossier de destination mais le définir dans le code alors tu peux supprimer les lignes :

Set objShell = New Shell
Set objFolder = objShell.BrowseForFolder(0, "Veuillez sélectionner le dossier de destination des fichiers PDF.", 0, 0)
If (Not objFolder Is Nothing) Then

et le End If correspondant

et définir la variable path comme suit :

Path = "D:\Téléchargements\Plan PDF"

Il te faut aussi modifier les lignes :

swCustProp.Get2 "Numero plan", valOut1, resolvedValOut1
swCustProp.Get2 "Ind1", valOut2, resolvedValOut2

pour mettre le nom de tes variables et, forcément ajouter une autre ligne similaire puisque tu as 3 propriétés à récupérer.

Il te faut aussi modifier la ligne :

nFileName = Path & "\" & resolvedValOut1 & "-" & resolvedValOut2 & "-" & swSheet.GetName & ".PDF"

pour l'adapter aux noms de fichiers que tu veux mettre.

Pour la date, il faut que tu remplace les / de celle-ci par autre caractère sinon cela va créer un problème dans le nom du fichier, par exemple :

Dim dateNow As String
dateNow = Replace(Date, "/", "-")

Et c'est donc le dateNow qu'il mettre dans le nom du fichier.

Cordialement,


macro_pdf_enregistrer_sous.swp
5

Bonjour

Merci @sbadenis pour ta réponse, je l'avais lu. 

Merci @G. pour ta réponse, j'ai essayé hier en modifiant 2 ou 3 truc pour changer le dossier de destination mais ça n'a pas fonctionner

Merci @d.roger pour ta réponse. j'essaye ça demain ou ce weekend et je reviens vers vous pour dire ce que ça donne.

Bonne journée à vous tous

6

alors alors, qu'est ce que ça a donné??? :)