OK, Save an image is shown below. its slightly different to how we save our pdf's stp, dwgs etc but is more what I would like to do with our rendered files.
oh..
I'm not a programmer, and pretty much cobbled this together... I'm sure there are better ways of doing it but this works for us quite well...so, that said.the rule does the following:
* saves the old background colour details to a text file
* activates a new colour scheme with a white background
*checks a network folder for all subfolders whose first 6 characters match the first 6 characters of the current documents filename
* if found, set the network path and filename for the image file
* switch off 3d indicator
* set resolution and print image file to C:\images\<first 6 characters>\
* copy image from c:\images to the network location mentioned previously
* if there is no match with the first 6 characters of the filename and the network folders, then save the filename to a folder C:\images\OTHER\
*reset the old background colour
so we save a copy of the image in a folder on the users machine and if the file belongs to a project, the image is then copied over to the network area for others to use..
if there is anyway to do something similar with the renders that would be brilliant.. many thanks for any assistance.
Imports System.IO
'On Error Resume Next
oPath = ThisDoc.Path
oFileName = ThisDoc.FileName(False) 'without extension
Dim oDoc As Document
oDoc = ThisApplication.ActiveEditDocument
fs = CreateObject("Scripting.FileSystemObject")
OldColorFile = fs.CreateTextFile(ThisDoc.Path & "\" & ThisDoc.FileName(False) & "OldColorName.txt", True)
Dim OldColorSchemeName As String
OldColorSchemeName = ThisApplication.ActiveColorScheme.Name
OldColorFile.WriteLine (OldColorSchemeName)
OldColorFile.Close
OldBackgroundFile = fs.CreateTextFile(ThisDoc.Path & "\" & ThisDoc.FileName(False) & "OldBackground.txt", True)
Dim OldBackground As BackgroundTypeEnum
OldBackground = ThisApplication.ColorSchemes.BackgroundType
OldBackgroundFile.WriteLine (OldBackground)
OldBackgroundFile.Close
ThisApplication.ColorSchemes.Item("Presentation").Activate
ThisApplication.ColorSchemes.BackgroundType = 52737
' Get the active view.
Dim oView As View
oView = ThisApplication.ActiveView
oTime = TimeString
oTime = Val(oTime) & "-" & Mid(oTime, 4, 2) & "-" & Right(oTime, 2)
'*****************************************
Dim oName2 As String
oName2 = Left(oDoc.DisplayName, 6) 'assumes project number in file name is 6 chrs
Dim sRootDrive As String
sRootDrive = "Y:\Inventor\Drawing and Sketches\"
'expects to find only one
Dim dirs As String()
Dim dir As String
Dim oTargetFolder As String
Try
'look for all directories starting with project number using * as a wildcard
'dirs = Directory.GetDirectories(path to search, what to search for)
dirs = Directory.GetDirectories(sRootDrive, oName2)
'get subdirectory and set variable
For Each dir In dirs
If dir.Contains(oName2) Then
oTargetFolder = dir
oFolder = SRootDrive & oName2 & "\Images\" & oFileName & " " & DateString & " " & oTime & ".jpg"
ThisApplication.DisplayOptions.Show3DIndicator = False
' Save the view as a jpg file.
Call oView.SaveAsBitmap(oFolder, 6000, 0)
fname = "C:\images\" & oName2 & "\"
'Check for the folder and create it if it does not exist
If Not System.IO.Directory.Exists(fname) Then
System.IO.Directory.CreateDirectory(fname)
End If
FileCopy(oFolder, (fname & "\" & oFileName & " " & DateString & " " & oTime & ".jpg"))
'open the folder where the new files are saved
Shell("explorer.exe " & oFolder,vbNormalFocus)
End If
Next
Catch
oTargetFolder = ""
End Try
If oFolder = "" Then
oRFolder = "C:\Images\OTHER\"
oFolder = oRFolder & oFileName & " " & DateString & " " & oTime & ".jpg"
'Check for the folder and create it if it does not exist
If Not System.IO.Directory.Exists(oRFolder) Then
System.IO.Directory.CreateDirectory(oRFolder)
End If
ThisApplication.DisplayOptions.Show3DIndicator = False
' Save the view as a jpg file.
Call oView.SaveAsBitmap(oFolder, 6000, 0)
'open the folder where the new files are saved
Shell("explorer.exe " & oFolder,vbNormalFocus)
End If
Dim oRead As New StreamReader(ThisDoc.Path & "\" & ThisDoc.FileName(False) & "OldBackground.txt")
Dim aLine As String
aLine = oRead.readline()
oRead.Close
Kill (ThisDoc.Path & "\" & ThisDoc.FileName(False) & "OldBackground.txt")
Dim Read As New Streamreader(ThisDoc.Path & "\" & ThisDoc.FileName(False) & "OldColorName.txt")
Dim bLine As String
bLine = Read.readline()
Read.Close
Kill (ThisDoc.Path & "\" & ThisDoc.FileName(False) & "OldColorName.txt")
ThisApplication.ColorSchemes.Item(bline).Activate
ThisApplication.ColorSchemes.BackgroundType = aline