Option Explicit
' declarations, used windows API calls and constants
' Deklarationen, benötigte Windows API-Calls und Konstanten
' Windows API to get the free discspace
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" ( _
ByVal lpRootPathName As String, _
lpFreeBytesAvailableToCaller As Currency, _
lpTotalNumberOfBytes As Currency, _
lpTotalNumberOfFreeBytes As Currency) As Long
' Windows API for the SaveAs Filebox
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
' structure needed by Windows API
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
' for more information on Open- or SaveAs dialogs look at
' [URL unfurl="true"]http://www.mvps.org/vbnet/index.html?code/comdlg/filedlgsoverview.htm[/URL]
' SolidWorks related declarations
Dim swApp As Object ' SolidWorks session
Dim PauseTime As Double
Dim Start As Double
Dim Finish As Double
Dim ModelDoc2 As Object ' active document
Dim filenameIn As String ' desired filename for saved bitmap
Private Sub CommandButton1_Click()
' common dialog for browse for desired filename
' Auswahl des Dateinamens für Bitmap
Dim OFName As OPENFILENAME
Dim tmp As String
'Set the structure size
OFName.lStructSize = Len(OFName)
'Set the filet
OFName.lpstrFilter = "SolidWorks Part (*.sldprt)" + Chr$(0) + "*.sldprt" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
'Create a buffer
OFName.lpstrFile = Space$(254)
'Set the maximum number of chars
OFName.nMaxFile = 255
'Create a buffer
OFName.lpstrFileTitle = Space$(254)
'Set the maximum number of chars
OFName.nMaxFileTitle = 255
'Set the initial directory (Doesn't Quite Work)
'OFName.lpstrInitialDir =
'Set the dialog title
OFName.lpstrTitle = UserForm1.Caption
'no extra flags
OFName.flags = 0
'default extension
OFName.lpstrDefExt = "sldprt" + Chr$(0)
'Show the 'Save File'-dialog
If GetSaveFileName(OFName) Then
FileName.Text = Trim$(OFName.lpstrFile)
Else
FileName.Text = ""
End If
End Sub
Private Function FileExists(strDest As String) As Boolean
' checks if file strDest exists
Dim intLen As Integer
If strDest <> vbNullString Then
On Error Resume Next
intLen = Len(Dir$(strDest))
On Error GoTo 0
FileExists = (Not Err And intLen > 0)
Else
FileExists = False
End If
End Function
Private Function GetPathPart(strPath As String) As String
'
Dim intCounter As Integer
' Parse the string backwards
For intCounter = Len(strPath) To 1 Step -1
' Short-circuit when we reach the slash
If Mid$(strPath, intCounter, 1) = "\" Then
Exit For
End If
Next intCounter
' Return the value
GetPathPart = Left$(strPath, intCounter)
End Function