PDF-registratie

Out of category
1

Hallo
Ik wil graag een PDF-opname maken van mijn tekeningen in een gedefinieerde map met een opmaak die is gedefinieerd door de tekeninginformatie

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

vetgedrukt wat ik invul bij Solidworks en cursief wat er bij moet komen

In elke tekening die ik maak, moet ik de volgende eigenschappen invullen:

Naam van de woning
C-index              
Stad                  van Noirmoutier
Wijnruit/Quartier    Bonnotte

en ik sla het voorlopig op in een map op mijn pc "D:\Downloads\PDF Plan\___.PDF".

Indien mogelijk later, moet ik deze map vervangen door een map van de toekomstige externe server (waarschijnlijk met behulp van een VPN) 

Hier is voor nu een heel eenvoudige macro die ik heb weten te maken (een wonder dat het werkt lol)
Kun je me helpen met het schrijven van deze macro?

Ter informatie, ik moet alle vellen van mijn tekening opslaan, dus meestal tussen de 4 en 8 vellen in hetzelfde bestand

Bij voorbaat dank

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

Zie dit bericht hieronder!

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

3 likes
3

Om uw zoekopdracht te verkorten, kan hier de macro zijn die overeenkomt.

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 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
    ' de eerste weergave is het blad, en gaat verder naar de volgende
    Set swView = swView.GetNextView
    ' het onderdeel
    ophalen Set swModel = swView.ReferencedDocument
    Set swModExt = swModel.Extension
    ' wijst "Hint" toe aan " att"
    Set Prop = swModExt.CustomPropertyManager("")
    boolstatus = Prop.Get3("Hint", false, ValOut, att)
    If att = " " Then att = ""'
    
    Volledig padherstel
    swPathName = Part.GetPathName
    Als swPathName = "" Dan
        swApp.SendMsgToUser ("Het tekeningbestand is niet opgeslagen, doe het alstublieft en begin opnieuw")Sluit
        Sub
    End af Als
    
    De maplocatie
    toewijzen swPath = Left(swPathName, InStrRev(swPathName, "FABRICATION", , 1))
    swPath = swPath & "C:\... "
    
    'het verifiëren van het bestaan van het pad swPath
    If oFSO.FolderExists(swPath) = False Then
        swApp.SendMsgToUser ("Registratiefout: controleer op de aanwezigheid van de directory: '" & swPath + "'")
        Exit Sub
    End If
    
    ' het ophalen van de naam
    swName = Right(swPathName, Len(swPathName) - InStrRev(swPathName, "\"))swName
    = Left(swName, InStrRev(swName, ".") - 1)
    
    swPathName = swPath + swName
    
    ' haalt vorige hint
    op Als Att = "A" Dan
        OldAtt = """
    ElseIf Att = "" Dan
        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, Fouten, Waarschuwingen) 'opslaan als 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, Fouten, Waarschuwingen) 'opslaan als pdf

    
    
    Else: swApp.SendMsgToUser ("Deze macro werkt alleen met een plan")
    
End If

Fin:
    
End Sub
2 likes
4

Hallo

Wat betreft de post http://www.lynkoa.com/forum/mise-en-plan/macro-pdf-enregistrer-sous, zou je moeten kunnen beginnen met de bijgevoegde macro.

Als u de doelmap niet wilt selecteren, maar deze in de code wilt definiëren, kunt u de regels verwijderen:

Set objShell = Nieuwe Shell
Stel objFolder = objShell.BrowseForFolder(0, "Selecteer de doelmap voor PDF-bestanden.", 0, 0)
Als (niet objFolder is niets) dan

en de bijbehorende End If

en stel de padvariabele als volgt in:

Pad = "D:\Downloads\PDF-plan"

U moet ook de regels wijzigen:

swCustProp.Get2 "Plannummer", valOut1, opgelostValOut1
swCustProp.Get2 "Ind1", valOut2, opgelostValOut2

om de naam van je variabelen te zetten en natuurlijk nog een soortgelijke regel toe te voegen, aangezien je 3 eigenschappen moet ophalen.

U moet ook de regel wijzigen:

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

om het aan te passen aan de bestandsnamen die u wilt plaatsen.

Voor de datum moet je de / ervan vervangen door een ander teken, anders ontstaat er een probleem in de bestandsnaam, bijvoorbeeld:

Dim dateNow als string
dateNow = Vervangen(Datum, "/", "-")

En dus is dit de datumNu dat het in de bestandsnaam heeft gezet.

Vriendelijke groeten


macro_pdf_enregistrer_sous.swp
5

Hallo

Dank u @sbadenis voor uw antwoord, ik had het gelezen. 

Bedankt @G. voor je antwoord, ik heb gisteren geprobeerd door 2 of 3 trucs aan te passen om de bestemmingsmap te wijzigen, maar het werkte niet

Bedankt @d.roger voor je antwoord. Ik probeer het morgen of dit weekend en ik neem contact met je op om je te vertellen wat er gebeurt.

Fijne dag voor jullie allemaal

6

Dus wat gaf het dan??? :)