Rejestracja w formacie PDF

Witam
Chcę nagrać moje rysunki w formacie PDF w zdefiniowanym folderze z formatowaniem zdefiniowanym przez informacje o rysunku

przykład: Noirmoutier - Bonnotte - MP - Ind C - Data

pogrubioną czcionką to co wypełniam w Solidworks i kursywą co należy dodać

W każdym rysunku, który tworzę, mam do wypełnienia następujące właściwości:

Nazwa właściwości
Indeks              C
Miasto                  Noirmoutier
Rue/Quartier    Bonnotte

i zapisuję go na razie w folderze na moim komputerze "D:\Downloads\PDF Plan\___.PDF".

Jeśli to możliwe później, powinienem zastąpić ten folder folderem przyszłego zdalnego serwera (prawdopodobnie za pomocą VPN) 

 Oto na razie bardzo proste makro, które udało mi się zrobić (cud, że działa lol)
Czy możesz mi pomóc napisać to makro?

Dla Twojej informacji muszę zapisać wszystkie arkusze mojego rysunku, więc zwykle od 4 do 8 arkuszy w tym samym pliku

Z góry dziękuję

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

Zobacz ten post poniżej!

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

3 polubienia

Aby skrócić wyszukiwanie, oto makro, które odpowiada.

Cdt

 

Makro:

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 'Kojarzy część z dokumentem w toku
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
    ' pierwszy widok jest arkuszem, przechodząc do następnego
    Set swView = swView.GetNextView
    ' pobieranie części
    Set swModel = swView.ReferencedDocument
    Set swModExt = swModel.Extension
    ' przypisując "Hint" do " Att"
    Set Prop = swModExt.CustomPropertyManager("")
    boolstatus = Prop.Get3("Hint", False, ValOut, Att)
    If Att = " " Then Att = ""'
    
    Odzyskiwanie pełnej ścieżki
    swPathName = Part.GetPathName
    If swPathName = "" Then
        swApp.SendMsgToUser ("Plik rysunku nie jest zapisany, zrób to i zacznij od nowa")Wyjdź
        z Sub
    End Jeśli
    
    Przypisywanie lokalizacji folderu
    swPath = Left(swPathName, InStrRev(swPathName, "FABRICATION", , 1))
    swPath = swPath & "C:\... "
    
    'weryfikowanie istnienia ścieżki swPath
    If oFSO.FolderExists(swPath) = False Then
        swApp.SendMsgToUser ("Błąd rejestracji: sprawdź obecność katalogu: '" & swPath + "'")
        Exit Sub
    End If
    
    ' pobieranie nazwy
    swName = Right(swPathName, Len(swPathName) - InStrRev(swPathName, "\"))swName
    = Left(swName, InStrRev(swName, ".") - 1)
    
    swPathName = swPath + swName
    
    ' Pobieranie poprzedniej wskazówki
    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, Błędy, Ostrzeżenia) 'zapisz jako dxf
    
    ' rekord pdf
    swPathName = swPath + swName
    swPathName = swPathName & Att + ".pdf" ' dodaj .pdf"
    Set swModExt = Part.Extension
    Part.ViewZoomtofit2
    boolstatus = swModExt.SaveAs(swPathName, 0, 0, swExportPDFData, Błędy, Ostrzeżenia) 'zapisz jako pdf

    
    
    W przeciwnym razie: swApp.SendMsgToUser ("To makro działa tylko z planem")
    
End If

Fin:
    
End Sub
2 polubienia

Witam

Jeśli chodzi o post http://www.lynkoa.com/forum/mise-en-plan/macro-pdf-enregistrer-sous, powinieneś być w stanie zacząć od dołączonego makra.

Jeśli nie chcesz wybierać folderu docelowego, ale zdefiniować go w kodzie, możesz usunąć wiersze:

Set objShell = Nowa powłoka
Set objFolder = objShell.BrowseForFolder(0, "Proszę wybrać folder docelowy dla plików PDF.", 0, 0)
Jeśli (nie objFolder jest niczym) to

i odpowiadający mu End If

i ustaw zmienną path w następujący sposób:

Ścieżka = "D:\Pobrane\Plan PDF"

Musisz także zmodyfikować wiersze:

swCustProp.Get2 "Numer planu", valOut1, resolvedValOut1
swCustProp.Get2 "Ind1", valOut2, resolvedValOut2

, aby umieścić nazwę swoich zmiennych i oczywiście dodać kolejną podobną linię, ponieważ masz 3 właściwości do pobrania.

Musisz także zmienić linię:

nFileName = Ścieżka & "\" & resolvedValOut1 & "-" & resolvedValOut2 & "-" & swSheet.GetName & ".PDF"

, aby dostosować go do nazw plików, które chcesz umieścić.

Dla daty musisz zastąpić / jego znakiem innym znakiem, w przeciwnym razie spowoduje to problem w nazwie pliku, na przykład:

Dim dateNow As Ciąg
dateNow = Zamień(Data, "/", "-")

A więc to jest dataTeraz, którą umieścił w nazwie pliku.

Pozdrowienia


macro_pdf_enregistrer_sous.swp

Witam

Dziękuję @sbadenis za odpowiedź, przeczytałem ją. 

Dziękuję @G. za odpowiedź, próbowałem wczoraj, modyfikując 2 lub 3 sztuczki, aby zmienić folder docelowy, ale to nie zadziałało

Dziękuję @d.roger za odpowiedź. Spróbuję tego jutro lub w ten weekend i odezwę się do Ciebie, aby opowiedzieć, co się stanie.

Miłego dnia dla was wszystkich

Cóż więc to dało??? :)