- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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