Makro rysunku Solidworks PDF

[valentin.fer]

Witam Pani, Szanowny Panie,

Wziąłem to makro w sieci, aby zapisać moje rysunki bezpośrednio w formacie pdf.
Niestety, będąc początkującym w tej dziedzinie, nie wiem, jak dodać ścieżkę do folderu z moimi rysunkami.

Czy ktoś może mi powiedzieć, jak postępować?

Oto makro, które znalazłem, jeśli to pomaga, działa, ale zapisuje pliki PDF w tym samym folderze, co moje rysunki oprogramowania.

Z góry dzięki!

Pozdrowienia

---

Dim swApp As Object
Sub main()
Dim swApp jako SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As Ciąg
Stan przyciemnienia Jako wartość logiczna
Domyślne błędy Tak długo, ostrzeżenia Tak długo
Ustaw swApp = Application.SldWorks
Ustaw swModel = swApp.ActiveDoc
"Zapisz
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, błędy, ostrzeżenia)
'Eksportuj do pliku PDF, jeśli jest to rysunek
Jeśli (swModel.GetType = swDocDRAWING) Następnie
strFilename = swModel.GetPathName
strFilename = Left(strFilename, Len(strFilename) - 6) & "pdf"
Ustaw swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
Zakończ jeżeli:
Koniec subwoofera

[sbadenis]

Zainspirowany odpowiedzią @Cyril_f :

Makro DWG i PDF na

Witam, musimy zmienić w następujący sposób: Dim swApp As Object Przyciemnij część jako obiekt Dim boolstatus As Boolean Dim longstatus As Long, longwarnings As Long Przyciemnij FeatureData jako obiekt Przyciemnij element jako obiekt Przyciemnij komponent jako obiekt Sub main() Ustaw swApp = Application.SldWorks Ustaw część = swApp.ActiveDoc Path = Part.GetPathName ' ścieżka do pliku Path = Mid(Path, InStrRev(Path, "\") + 1) 'Wyczyść ścieżkę path = about("profil użytkownika") & "\Desktop\" & ścieżka Part.SaveAs2 Left(Path, (Len(Path) - 6)) & "PDF", ...

Ten (nieprzetestowany) kod powinien działać

Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename =  Mid(strFilename, InStrRev(strFilename, "\") + 1) 'Purge le chemin d'accès
strFilename = Environ("userprofile") & "\Desktop\" & strFilename 'Ajoute le bureau comme chemin en remplaçement (A modifier si besoin Ex: strFilename ="C:\Temp\strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & « pdf »
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub

[Cyril_f]

Dobry wieczór

Oprócz odpowiedzi @sbadenis, czy ścieżka nagrywania jest stała, czy nie?
Oferowany kod zapisuje się na pulpicie.

[valentin.fer]

Witaj Cyrylu,

Ścieżka będzie znajdować się w folderze dedykowanym planowi w formacie PDF, który różni się od tego w formacie SW.
Ale z czasem lokalizacja się zmieni, bo pracuję w folderach po 1000 planów i idzie to bardzo szybko. (folder na serwerze dedykowanym)

Nie jestem też pewien, czy zrozumiałem, co powinienem zrobić w makrze @sbadenis i gdzie dodać swoją ścieżkę

Bardzo dziękuję za odpowiedzi.

Pozdrowienia

[sbadenis]

Ścieżka została już dodana na stałe (do pulpitu)
Jak chcesz używać makra?
Przypadek nr 1 plik po pliku, makro prosi Cię lub chcesz zapisać plik do każdego pliku (co może być szybko bólem głowy, jeśli 100 plików do zapisania)
Przypadek nr 2 w podkatalogu twojego pliku (zawsze identyczny)
Przypadek nr 3 (ten, który wybrałem) na pulpicie (w razie potrzeby dodaj Mapy/ za pulpitem, aby mieć folder na pulpicie).

[valentin.fer]

Dobra, dzięki za wyjaśnienie.

Mam folder z rysunkami PDF, a w środku mam kilka folderów ułożonych w przyrosty po 1000 planów pdf.

Przykład:

• 1-1000
• 1001-2000
• 2001-3000

Myślę, że umieszczę przycisk makra na pasku narzędzi i zapisze się on w wybranej przeze mnie lokalizacji, a następnie go zmienię.

Muszę tylko zamienić ścieżkę do biura na tę, którą chcę, jeśli dobrze rozumiem, spróbuję.
Moja obecna ścieżka wygląda tak:
O:\Baza danych SolidWorks\03-Biblioteka PDF\18001-19000

Bardzo dziękuję Denis za odpowiedź.

Pozdrowienia

[sbadenis]

W takim przypadku należy zmienić ten wiersz:

strFilename = Environ("userprofile") & "\Desktop\" & strFilename 'Ajoute le bureau comme chemin en remplaçement (A modifier si besoin Ex: strFilename ="C:\Temp\strFilename

Przez '''
strFilename = "O:\SolidWorks Base\03-PDF Library\18001-19000" & strFilename

Et le jour ou tu aura dépassé tes 1000 tu changes de nouveau cette ligne dans la macro

[valentin.fer]

Niestety to nie działa

[sbadenis]

Rzeczywiście, błąd, że po 19000 roku brakowało \, oto kod zmodyfikowany, kompletny i przetestowany:

Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1)  'Purge le chemin d'accès
strFilename = "O:\Base SolidWorks\03-Bibliothèque PDF\18001-19000\" & strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & "pdf"
Debug.Print strFilename
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub

Przed uruchomieniem makra musi również istnieć folder 18001-19000

[valentin.fer]

Och tak! Dobra robota

Jest idealny, działa!

Dziękuję bardzo!

[valentin.fer]

Z ciekawości, czy byłoby skomplikowane automatyczne znalezienie odpowiedniego pliku do makra, gdy minąłem kamień milowy numerów planu?

[sbadenis]

Jeśli znajdziesz swój numer w nazwie pokoju, jest to dość łatwe.
dodając tuż poniżej tej linii:

strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1)  'Purge le chemin d'accès

Otrzymujesz 2 pierwsze cyfry i odpowiednio zmieniamy nazwę folderu.
Dodałby kilka linijek kodu, ale nic wyszukanego.
Z drugiej strony musisz również utworzyć plik, jeśli nie istnieje.

[valentin.fer]

Okej, myślę, że rozumiem zasadę.

Obecnie, jak wspomniałem wcześniej, pracuję z folderami o nazwach dokładnie takich: (Tworzę je z wyprzedzeniem)

17001-18000
18001-19000
19001-20000

Będę musiał zmienić nazwę moich folderów, aby makro działało?

[sbadenis]

Nie, dla mnie jest to możliwe za pomocą makra, ale dodałoby to kilka linijek kodu i musisz mieć pewność, że nazwa pliku MEP jest również zawarta w wartościach wskazanych przez folder (przykład 18001.slddrw-> folder 18001-19000)
Czy możesz podać dokładną nazwę rysunku jako przykład?
Ponieważ pomysł polegałby na pobraniu za pomocą makra 1. cyfry i podążaniu za tymi cyframi, aby zapisać w istniejącym katalogu lub utworzyć folder, jeśli przejdziemy do następnego tysiąca.

[sbadenis]

Oto zmodyfikowany kod do automatycznego tworzenia nazwy folderu, jeśli MEps są rzeczywiście w tej formie:
18001.slddrw, 19000.slddrw lub 20000.slddrw...

Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim FolderName As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1)  'Purge le chemin d'accès
FolderName = Left(strFilename, Len(strFilename) - 7)
Debug.Print Right(FolderName, Len(FolderName) - 2)
If Right(FolderName, Len(FolderName) - 2) = "000" Then

'Si la MEP se termine par 000 on créer le dossier avec avec comme début de N° FolderName-1
FolderName = (Left(FolderName, Len(FolderName) - 3) - 1) & "001-" & (Left(FolderName, Len(FolderName) - 3)) & "000"
Else

'Si la MEP ne se termine pas par 000 on créer le dossier avec comme début de N° FolderName
FolderName = Left(FolderName, Len(FolderName) - 3) & "001-" & (Left(FolderName, Len(FolderName) - 3) + 1) & "000"
End If
FolderName = "O:\Base SolidWorks\03-Bibliothèque PDF\" & FolderName & "\"

'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
If Dir(FolderName, vbDirectory + vbHidden) = "" Then
    MkDir FolderName
    End If



strFilename = FolderName & strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & "pdf"
Debug.Print strFilename
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub

[valentin.fer]

Tak, moje pliki rysunków są tak trafnie nazwane.

Udało mi się zrobić test i działa idealnie.

Jeszcze raz dziękuję za pomoc, to naprawdę miłe