Guten Morgen,
hier der verwendete Code:
******************************************************************
Option Explicit
Dim swApp As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
'check for valid solidworks application
If swApp Is Nothing Then
MsgBox "Error Connecting to SolidWorks. Please Try Again.", vbCritical
Exit Sub
End If
'declare and set modelDoc object
Dim swDoc As ModelDoc2
Set swDoc = swApp.ActiveDoc
'check for valid document
If swDoc Is Nothing Then
MsgBox "Unable to Connect to a Valid SolidWorks Drawing.", vbCritical
Exit Sub
End If
'check for valid drawing
If swDoc.GetType <> SwConst.swDocumentTypes_e.swDocDRAWING Then
MsgBox "Unable to Connect to a Valid SolidWorks Drawing.", vbCritical
Exit Sub
End If
'Declare and set drawing object
Dim swDwgDoc As DrawingDoc
Set swDwgDoc = swDoc
'declare and set exporter object
Dim swExporter As SldWorks.ExportPdfData
Set swExporter = swApp.GetExportFileData(SwConst.swExportDataFileType_e.swExportPdfData)
'declare and set output directory to current path
Dim outputPath As String
'outputPath = getFolderFromFullPath(swDoc.GetPathName)
outputPath = "C:\SWXExport\"
'create and set array for sheet names
Dim sheetNames As Variant
sheetNames = swDwgDoc.GetSheetNames
'create and set object for current sheet
Dim CurDwgSheet As Sheet
Set CurDwgSheet = swDwgDoc.GetCurrentSheet
'create base out name
Dim outputFileName As String
' outputFileName = getTitleFromFullTitle(swDoc.GetTitle, CurDwgSheet.GetName)
'Variablen für den Zeichnungsnamen
Dim Rev As String
Dim MatNr As String
Dim MatBez As String
'errors and warnings objects
Dim lErrors As Long
Dim lWarnings As Long
Dim i As Integer
Dim bRet As Boolean
'create frame and status bar pane object
Dim statusPane As StatusBarPane
Dim swFrame As SldWorks.Frame
Set swFrame = swApp.Frame
Set statusPane = swFrame.GetStatusBarPane
statusPane.Visible = True
'loop through and export each sheet
For i = 0 To UBound(sheetNames)
Stop
' Dateinamen zusammenstellen
Rev = swDoc.CustomInfo("Revision")
'MatNr = ' diese konfigurationsspezifische Information kann aus dem referenzierten Modell gelesen werden... nur wie?
'MatBez = ' diese konfigurationsspezifische Information kann aus dem referenzierten Modell gelesen werden... nur wie?
outputFileName = MatNr + "_" + MatBez + "_" + Rev
'update status pane
statusPane.Text = "Exporting " + sheetNames(i)
'update exporter object
bRet = swExporter.SetSheets(SwConst.swExportDataSheetsToExport_e.swExportData_ExportSpecifiedSheets, sheetNames(i))
'check for errors
If bRet = False Then
MsgBox "Error Creating PDF on Sheet: " + Str(i)
Exit Sub
End If
'save out pdf
bRet = swDoc.Extension.SaveAs(outputPath + outputFileName + ".pdf", SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent, _
swExporter, lErrors, lWarnings)
'check for errors
If bRet = False Then
MsgBox "Error Creating PDF on Sheet: " + Str(i)
CatchErrors lErrors
Exit Sub
End If
Next i
End Sub
Private Function getFolderFromFullPath(thefullpath As String) As String
'returns the path without the filename
getFolderFromFullPath = Strings.Mid(thefullpath, 1, Strings.Len(thefullpath) - ((Strings.Len(thefullpath) - Strings.InStrRev(thefullpath, "\"))))
End Function
Private Function getTitleFromFullTitle(thefulltitle As String, thesheetname As String) As String
'returns filename without sheet name
getTitleFromFullTitle = Strings.Mid(thefulltitle, 1, Strings.Len(thefulltitle) - ((Strings.Len(thefulltitle) - Strings.InStrRev(thefulltitle, thesheetname) + 4)))
End Function
Private Sub CatchErrors(theError As Long)
Select Case theError
Case 0
Case SwConst.swFileSaveError_e.swGenericSaveError
MsgBox "File Saving Error", vbExclamation
Case SwConst.swFileSaveError_e.swReadOnlySaveError
MsgBox "File Saving Error: Read-Only Rights", vbExclamation
Case SwConst.swFileSaveError_e.swFileNameEmpty
MsgBox "File Saving Error: Empty Filename", vbExclamation
Case SwConst.swFileSaveError_e.swFileNameContainsAtSign
MsgBox "File Saving Error: Invalid FileName Character", vbExclamation
Case SwConst.swFileSaveError_e.swFileSaveFormatNotAvailable
MsgBox "File Saving Error: Invalid File Format", vbExclamation
Case SwConst.swFileSaveError_e.swFileSaveAsNameExceedsMaxPathLength
MsgBox "File Saving Error: Filename Exceeds Maximum Path Length of 255 Characters", vbExclamation
End Select
End Sub
*******************************************************************
Das Makro habe ich mal gefunden und ein bisschen umgemodelt. Es funktioniert soweit auch so wie ich es brauche, nur dass ich die konfigurationsspezifischen Dateieigenschaften des Models nicht auslesen kann. Wie würde der Code in diesem Fall lauten?
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
