Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
Anonymous
in reply to: MjDeck

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