×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Macro query

Macro query

Macro query

(OP)
I played about a bit and got to the editor tool, which displays as below, but there doesn't appear to be an instruction to determine colour/B&W. I'd really like to do more with these - they seem like great timesavers...

Dim swApp As Object
Dim Part As Object
Dim SelMgr As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As Object
Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
Set swModel = swApp.ActiveDoc

sPathName = swModel.GetPathName 'Get File Name & Path
Extension = Right(sPathName, 6) 'Determine File Type

'Try Again if Not "SLDDRW"
If Extension <> "SLDDRW" Then
    MsgBox ("Current Document Is Not .SLDDRW")
    End
End If
    
'Save as PDF
SavePDF:

sPathName = Left(sPathName, Len(sPathName) - 6) 'Remove "SLDDRW" Extension
sPathName = sPathName + "pdf" 'Add "PDF" Extension

Set fso = CreateObject("Scripting.FileSystemObject") 'Check if file exists
If (fso.FileExists(sPathName)) Then 'If file exists
    If MsgBox("Overwrite " & sPathName & " ?", vbYesNo) = vbNo Then 'Ask if want to overwrite file
    End If
End If
Part.SaveAs2 sPathName, 0, True, False 'Save file if file does not exist or if choose vbYes

End Sub

RE: Macro query

RE: Macro query

That's just a system setting.  You *could* just turn it off and be done with it, but that's no fun.  All you need to do is toggle that setting in the code.  This new code will get the current setting, turn it off no matter what it's set at, then set it back to what it was at the end.  You can easily add a message box asking if you want to save in color or not.  If you prefer it that way, let me know, otherwise this should do what you're asking.


Dim swApp As Object
Dim Part As Object
Dim SelMgr As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As Object
Dim pdfColor as Boolean

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
Set swModel = swApp.ActiveDoc

sPathName = swModel.GetPathName 'Get File Name & Path
Extension = Right(sPathName, 6) 'Determine File Type

'Try Again if Not "SLDDRW"
If Extension <> "SLDDRW" Then
    MsgBox ("Current Document Is Not .SLDDRW")
    End
End If
    
'Save as PDF
SavePDF:

sPathName = Left(sPathName, Len(sPathName) - 6) 'Remove "SLDDRW" Extension
sPathName = sPathName + "pdf" 'Add "PDF" Extension

pdfColor = swApp.GetUserPreferenceToggle(swPDFExportInColor)
swApp.SetUserPreferenceToggle swPDFExportInColor, False

Set fso = CreateObject("Scripting.FileSystemObject") 'Check if file exists
If (fso.FileExists(sPathName)) Then 'If file exists
    If MsgBox("Overwrite " & sPathName & " ?", vbYesNo) = vbNo Then 'Ask if want to overwrite file
    End If
End If
Part.SaveAs2 sPathName, 0, True, False 'Save file if file does not exist or if choose vbYes

swApp.SetUserPreferenceToggle swPDFExportInColor, pdfColor

End Sub

RE: Macro query

I cleaned it up a bit for you, as you had some mismatched variables, as well as some unused ones.  Try this instead:

Dim swApp As Object
Dim swModel As Object
Dim sPathName As String
Dim pdfColor As Boolean
Dim SaveFile As Boolean

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

If swModel Is Nothing Then
    End
End If

If swModel.GetType <> 3 Then
    MsgBox "This utility only works on .SLDDRW files"
    End
End If

sPathName = swModel.GetPathName 'Get File Name & Path
sPathName = Left(sPathName, Len(sPathName) - 6) 'Remove "SLDDRW" Extension
sPathName = sPathName & "pdf" 'Add "PDF" Extension

pdfColor = swApp.GetUserPreferenceToggle(swPDFExportInColor)
swApp.SetUserPreferenceToggle swPDFExportInColor, False

SaveFile = True
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(sPathName) Then 'Check if file exists
    If MsgBox("Overwrite " & sPathName & " ?", vbYesNo) = vbNo Then 'Ask if want to overwrite file
        SaveFile = False
    End If
End If

If SaveFile Then
    swModel.SaveAs2 sPathName, 0, True, False 'Save file if file does not exist or if choose vbYes
End If

swApp.SetUserPreferenceToggle swPDFExportInColor, pdfColor

End Sub

RE: Macro query

(OP)
You, sir, are a GENIUS. I copied and pasted that into the existing macro, exit, save and boom - done. Absolutely perfect! :D

RE: Macro query

No problem, I do what I can.  Honestly though, it's a bit of luck that I knew it so quickly.  I had a similar issue exporting DXFs not too long ago, and had to figure out the right toggles to get everything right.

Anyway, if you didn't already, I'd suggest using the second piece of code I posted instead of the first.  Your original code does NOT skip saving the file if you choose "No" when asked if you want to overwrite the file.

RE: Macro query

(OP)
Ooh - I don't suppose you have one that exports dwg's as well?!

I have a client that requests all their drawings in dwg and occasionally dxf as well as the SW format we normally deliver. If you have one that exports dwg's in a sensible manner, I'd be forever grateful. I find save-as seems to generate some odd results (scales out - so I open in AutoCAD and scale everything up, only to find dimensions get multiplied by the same amount... etc, etc!)

I'll paste the second revision code in and give it a blast. I'm truly jealous that you can just bash this stuff out - it's like looking at the matrix to me at the moment...

RE: Macro query

Most of those things are just settings.  When you're at the save-as dialog box, after selecting the file type click options and it you can change them.

As for a macro, I do have one that saves a DXF, but it's a bit more detailed than you'd probably need.  If I get a chance, I'll try and get a quick one working tomorrow.  Otherwise, there should be plenty of examples that do the trick.

RE: Macro query

(OP)
I'll have a play with the settings and see what I can get out of it.

As for the dwg's, I tried the task scheduler some time ago but wasn't exactly blown away by the results. I thought it was worth another try, so gave it a second shot yesterday and had much better results, so I think I'll stick with that route for now.

Thanks again, however!

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources