Witam
Szukam makra (lub fragmentu programu VBA), które jako rysunek SolidWorks wykonałoby następujące czynności:
- Zapisywanie w formacie PDF arkuszy o nazwach zaczynających się od "Plan_"
- Zapis DWG (wersja R12) arkuszy zaczynających się na literę "P"
Plan zaczyna się na P, prawda?
Oki, wychodzę...; -)
1 polubienie
Dobra uwaga @max59 , więc raczej:
Zapis w DWG (wersja R12) arkuszy o składni "PXX"
XX to 2 cyfry
Czy właściwe jest eksportowanie każdej strony PXX do osobnego pliku na stronę?
1 polubienie
@MaD:
każda strona PXX musi być osobnym plikiem.
Na każdej z tych stron znajduje się reprezentacja korpusu do cięcia plazmowego.
Chciałbym podać jako nazwę pliku: NAZWA PLIKU MEP-NAZWA ARKUSZA
Jeśli chodzi o zapisywanie arkuszy "Plan_" w formacie PDF, najlepiej byłoby, gdyby wszystkie arkusze były zgrupowane w tym samym pliku PDF.
Dla nazwy pliku PDF: Nazwa pliku MEP-Description (właściwość niestandardowa w pliku części)
Dobra więc mam ten kod do skopiowania
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim boolstatus As Boolean
Dim Filename As String
Dim lErrors As Long
Dim lWarnings As Long
Dim strSheetName() As String
Dim varSheetName As Variant
'
Dim swDraw As SldWorks.DrawingDoc
Dim vSheetNames As Variant
'
Dim Part As Object
Dim longstatus As Long, longwarnings As Long
Dim File As String
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
' ajout controle du bon fichier
If Part Is Nothing Then
MsgBox "Aucun fichier n'est actuellement ouvert."
Exit Sub ' If no model is currently loaded, then exit
End If
' Determine the document type. If the document is a drawing, then send a message to the user.
If (Part.GetType <> 3) Then '1Part 2Assembly 3Document
MsgBox "Cette macro ne s'applique que sur une mise en plan"
Exit Sub
End If
File = Part.GetPathName
If File = "" Then
MsgBox "Cette macro necessite que le fichier soit préalablement enregistré"
Exit Sub
End If
Dim Filepath As String
Dim Filename As String
Filepath = Left(File, InStrRev(File, "\"))
Filename = Mid(File, Len(Filepath) + 1, Len(File) - (7 + Len(Filepath)))
Set swModelDocExt = Part.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
Set swDraw = Part
vSheetNames = swDraw.GetSheetNames
Dim i As Long
Dim j As Long
j = 0
ReDim strSheetName(UBound(vSheetNames))
For i = 0 To UBound(vSheetNames)
If InStr(vSheetNames(i), "Plan") <> 0 Then
strSheetName(j) = vSheetNames(i)
j = j + 1
End If
Next
varSheetName = strSheetName
If swExportPDFData Is Nothing Then MsgBox "Nothing"
boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, varSheetName)
swExportPDFData.ViewPdfAfterSaving = True
boolstatus = swModelDocExt.SaveAs(Filepath & "\" & Filename & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings)
'DWG
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfVersion, swDxfFormat_e.swDxfFormat_R12)
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfSeparateSheets)
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfVersion, 0)
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, 1)
longstatus = Part.SaveAs3(Filepath & "\" & Filename & ".DWG", 0, 0)
For i = 0 To UBound(vSheetNames)
If InStr(vSheetNames(i), "Plan") <> 0 Then
Kill Filepath & "\" & Format(i, String(2, "0")) & "_" & Filename & ".DWG"
End If
Next
End Sub
Wypróbuj go najpierw na kopii planu, nigdy nie wiesz i powiedz mi, czy pasuje
3 polubienia
Mały dodatek do zmiany nazw DWG
If InStr(vSheetNames(i), "Plan") <> 0 Then
Kill Filepath & "\" & Format(i, String(2, "0")) & "_" & Filename & ".DWG"
Else
Kill Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG"
Name Filepath & "\" & Format(i, String(2, "0")) & "_" & Filename & ".DWG" As Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG"
End If
Pozwolę Ci umieścić to z powrotem w poprzednim kodzie :)
3 polubienia
i dla nazwy pliku PDF
Dim swCustProp As CustomPropertyManager
Set swCustProp = swModelDocExt.CustomPropertyManager("")
boolstatus = swModelDocExt.SaveAs(Filepath & "\" & Filename & "-" & swCustProp.Get("LBM_REV") & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings)
gdzie LBM_REV jest nazwa Twojej nieruchomości :)
Informuj nas na bieżąco
3 polubienia
Mam błąd w wykonaniu MAKRA:
Wynik jest następujący:
Właściwość "description" nie pojawia się w nazwie pliku PDF
dla DWG (myślę, że jest to wynik błędu), chciałbym pokazać nazwy arkuszy (P01 itp.....) na końcu.
capture-2.jpg
2 polubienia
Rzeczywiście, ten sam błąd na nowym makrze, podczas gdy na 1. nie ma problemów
Widzę, co ulega awarii podczas moich testów, nie można było zmienić nazwy, jeśli plik istniał, więc go usunąłem, ale jeśli nie istnieje, nie może go usunąć, dodaję kontrolkę pliku
2 polubienia
Z korektą na danej linii
If Len(Dir(Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG")) > 0 Then Kill Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG"
Powinno być lepiej :)
macro_export_pdf__dwg.swp
2 polubienia
Czy w przypadku właściwości jest to właściwość niestandardowa, czy zintegrowana z Solidworks?
1 polubienie
jest to własność osobista ("OPIS") pokoju (uwaga, tej właściwości nie ma na rysunku)
Nie rozumiem zbyt wiele z VBA, ale zagłębiając się w makra, które otrzymałem, zastanawiam się, czy nie odpowiada to temu:
capture-4.jpg
Dobra, nie zrozumiałem jej :/ ok szukam
1 polubienie
Czy na jednym rysunku jest tylko jeden komponent, czy kilka?
1 polubienie
Tylko 1 komponent na instalację tak
Ok to spróbuj tego :)
Dziękujemy naszym amerykańskim przyjaciołom :) https://forum.solidworks.com/message/431752#comment-431752
Makro w komputerze
macro_export_pdf__dwg.swp
5 polubień