SaveAS PDF Differences

Well the code is pretty ugly and messes with the registry. This is much simpler and does the same.

Dim swApp As Object Dim swDrawing As Object Dim strName As String Dim longErrors As Long Dim longWarnings As Long

Sub main()

Set swApp = Application.SldWorks Set swDrawing = swApp.ActiveDoc If swDrawing.GetType 3 Then MsgBox "I only work with drawings.": End

Path = "c:\temp\" strName = Right(swDrawing.GetPathName, Len(swDrawing.GetPathName) - Len(Left(swDrawing.GetPathName, InStrRev(swDrawing.GetPathName, "\",

-1, vbTextCompare)))) If strName = "" Then MsgBox "Make sure you've saved the drawing before trying to create a pdf of it.": End boolstatus = swDrawing.SaveAs4(Path & strName & ".pdf", 0, 1, longErrors, longWarnings) If boolstatus = False Then MsgBox "Something went wrong during save. Make sure you have bluebeam added in for older SW versions."

End Sub

Code above puts .slddrw in the PDF filename.

Heres the code I use.

----------------------------------------------- Dim swApp As Object Dim Drawing As Object Dim boolstatus As Boolean Dim longstatus As Long Dim Annotation As Object Dim Gtol As Object Dim DatumTag As Object Dim FeatureData As Object Dim Feature As Object Dim Component As Object

Sub main() Dim FileName As String Dim dotpos As Integer Dim slashpos As Integer Dim dashpos As Integer

Set swApp = CreateObject("SldWorks.Application") Set Drawing = swApp.ActiveDoc

If Drawing Is Nothing Then MsgBox ("No document loaded") Exit Sub End If

If Drawing.GetType swDocDRAWING Then MsgBox ("This macro only works with drawings.") Exit Sub End If

FileName = Drawing.GetPathName If FileName = "" Then 'model is not saved yet FileName = Drawing.GetTitle dashpos = InStrRev(FileName, "-") 'find dash to remove sheet name from title i.e. " - sheet1" FileName = Mid(FileName, 1, dashpos - 2) Else dotpos = InStrRev(FileName, ".") slashpos = InStrRev(FileName, "\")

If dotpos 0 Then ' if contains a dot (extension exists) then chop off extension FileName = Mid(FileName, slashpos + 1, dotpos - slashpos - 1) Else 'does not contain a dot FileName = Right(FileName, Len(FileName) - slashpos) End If End If

Load UserForm1

'set the filter UserForm1.CommonDialog1.Filter = "All Files (*.*)|*.*|PDF Files (*.pdf)|*.pdf|SolidWorks Drawing Files (*.slddrw)|*.slddrw" ' Specify default filter. UserForm1.CommonDialog1.FilterIndex = 2

'Set the default file name UserForm1.CommonDialog1.FileName = "C:\TEMP-PDF\" + FileName 'FileName = "C:\xxx.DXF"

' Set CancelError is True UserForm1.CommonDialog1.CancelError = True

' CancelError is True. On Error GoTo ErrHandler

UserForm1.CommonDialog1.ShowSave

FileName = UserForm1.CommonDialog1.FileName Drawing.SaveAs3 FileName, swSaveAsCurrentVersion, swSaveAsOptions ErrHandler: ' User pressed Cancel button. Unload UserForm1 Exit Sub

End Sub

If you want just the basename and not the .slddrw then you can use instrev to identify the dot position.

strBaseName = Left(strName, len(StrName) - InStrRev(1, StrName, ".", vbTextCompare)

I think, coding off the top of my head here.

I appreciate everyones help. Let me try again. Here is my simplified code. The problem is that when I try to do my SaveAS, I get errors. Everything else works OK. Can anyone tell me what is going on with my SaveAS, and specifically what I need to change.

Sub main() Dim StartingPath As String Dim SlashPosition As Integer Dim FileName As String Dim FileNameNoExt As String Dim FolderName As String Dim FinalPath As String

Set swApp = Application.SldWorks Set ModelDoc = swApp.ActiveDoc

' gets the path of the file StartingPath = ModelDoc.GetPathName 'gets the position of last \ SlashPosition = InStrRev(StartingPath, "\") 'removes path and leaves part name FileName = Right(StartingPath, Len(StartingPath) - SlashPosition) 'takes off the SLDPRT FileNameNoExt = Left(FileName, Len(FileName) - 6) 'give 1st 4 characters of part name FolderName = Left$(FileName, 4) 'final path for save pdf FinalPath = "H:\DWGS\" & FolderName & "\" & FileNameNoExt & "PDF"

ModelDoc2.SaveAs4 FinalPath, swSaveAsCurrentVersion, swSaveAsCurrentVersion

End Sub

I appreciate everyones help. Let me try again. Here is my simplified code. The problem is that when I try to do my SaveAS, I get errors. Everything else works OK. Can anyone tell me what is going on with my SaveAS, and specifically what I need to change.

Sub main() Dim StartingPath As String Dim SlashPosition As Integer Dim FileName As String Dim FileNameNoExt As String Dim FolderName As String Dim FinalPath As String

Set swApp = Application.SldWorks Set ModelDoc = swApp.ActiveDoc

' gets the path of the file StartingPath = ModelDoc.GetPathName 'gets the position of last \ SlashPosition = InStrRev(StartingPath, "\") 'removes path and leaves part name FileName = Right(StartingPath, Len(StartingPath) - SlashPosition) 'takes off the SLDPRT FileNameNoExt = Left(FileName, Len(FileName) - 6) 'give 1st 4 characters of part name FolderName = Left$(FileName, 4) 'final path for save pdf FinalPath = "H:\DWGS\" & FolderName & "\" & FileNameNoExt & "PDF"

ModelDoc2.SaveAs4 FinalPath, swSaveAsCurrentVersion, swSaveAsCurrentVersion

End Sub

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, "\") -

' Status ModName = Left(Model.GetTitle, InStrRev(Model.GetTitle, " Sheet") -

' 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

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") -

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

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

End Sub

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") -

'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

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/

Im confused. What are you trying to do that the macro I posted doesnt do?

I was trying to take the first 4 characters of the Solidworks file name and use that variable as a folder name in the path of the place where the PDF was going to be saved. In hindsight, my problem was that it would only save to a folder that was manually created. I have now figured out how to create one on the fly now. Sorry for all of the confusion.

fcsuper , Im looking at the macro you posted to replace mine. The issue I have with mine and yours is it doesnt notify you if the PDF already exist. In SW 2004, my macro did this. Something must have changed in the code, but I cant figure it out.

Any ideas?

If a PDF already exist in the directory its saving to, I want a message asking "are you sure you want to overwrite".

I know nothing about programming. But if you can't figure it out within the code, there is something else you can do that should prevent automatic overwrites. After you create your PDF's set them to read-only. Windows shouldn't allow you to overwrite the file (although I've seen stranger thing happen).

A simple FileExists call should ensure that you don't overwrite a pre-existing file. Only a few additional lines of code.

I want the user to be allowed to overwrite the file, I just want them to be notified that a file exist already.

Do you know the code I can use for this?

Like I said, the macro does this in SW 2004, but not in SW 2005.

I want the user to be allowed to overwrite the file, I just want them to be notified that a file exist already.

Do you know the code I can use for this?

Like I said, the macro does this in SW 2004, but not in SW 2005.

Im also trying to figure out how to open the PDF after it is generated. This would allow the user to verify everything looks good.

Just before the save add something like this (make sure you add reference to microsoft scripting runtime)

Dim fso As object Dim file as object set fso = createobject("Scripting.FileSytemObject")

if FileExists(PathToWhereFileWillBeSaved) = True Then msgbox "I'm going to overwrite this file." Set File = PathToWhereFileWillBeSaved File.Delete if FileExists(PathToWhereFileWillBeSaved) = True Then msgbox "oops i couldnt delete the file. It must be open already or something." End if

Mr Who,

I cant get the above to work with my macro posted above. (I added a reference to MS scripting runtime)

That was just the code outline. The actual working code would be like this.

FileName = "C:\temp\myFile.pdf" Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(FileName) = True Then MsgBox "I'm going to overwrite: " & FileName Set file = fso.GetFile(FileName) file.Delete If fso.FileExists(FileName) = True Then MsgBox "oops i couldnt delete the file. It must be open already or something." End If

In terms of integrating it with your existing macro you have to call it just before Drawing.SaveAs3 FileName, swSaveAsCurrentVersion, swSaveAsOptions. I am assuming that FileName is the full path to the PDF file. I can't actually test this with your code because your code is dependent on the presence of a userform. Anyone else following this thread should take note that you can't cut and paste the monkey code and have it work on your system.