How to automate changing configs and rendering to tif files?

Hello Matt,

Try something like this. All you have to do now is cope/rename whatever with the file.

' ****************************************************************************** ' ' snipped-for-privacy@studiozwaard.nl ' ****************************************************************************** Dim swApp As SldWorks.SldWorks Dim Part As SldWorks.ModelDoc2 Dim config As Object 'SldWorks.Configuration Dim boolstatus As Boolean Dim longstatus As Long, longwarnings As Long Dim FeatureData As Object Dim Feature As Object Dim Component As Object Sub main() On Error Resume Next Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc currentfile = Part.GetTitle targetpath = "C:\temp\"

For i = 0 To Part.GetConfigurationCount - 1 configname = Part.GetConfigurationNames(i) Part.ShowConfiguration configname

result = swApp.CallBack("pworks@MiEval", 0, "RenderToFile Filename ""C:\Temp\rendering.bmp""") result = swApp.CallBack("pworks@MiEval", 0, "RenderToFile Size 1280

1024") result = swApp.CallBack("pworks@MiEval", 0, "RenderToFile Format bmp") result = swApp.CallBack("pworks@MiEval", 0, "RenderToFile Render")

Next i MsgBox "Files have been saved in " & targetpath End Sub

Kind regards,

JJ

Matt Schroeder schreef:

JJ wrote: > Hello Matt, >

***************************************************************************= *** > ' > ' snipped-for-privacy@studiozwaard.nl > ' > Kind regards, >

JJ,

!! Amazing !! Thank you!

That works like a charm except it doesn't save to new file names, and therefore writes over each file as it goes to the next config I believe.

Is there something I did wrong?

Here's your code, as modified by me:

' '**************************************************************************=

*=AD*** ' ' snipped-for-privacy@studiozwaard.nl ' '**************************************************************************= *=AD*** Dim swApp As SldWorks.SldWorks Dim Part As SldWorks.ModelDoc2 Dim config As Object 'SldWorks.Configuration Dim boolstatus As Boolean Dim longstatus As Long, longwarnings As Long Dim FeatureData As Object Dim Feature As Object Dim Component As Object Sub main() On Error Resume Next Set swApp =3D Application.SldWorks Set Part =3D swApp.ActiveDoc currentfile =3D Part.GetTitle targetpath =3D "C:\Documents and Settings\Schrom00\My Documents\My Pictures\"

For i =3D 0 To Part.GetConfigurationCount - 1 configname =3D Part.GetConfigurationNames(i) Part.ShowConfiguration configname

result =3D swApp.CallBack("pworks@MiEval", 0, "RenderToFile Filename ""C:\Documents and Settings\Schrom00\My Documents\My Pictures\rendering.tif""") result =3D swApp.CallBack("pworks@MiEval", 0, "RenderToFile Size 1280

1024") result =3D swApp.CallBack("pworks@MiEval", 0, "RenderToFile Format tif ") result =3D swApp.CallBack("pworks@MiEval", 0, "RenderToFile Render")

Next i MsgBox "Files have been saved in " & targetpath End Sub

Hello Matt,

You can try to use the filesystem object to rename a file.

dim fso as scripting.filesystemobject dim f as file

set fso=createobject("scripting.filesystemobject") set f=fso.getfile(filename)

f.name=new_filename

I typed this over, so plz check it for writing errors, but this can be used to rename a file.

By the way, I also have a macro to save each configuration as a part. If you need it, plz let me know.

Kind regards,

JJ

JJ,

There are new photoworks apis that make this a bit more intuitive and easier to understand. Here is similar code for that. Most of this code was created by recording the rendering of a file with the appropriate settings.

Dim swApp As SldWorks.SldWorks Dim Part As SldWorks.ModelDoc2 Dim config As Object 'SldWorks.Configuration Dim boolstatus As Boolean Dim longstatus As Long, longwarnings As Long Dim FeatureData As Object Dim Feature As Object Dim Component As Object Sub main() On Error Resume Next Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc currentfile = Part.GetTitle targetpath = "C:\.......\My Pictures\"

'There are new Photoworks APIs we first need to connect to Photoworks use them Dim pwPhotoWorks As PhotoWorks.PhotoWorks Set pwPhotoWorks = swApp.GetAddInObject("PhotoWorks.PhotoWorks") Dim pwOpt As PhotoWorks.PwOptions Set pwOpt = pwPhotoWorks.PwOptions swApp.ActiveDoc.ActiveView.FrameState = 1

'True overwrites existing files of the same name false doesn't bOverWrite = False

'Recurse through the configurations of the document For i = 0 To Part.GetConfigurationCount - 1 configname = Part.GetConfigurationNames(i) Part.ShowConfiguration configname

'Set all the rendering options

'set the file name to that of the configuration pwPhotoWorks.RenderFilename = TargetPath & configname & ".tif""" 'set the file format. pwPhotoWorks.RenderFileFormat = PW_RenderFileFormat.pwFileFormatTIF 'set the current units pwPhotoWorks.RenderFileUnits = PW_RenderFileUnits.pwInches 'Height in the current units which is inches pwPhotoWorks.RenderFileHeight = 1 'Width in the current units which is inches pwPhotoWorks.RenderFileWidth = 1 'DPI of render file. pwPhotoWorks.RenderFileDotsPerUnit = 1200

'Start the render process pwPhotoWorks.RenderToFile (bOverWrite)

Next i MsgBox "Files have been saved in " & targetpath End Sub

Regards, Corey

JJ wrote: