Hoe op te slaan in PDF met een macro

3D Design Volume Model
1

Hoi allemaal

hier is mijn probleem, ik wil de tekeningen die ik wijzig in PDF opslaan.

Omdat ik er meerdere achter elkaar moet doen, moet ik elke keer sparen onder de weg opnieuw geven...... Kortom, veel clicks.

Ik heb geprobeerd een macro te maken, deze wordt opgeslagen in PDF, maar nog steeds in de aanmaakmap, en niet in dezelfde map als de tekening.

De macro in kwestie:

' ******************************************************************************
' C:\Gebruikers\FCH. CORADINCORP.001\AppData\Local\Temp\swx3264\Macro1.swb - macro opgenomen op 30/03/16 door fch
' ******************************************************************************
Dim swApp als object

Deel dimmen als object
Dim boolstatus als Booleaanse
Dim longstatus As Long, longwarnings As Long

Sub hoofd()

Stel swApp in = _
Toepassing.SldWorks

Deel instellen = swApp.ActiveDoc
longstatus = Part.SaveAs3("E:\teste macro.PDF", 0, 0)
Einde Sub

 

Bedankt voor je hulp

Franciscus


enr-pdf-1.swp
2

Waarom geen batchconverter gebruiken?....

 

1 like
3

Hallo

Hier is een macro die zou moeten werken:

 


Dim swApp als object

Deel dimmen als object
Dim boolstatus als Booleaanse
Dim docPath
Dim longstatus As Long, longwarnings As Long

Sub hoofd()

Stel swApp in = _
Toepassing.SldWorks

 

Deel instellen = swApp.ActiveDoc
docPath = Deel.GetPathName
longstatus = Part.SaveAs3(Replace(LCase(docPath), ".slddrw", ".pdf"), 0, 0)
Einde Sub

5 likes
4

Hallo, gebruik het hulpprogramma Mycadtools

2 likes
5

Hallo

Hier is de MOCRO die we thuis gebruiken, deze macro slaat de PDF automatisch op in de map waar de tekening zich bevindt.


macro_pdf.swp
1 like
6

Dank u allen voor uw hulp

SergeR:   Ik weet het niet, maar ik kom er wel achter.

amseli:   Mycad tool Ik heb het niet in mijn contract op dit moment. Ik hoop op spoed.

Manu 67:  bedankt manu, maar je macro is leeg

 

 .PL: bedankt voor de macro, ik heb net de .sldprt vervangen door slddrw en nu werkt het heel goed, nogmaals bedankt

de originele regel: longstatus = Part.SaveAs3(Replace(LCase(docPath), ".sldprt", ".pdf"), 0, 0)

vervangen door: longstatus = Part.SaveAs3(Replace(LCase(docPath), ".slddrw", ".pdf"), 0, 0)

Nogmaals bedankt aan iedereen voor jullie hulp

Franciscus

1 like
7

Dim swApp als SldWorks.SldWorks
Dim swModel als ModelDoc2
Dim lErrors zo lang
Dim lWaarschuwingen zo lang mogelijk

Sub hoofd()

Stel swApp = Toepassing.SldWorks in
Stel swModel = swApp.ActiveDoc in
swModel.Extension.SaveAs GetFilename(swModel.GetPathName) & " rev." & swModel.GetCustomInfoValue("", "Revisie") & ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings

Einde Sub


Functie GetFilename(strPath As String) Als String
    Dim strTemp als snaar
    strTemp = Mid$(strPath, InStrRev(strPath, "\") + 1)
    GetFilename = Left$(strTemp, InStrRev(strTemp, ".") - 1)
Functie beëindigen

 


macro_pdf.docx
1 like
8

Dank je wel manu67 Ik zal je macro zo snel mogelijk proberen

9

Hallo

Hier is degene die werkt en ik heb het net getest:

Dim swApp als SldWorks.SldWorks
Dim swModel als ModelDoc2
Dim lErrors zo lang
Dim lWaarschuwingen zo lang mogelijk

Sub hoofd()

Stel swApp = Toepassing.SldWorks in
Stel swModel = swApp.ActiveDoc in
swModel.Extension.SaveAs GetFilename(swModel.GetPathName) & " rev." & swModel.GetCustomInfoValue("", "Revisie") & ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings

Einde Sub

Functie GetFilename(strPath As String) Als String
Dim strTemp als snaar
strTemp = Mid$(strPath, InStrRev(strPath, "\") + 1)
GetFilename = Left$(strTemp, InStrRev(strTemp, ".") - 1)
Functie beëindigen

3 likes
10

Macro's werken goed, maar ik heb een klein verzoek om toe te voegen of het mogelijk is dat de macro werkt voor alle plannen die open zijn in Solidworks.