PDF Registration

Out of category
1

Hello
I would like to make a PDF recording of my drawings in a defined folder with a formatting defined by the drawing information

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

in bold what I fill in Solidworks and in italics what should be added

In every drawing I make, I have the following properties to fill in:

Property Name
C-index              
City                  of Noirmoutier
Rue/Quartier    Bonnotte

and I save it for the moment in a folder on my PC "D:\Downloads\PDF Plan\___.PDF".

If possible later, I should replace this folder with a folder of the future remote server (using a VPN probably) 

Here is for now a very simple macro that I managed to make (a miracle that it works lol)
Can you help me write this macro?

For your information, I need to save all the sheets of my drawing so usually between 4 and 8 sheets in the same file

Thanks in advance

' ******************************************************************************
' 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

See this post just below!

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

3 Likes
3

To shorten your search, here may be the macro that corresponds.

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 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 'Associates Part To The Document In Progress
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
    ' the first view being the sheet, moving on to the next
    Set swView = swView.GetNextView
    ' retrieving the part
    Set swModel = swView.ReferencedDocument
    Set swModExt = swModel.Extension
    ' assigning "Hint" to " Att"
    Set Prop = swModExt.CustomPropertyManager("")
    boolstatus = Prop.Get3("Hint", False, ValOut, Att)
    If Att = " " Then Att = ""'
    
    Full Path
    Recovery swPathName = Part.GetPathName
    If swPathName = "" Then
        swApp.SendMsgToUser ("The drawing file is not saved, please do it and start over")Exit
        Sub
    End If
    
    Assigning the folder
    location swPath = Left(swPathName, InStrRev(swPathName, "FABRICATION", , 1))
    swPath = swPath & "C:\... "
    
    'verifying the existence of the path swPath
    If oFSO.FolderExists(swPath) = False Then
        swApp.SendMsgToUser ("Registration error: check for the presence of the directory: '" & swPath + "'")
        Exit Sub
    End If
    
    ' fetching the name
    swName = Right(swPathName, Len(swPathName) - InStrRev(swPathName, "\"))swName
    = Left(swName, InStrRev(swName, ".") - 1)
    
    swPathName = swPath + swName
    
    ' retrieving previous hint
    If Att = "A" Then
        OldAtt = ""
    ElseIf Att = "" Then
        OldAtt = ""Else
        
    iAtt = Asc(Att)
        iAtt = iAtt - 1
        OldAtt = Chr(iAtt)
    End If
    
suite:
    
    'record dxf
    'swPathName = swPathName & Att + ".dxf" ' add .dxf"
    'Set swModExt = Part.Extension
    'Part.ViewZoomtofit2
    'boolstatus = swModExt.SaveAs(swPathName, 0, 0, swExportPDFData, Errors, Warnings) 'save as dxf
    
    ' pdf
    record swPathName = swPath + swName
    swPathName = swPathName & Att + ".pdf" ' add .pdf"
    Set swModExt = Part.Extension
    Part.ViewZoomtofit2
    boolstatus = swModExt.SaveAs(swPathName, 0, 0, swExportPDFData, Errors, Warnings) 'save as pdf

    
    
    Else: swApp.SendMsgToUser ("This macro only works with a plan")
    
End If

Fin:
    
End Sub
2 Likes
4

Hello

As for the post http://www.lynkoa.com/forum/mise-en-plan/macro-pdf-enregistrer-sous, you should be able to start from the attached macro.

If you don't want to select the destination folder but define it in the code then you can delete the lines:

Set objShell = New Shell
Set objFolder = objShell.BrowseForFolder(0, "Please select the destination folder for PDF files.", 0, 0)
If (Not objFolder Is Nothing) Then

and the corresponding End If

and set the path variable as follows:

Path = "D:\Downloads\PDF Plan"

You also need to modify the lines:

swCustProp.Get2 "Plan Number", valOut1, resolvedValOut1
swCustProp.Get2 "Ind1", valOut2, resolvedValOut2

to put the name of your variables and, of course, add another similar line since you have 3 properties to retrieve.

You also need to change the line:

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

to adapt it to the filenames you want to put.

For the date, you have to replace the / of it with another character otherwise it will create a problem in the file name, for example:

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

And so this is the dateNow that it put in the file name.

Kind regards


macro_pdf_enregistrer_sous.swp
5

Hello

Thank you @sbadenis for your answer, I had read it. 

Thank you @G. for your answer, I tried yesterday by modifying 2 or 3 tricks to change the destination folder but it didn't work

Thank you @d.roger for your answer. I'm trying it tomorrow or this weekend and I'll get back to you to tell you what happens.

Have a good day to all of you

6

So then, what did it give??? :)