TIA, Richard
"Richard Charney" <rcha...@elakeside.com> wrote in message
news:588753f8.04042...@posting.google.com...
Thanks, Richard
"Corey Scheich" <csch...@garlockequip.com> wrote in message news:<c6m65d$dedro$1...@ID-200385.news.uni-berlin.de>...
Our company has developed a SolidWorks DLL add-in which can be configured
(via XML text file) to listen for specific SolidWorks events and trigger the
execution of a user specified macro & procedure. The events that are
supported are:
SldWorks FileNewNotify2
SldWorks FileOpenNotify2
PartDoc DestroyNotify
PartDoc FileSaveAsNotify2
PartDoc FileSaveNotify
PartDoc FileSavePostNotify
AssemblyDoc DestroyNotify
AssemblyDoc FileSaveAsNotify2
AssemblyDoc FileSaveNotify
AssemblyDoc FileSavePostNotify
DrawingDoc DestroyNotify
DrawingDoc FileSaveAsNotify2
DrawingDoc FileSaveNotify
DrawingDoc FileSavePostNotify
We also have written a SolidWorks VBA macro which enhances to the output
options provided with the SolidWorks 2004 SaveAs PDF capabilities. This
macro adds the ability to create a PDF containing all sheets, only the
active drawing sheet, or creating an individual PDF file for each sheet. If
required, this macro could be modified to save the PDF files to a single
folder. Currently it saves the files to the same folder as the drawing
file.
Please contact me to discuss further if you are interested.
Best regards,
John Picinich
www.cadimensions.com
"Richard Charney" <rcha...@elakeside.com> wrote in message
news:588753f8.0404...@posting.google.com...
Richard
"John Picinich" <johnN...@cadimensions.com> wrote in message news:<V1skc.133938$e17....@twister.nyroc.rr.com>...
Corey
"Richard Charney" <rcha...@elakeside.com> wrote in message
news:588753f8.0404...@posting.google.com...
I havent had the pleasure of playing with Task Manager - it didnt install when
'upgrading' 04 install in work.
> I would like to see and example file myself, if anyone has one.) then
> you setup a custom task in Scheduler and specify your macro and fill
> in the parameters.
Well, I was wondering why noone posted some snippet, hell, its only one
line of code to export the PDF, right? Well, seems you'll need a few
hundred more lines to get any feedback or error handling :/
The following code module does SOME of this. If all is well, then it wont have
any problems, but there isnt enuff error handling to handle all problems, and
basically nothing for reporting, to show WHICH files it had the problem with.
For Instance, the file search routine will find ALL .slddrw files:
hidden files, files in your SW temp dir, etc, etc.
Also, it does not use the task manager. If something is amiss, it may
be stuck on waiting for the user to select from some error dialog. If all
goes well, you could still fill up your Hard Disk. USE WITH CAUTION.
But what it DOES is present the user with the windows "Browse For Folder"
dialog, and lets the user select a base folder to search from. The routine
then searches the folder, and ALL CHILD folders, for SW drawings.
It returns a dialog with the # of files found, and, if any are found, if
the users wishes to export all of them as PDF files.
The code is a stand alone module, and all variables are private to the
module, so this should Paste into other projects (as well as post more
easily on the NG's) Also, the file search extension, and output
extension are coded in as constants, with a little tweaking the routine
could be used for other SW files.
If any of you whizzes out there upgrades this code, plz repost :)
'----- snip --------- snip --------- snip --------- snip ----
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const MAX_PATH = 260
Private Const DWG_SEARCHSPEC As String = ".SLDDRW"
Private Const DOC_EXPORT_EXTENSION As String = ".PDF"
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function FindFirstFile Lib "kernel32" Alias _
"FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As _
WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias _
"FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As _
WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As _
Long) As Long
Dim FoundPath() As String
Dim FoundFiles() As String
Dim FileCount As Long
Dim swApp As SldWorks.SldWorks
Dim Part As ModelDoc2
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) _
As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Function BrowseForFolder(WindowTitle As String) As String
' call the Browse for folders dialog
Dim bi As BROWSEINFO
Dim pidl As Long
Dim path As String
Dim pos As Integer
bi.hOwner = GetDesktopWindow ' get hwnd of desktop
bi.pidlRoot = 0 'Pointer to the item identifier list
bi.lpszTitle = WindowTitle 'message displayed in Browse dialog
bi.ulFlags = BIF_RETURNONLYFSDIRS 'the type of folder to return.
pidl = SHBrowseForFolder(bi) 'show the browse for folders dialog
path = Space$(MAX_PATH) 'parse the user's returned folder
'selection contained in pidl
If SHGetPathFromIDList(ByVal pidl, ByVal path) Then
pos = InStr(path, Chr$(0))
BrowseForFolder = Left(path, pos - 1)
End If
Call CoTaskMemFree(pidl)
End Function
Public Sub FindFiles(strRootFolder As String, strFolder As String, _
strFile As String)
Dim lngSearchHandle As Long
Dim udtFindData As WIN32_FIND_DATA
Dim strTemp As String, lngRet As Long
Dim UCaseExt As String
UCaseExt = UCase$(Right$(strFile, Len(strFile) - 1))
'Check that folder name ends with "\"
If Right$(strRootFolder, 1) <> "\" Then
strRootFolder = strRootFolder & "\"
End If
'Find first file/folder in current folder
lngSearchHandle = FindFirstFile(strRootFolder & "*", udtFindData)
'Check that we received a valid handle
If lngSearchHandle = INVALID_HANDLE_VALUE Then Exit Sub
lngRet = 1
Do While lngRet <> 0
'Trim nulls from filename
strTemp = TrimNulls(udtFindData.cFileName)
If (udtFindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) _
= FILE_ATTRIBUTE_DIRECTORY Then
'It's a dir - make sure it isn't . or .. dirs
If strTemp <> "." And strTemp <> ".." Then
'It's a normal dir: let's dive straight into it...
Call FindFiles(strRootFolder & strTemp, strFolder, _
strFile) ', colFilesFound)
End If
Else
'It's a file. First check if the current folder matches
' the folder path in strFolder
If (strRootFolder Like strFolder) Then
'Folder matches, what about file?
ext$ = Right(strTemp, Len(UCaseExt))
If UCase(ext$) = UCaseExt Then
FileCount = FileCount + 1
ReDim Preserve FoundPath(0 To FileCount)
ReDim Preserve FoundFiles(0 To FileCount)
FoundPath(FileCount) = strRootFolder
FoundFiles(FileCount) = strTemp
' list in debug window
Debug.Print strRootFolder & strTemp
End If
End If
End If
'Get next file/folder
lngRet = FindNextFile(lngSearchHandle, udtFindData)
Loop
'Close find handle
Call FindClose(lngSearchHandle)
End Sub
Public Function TrimNulls(strString As String) As String
Dim l As Long
l = InStr(1, strString, Chr(0))
If l = 1 Then
TrimNulls = ""
ElseIf l > 0 Then
TrimNulls = Left$(strString, l - 1)
Else
TrimNulls = strString
End If
End Function
Sub main()
Dim retpath As String
Dim DialogText As String
Const swDocDRAWING As Long = 3
Const swOpenDocOptions_Silent As Long = 1
Const swOpenDocOptions_ReadOnly As Long = 2
Const swSaveAsOptions_Silent As Long = 1
Const swSaveAsOptions_AvoidRebuildOnSave As Long = 8
Dim ErrCode As Long
Dim PathSpec As String
Dim Errors As Long, Warnings As Long
Dim OpenOptions As Long, ExportOptions As Long
Dim OpenDwgObj As ModelDoc2
Dim ExportFileSpec As String
Set swApp = Application.SldWorks ' attach to existing SW
If swApp Is Nothing Then
MsgBox "Solidworks must be running to use this macro", 65, _
"PDF Export"
Exit Sub
End If
DialogText = "Select Base Folder for .SldDrw search." & vbCrLf
DialogText = DialogText & "Program will recurse all child folders"
retpath = BrowseForFolder(DialogText)
If retpath > "" Then
FileCount = -1: Erase FoundFiles ' clear previous search
' and find a new batch
Call FindFiles(retpath, "*", "*" & DWG_SEARCHSPEC)
If FileCount = -1 Then
MsgBox "No Files matching the extension " & vbCrLf & _
DWG_SEARCHSPEC & " found to export"
Else
DialogText = FileCount + 1 & _
" Files matching the extension " & vbCrLf
DialogText = DialogText & DWG_SEARCHSPEC & _
" found to export." & vbCrLf & vbCrLf
DialogText = DialogText & _
"Would you like to export these PDFs now ?"
retcode% = MsgBox(DialogText, 36, "Export PDFs")
If retcode = 6 Then ' user wants to export PDFs
' Boolean OR the Doc options
OpenOptions = swOpenDocOptions_Silent Or _
swOpenDocOptions_ReadOnly
ExportOptions = swSaveAsOptions_Silent Or _
swSaveAsOptions_AvoidRebuildOnSave
' loop thru and open SW Drawings
For Doc& = 0 To FileCount
' generate path
PathSpec = FoundPath(Doc&) & FoundFiles(Doc&)
' open the doc
Set OpenDwgObj = swApp.OpenDoc6(PathSpec, _
swDocDRAWING, Options, "", Errors, Warnings)
If Not (OpenDwgObj Is Nothing) Then
' generate new Name for export
ExportFileSpec = Left$(PathSpec, Len(PathSpec) - _
Len(DWG_SEARCHSPEC))
ExportFileSpec = ExportFileSpec & _
DOC_EXPORT_EXTENSION
Debug.Print ExportFileSpec
OpenDwgObj.SaveAs4 ExportFileSpec, 0, _
ExportOptions, Errors, Warnings
DocTitle$ = OpenDwgObj.GetTitle
swApp.CloseDoc DocTitle$
Set OpenDwgObj = Nothing
End If
Next Doc& '
End If
End If
End If
End Sub
'----- snip --------- snip --------- snip --------- snip ----