SolidWorks >> Makra >> Makro zapisz do pdf 3d
Odpowiedz
Autor Wypowiedź
Projektant
2016-05-06, 12:48
Pomógł 0 raz(y).
 Mam proste makro które zapisuje otwarty plik w formacie pdf ale chcę aby pdf został zapisany w formacie 3d. Myślę że do makra powinienem dopisać jakiś atrybut ale nie mogę dojsć jaki. Proszę o pomoc.

Druga sprawa to jak zmodyfikować takie makro aby ścieżką zapisu do generowanych plików był zawsze stały katalog np:
C:#eksport




Sub main()



Set swApp = _

Application.SldWorks



Set Part = swApp.ActiveDoc

'stop if no document active

If Part Is Nothing Then Exit Sub



Dim Path As String

Path = Part.GetPathName

'dont run on drawings

If Part.GetType = swDocDRAWING Then

Exit Sub

End If



'change the extension

Dim Extension As String

Extension = Mid(Path, InStrRev(Path, "."))

Path = Replace(Path, Extension, ".PDF")

Extension = ".PDF"



'save the file

longstatus = Part.SaveAs3(Path, 0, 0)



MsgBox "Saved " & Path, vbInformation

End Sub
 
.
2016-05-09, 11:31
Pomógł 52 raz(y).
 ...
 
.
2016-05-09, 11:31
Pomógł 52 raz(y).
 To by było mniej więcej tak:

Dim swApp As Object
Sub main()

Set swApp = Application.SldWorks

Dim exportData As SldWorks.ExportPdfData
Set exportData = swApp.GetExportFileData(swExportPdfData)
exportData.ExportAs3D = True

Dim Folder, NazwaPliku, Path As String

Folder = "C:Eksport"
If Dir(Folder + "*.*") = "" Then MkDir (Folder)

Dim swModel As ModelDoc2
Set swModel = swApp.ActiveDoc

NazwaPliku = swModel.GetTitle
NazwaPliku = Left(NazwaPliku, InStrRev(NazwaPliku, ".") - 1)

Path = Folder + NazwaPliku + ".PDF"
If Dir(Path) "" Then
If MsgBox("Plik :" + Chr(10) + Path + " już istnieje." + Chr(10) + "Zastąpić . . . ?", vbYesNo + vbExclamation, "Eksport do PDF 3D") = vbNo Then Exit Sub
End If

Dim lErrors As Long
Dim lWarnings As Long

swModel.Extension.SaveAs Path, swSaveAsCurrentVersion, swSaveAsOptions_Silent, exportData, lErrors, lWarnings
MsgBox "Zapisano " & Path, vbInformation, "Eksport do PDF 3D"

End Sub

Trzeba tylko dopisać 'backslashe' przed i po 'Eksport' i znaki mniekszości i większości w linii 10 od dołu bo forum ich nie toleruje.
 
Projektant
2016-05-11, 08:10
Pomógł 0 raz(y).
 Zgodnie z prośbą makro zapisuje eksporty do konkretnego katalogu szczytem rozkoszy było by gdyby wyskakiwało okienko z dwoma check box-ami C:Eksport i tak samo jak plik źródłowy.
Panie Włodzimierzu czy jest możliwośc wykonania takiej modyfikacji Pańskiego Makra. ?

edit.
Czy sprawa znaków dotyczy linii?
Path = Folder + NazwaPliku + ".PDF"

Podczas uruchomienia VB zgłasza bład w innej linii "bład składni" może chodzi o to miejsce?
 
.
2016-05-11, 09:39
Pomógł 52 raz(y).
 Błąd wynika z braku znaków , których nie toleruje form.
Poniżej makro przerobione, ale nie z checboxami bo to wymaga wprowadzenia okna dialogowego i to się komplikuje. Zamiast tego zastosowałem okienko Msgbox z pytaniem o zastosowanie folderu modelu.
Ze względu na ograniczenia forum zastosowałem inne znaki, które musisz sobie sam zamienić przed uruchomieniem makra:
zamiast Backslash #
zamiast znak mniejszości !
zamiast znaku większości @

Kod makra:
Dim swApp As Object
Sub main()

Set swApp = Application.SldWorks

Dim exportData As SldWorks.ExportPdfData
Set exportData = swApp.GetExportFileData(swExportPdfData)
exportData.ExportAs3D = True

Dim Folder, CurFolder, NazwaPliku, Path As String

Folder = "C:#Eksport#"
If Dir(Folder + "*.*") = "" Then MkDir (Folder)

Dim swModel As ModelDoc2
Set swModel = swApp.ActiveDoc

NazwaPliku = swModel.GetTitle
CurFolder = swModel.GetPathName
CurFolder = Left(CurFolder, InStrRev(CurFolder, NazwaPliku) - 1)
NazwaPliku = Left(NazwaPliku, InStrRev(NazwaPliku, ".") - 1)
If MsgBox("Czy zapisać w bieżącym folderze :" + Chr(10) + CurFolder, vbYesNo + vbQuestion, "Eksport do PDF 3D") = vbYes Then Folder = CurFolder

Path = Folder + NazwaPliku + ".PDF"
If Dir(Path) !@ "" Then
If MsgBox("Plik :" + Chr(10) + Path + " już istnieje." + Chr(10) + "Zastąpić . . . ?", vbYesNo + vbExclamation, "Eksport do PDF 3D") = vbNo Then Exit Sub
End If

Dim lErrors As Long
Dim lWarnings As Long

swModel.Extension.SaveAs Path, swSaveAsCurrentVersion, swSaveAsOptions_Silent, exportData, lErrors, lWarnings
MsgBox "Zapisano :" & Chr(10) & Path, vbInformation, "Eksport do PDF 3D"

End Sub
 
Projektant
2016-05-11, 11:31
Pomógł 0 raz(y).
 Wspaniale działa. Zaproponowany przez Pana sposób jest nawet lepszy. Serdecznie dziękuję.

Załączam makro na formu na pewno przyda się nie jednemu użytkownikowi.

http://www.pswug.info/image/forum/forum_760_20_2289_8397.swp
 
Projektant
2016-07-05, 08:52
Pomógł 0 raz(y).
 Czy można to makro zmodyfikować w taki sposób aby po eksporcie otwierało katalog w którym zostały zapisane pliki? Byłaby to chyba już wisienka na torcie.
 
Odpowiedz

PSWUG

Strefa Resellera

Publikuj

Społeczność

Ankieta

Linki

RSS
BOT