Prev: Free IGES Viewer?????
Next: Installation Problem
From: inthepickle on 2 May 2006 13:09
Here is the code that I have for a macro that saves a drawing as a PDF.
Most of this code has came from a macro that I downloaded somewhere.
I am attempting to change it, but I am having problems. Originally
Line 25 works great, but it saves the PDF to the directory of the
drawing. I don't want that, so I added Lines 20-24 to make up my path.
I then added Line 26 and commented out 25. The Macro did not work at
all. I need to know why line line 25 works and why line 26 will not.
If I debug.print either one of them, they are exactly the same. What
am I doing wrong, and how can I make it work the way I want.

1 Public swApp As SldWorks.SldWorks
2 Public DrawingDoc As SldWorks.DrawingDoc
3 Dim ModelDoc As SldWorks.ModelDoc2
4 Dim objWShell As Object
5 Dim strRegKey As String
6 Dim lngWarnings As Long
7 Dim lngErrors As Long
8 Dim strPDFName As String
9 Sub main()
10 Set swApp = Application.SldWorks
11 Set ModelDoc = swApp.ActiveDoc
12 If Not ModelDoc Is Nothing Then
13 If ModelDoc.GetType = swDocDRAWING Then
14 Set DrawingDoc = ModelDoc
15 strRegKey = "HKEY_CURRENT_USER\Software\Bluebeam
Software\Pushbutton PDF\SolidWorksLt\WhatToPlot"
16 Set objWShell = CreateObject("WScript.Shell")
17 objWShell.RegWrite strRegKey, 1
18 Set objWShell = Nothing
19 Set objFS = CreateObject("Scripting.FileSystemObject")
20 FullPath = ModelDoc.GetPathName ' gets the path of the
file
21 SlashPosition = InStrRev(FullPath, "\") 'gets the
position of last \
22 FileName = Right(FullPath, Len(FullPath) -
SlashPosition) 'removes path and leaves part name
23 FileNameNoExt = Left(FileName, Len(FileName) - 7) 'takes
off the SLDPRT
24 FolderName = Left$(FileName, 4) 'give 1st 4 characters
of part name
25 'strPDFName =
objFS.buildpath(objFS.GetParentFolderName(DrawingDoc.GetPathName),
objFS.GetBaseName(DrawingDoc.GetPathName) & ".PDF")
26 'strPDFName = "H:\DWGS\" & FolderName & "\" &
FileNameNoExt & ".PDF"
27 DrawingDoc.SaveAs4 strPDFName, swSaveAsCurrentVersion,
swSaveAsOptions_Silent, lngErrors, lngWarnings
28 Else
29 MsgBox "A SolidWorks Drawing document must be open in
order to SaveAs a PDF!", vbInformation
30 End If
31 Else
32 MsgBox "A SolidWorks Drawing document must be open in
order to SaveAs a PDF!", vbInformation
33 End If
34 End Sub

From: Mr. Who on 2 May 2006 14:43
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

From: Mr. Who on 2 May 2006 16:15
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.

From: inthepickle on 2 May 2006 16:37
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

From: inthepickle on 2 May 2006 16:37
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

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