Macro query 1

[hititfaster]

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

 

[CorBlimeyLimey]

I'm not at all competent with macro creation, but one of these should help?

http://solidworkstips.com/content/index.php/api-tips/53-06-one-button-pdf-publishing

http://sw.fcsuper.com/index.php?name=UpDownload&req=getit&lid=3

from

http://sw.fcsuper.com/index.php?name=UpDownload&req=viewsdownload&sid=6

http://www.eng-tips.com/search.cfm?...macro&t=&h=&searchSite=1&searchArea=1&d=1&s=1

https://forum.solidworks.com/thread/46204

https://forum.solidworks.com/message/144051#144051

 

[gp13]

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

 

[gp13]

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

 

[hititfaster]

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

 

[gp13]

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.

 

[hititfaster]

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...

 

[gp13]

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.

 

[hititfaster]

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!