Prev: Free IGES Viewer?????
Next: Installation Problem
From: fcsuper on 2 May 2006 19:54
Hope you don't mind my input...This is assembled from various sources
and input on eng-tips. I've left in three methods to set where to
save the PDF. Just comment out the methods not in use. It set it up
to limit PDFs only of drawings, but it can be changed to produce them
for models and assemblies too. This code includes error handling.


Dim SwApp As SldWorks.SldWorks
Dim Model As SldWorks.ModelDoc2
Dim MyPath, ModName, NewName As String
Dim MB As Boolean
Dim Errs As Long
Dim Warnings As Long

Sub main()

Set SwApp = Application.SldWorks

' This ensures that there are files loaded in SolidWorks
Set Model = SwApp.ActiveDoc
If Model Is Nothing Then
MB = MsgBox("No drawing loaded!", vbCritical)
Exit Sub
End
End If

' Admonish user if attempted to run macro on part or assy file
If Model.GetType <> 3 Then
SwApp.SendMsgToUser "Current document is not a drawing."
End
End If

' Use one of the three following options for PDF save location
' Comment out the options with are not used.

' Option 1: Use the current directory
' MyPath = CurDir
'
' Option 2: Specify the directory you want to use
' MyPath = "C:\PDF"

' Option 3: Use the drawing folder
MyPath = Left(Model.GetPathName, InStrRev(Model.GetPathName, "\") -
1)

' Status
ModName = Left(Model.GetTitle, InStrRev(Model.GetTitle, " Sheet") -
3)
NewName = ModName & ".pdf"
MsgBox "Save " & NewName & " to" & Chr(13) & MyPath & Chr(13) &
Chr(13) & "(No notification will occur " & Chr(13) & "for success PDF
creation.)"

' PDF Creation
MB = Model.SaveAs4(MyPath & "\" & NewName, swSaveAsCurrentVersion,
swSaveAsOptions_Silent, Errs, Warnings)

' Warnings to user on Error
' MsgBox "Errors: " & Errs & vbCrLf & "Warnings: " & Warnings
If Warnings <> 0 Then
MsgBox "There were warnings. PDF creation may have failed.
Verify" & Chr(13) & "results and check possible causes.", vbExclamation
Else
End If

If MB = False Then
MsgBox "PDF creation has failed! Check save location, available"
& Chr(13) & "disk space or other possible causes.", vbCritical
Else
End If

'Clear immediate values
Set Model = Nothing
Set MyPath = Nothing


End Sub

From: inthepickle on 3 May 2006 07:00
thx fcsuper. I have tried to use your code, but there is one thing
that is going wrong. I modified your code by taking out some of the
error checking and adding FolderName as a variable. Whenever I use
that variable the save will not work, but if I comment it out, the save
works fine. What is the deal with that variable. Someone please help
me with this.



Dim SwApp As SldWorks.SldWorks
Dim Model As SldWorks.ModelDoc2
Dim MyPath, ModName, NewName, FolderName As String
Dim MB As Boolean
Dim Errs As Long
Dim Warnings As Long
Sub main()

Set SwApp = Application.SldWorks
Set Model = SwApp.ActiveDoc

If Model Is Nothing Then
MB = MsgBox("No drawing loaded!", vbCritical)
Exit Sub
End
End If

If Model.GetType <> 3 Then
SwApp.SendMsgToUser "Current document is not a drawing."
End
End If

ModName = Left(Model.GetTitle, InStrRev(Model.GetTitle, " Sheet") -
3)
NewName = ModName & ".pdf"
FolderName = Left(ModName, 4)

MyPath = "H:\DWGS\" & FolderName & "\" & NewName

MB = Model.SaveAs4(MyPath, swSaveAsCurrentVersion,
swSaveAsOptions_Silent, Errs, Warnings)

End Sub

From: inthepickle on 3 May 2006 11:44
to anyone else out there who is wondering what the answer was. I will
tell you. It would only save the PDF to a folder that already existed.
It was not in the code to create a folder. Here is the code that will
allow you to do this. Hope this helps someone. Thanks everyone for
your input.

Dim SwApp As SldWorks.SldWorks
Dim Model As SldWorks.ModelDoc2
Dim MyPath, ModName, NewName, FolderName As String
Dim MB As Boolean
Dim Errs As Long
Dim Warnings As Long
Sub main()

Set SwApp = Application.SldWorks
Set Model = SwApp.ActiveDoc

'checks to see if something is open
If Model Is Nothing Then
MB = MsgBox("No drawing loaded!", vbCritical)
Exit Sub
End
End If

'checks to make sure drawing is open
If Model.GetType <> 3 Then
SwApp.SendMsgToUser "Current document is not a drawing."
End
End If

'check to make sure drawing has been saved
FileName = Model.GetPathName
If FileName = "" Then
MB = MsgBox("Save Drawing First!", vbCritical)
Exit Sub
End
End If

ModName = Left(Model.GetTitle, InStrRev(Model.GetTitle, " Sheet") -
3) & ".pdf" 'gets file name & adds pdf extension
FolderName = Left(ModName, 4) 'gets first 4 characters from file
name

'CreateDir "H:\DWGS\", FolderName 'creates folder in directory
uncomment if needed

MyPath = "H:\DWGS\" & FolderName & "\" & ModName 'only works if
folder has already been created

MB = Model.SaveAs4(MyPath, swSaveAsCurrentVersion,
swSaveAsOptions_Silent, Errs, Warnings)

'ERROR CHECKING IF NEEDED
'MsgBox "Errors: " & Errs & vbCrLf & "Warnings: " & Warnings
'If Warnings <> 0 Then
' MsgBox "There were warnings. PDF creation may have failed.
Verify" & Chr(13) & "results and check possible causes.", vbExclamation
'Else
'End If

'If MB = False Then
' MsgBox "PDF creation has failed! Check save location,
available" & Chr(13) & "disk space or other possible causes.",
vbCritical
'Else
'End If

End Sub
Sub CreateDir(Path As String, MyFolder As String)
Dim stPath As String
On Error Resume Next
stPath = Path & "\" & MyFolder
MkDir stPath
End Sub

From: Mr. Who on 3 May 2006 12:09
Ah, I think I know what you are doing wrong. You are trying to create
a folder that matches the name of the drawing and then saving the
drawing into it.

So if you had a drawing called MyDraw.slddrw you wanted it saved to:

H:\DWGS\MyDraw\MyDraw.pdf

But you can't save to a directory that doesn't exist! You will need to
use the windows filesystemobject to create the directory before trying
to save into it.

dim fso as object
set fso = CreateObject("Scripting.FileSystemObject")
if not fso.folderexists("H:\DWGS\" & FolderName) Then fso.CreateFolder
"H:\DWGS\" & FolderName

The other code piece you posted didn't work because you declare
modeldoc as your document object but then you do the save you used
modeldoc!2!.

Here is my code remodified to account for everything including error
messages, directory creation, drawing name without file extension, save
to folder that uses drawing name.
You can download it at http://209.123.84.162/solidworks/

From: SW Monkey on 4 May 2006 12:22
Im confused. What are you trying to do that the macro I posted doesnt
do?

First  |  Prev  |  Next  |  Last
Pages: 1 2 3 4 5
Prev: Free IGES Viewer?????
Next: Installation Problem