Project File Mapping

Anonymous · ‎09-30-2016

All,

I have the code stated below, I was hoping you could help with a few things:

Format:HTML Format Version:1.0 StartHTML: 165 EndHTML: 24470 StartFragment: 314 EndFragment: 24438 StartSelection: 314 EndSelection: 314SyntaxEditor Code Snippet

Sub Main
    iLogicVb.RunRule("CustOn")



'query user
MessageBox.Show("Would you like to print to the current Project File?: ", "iLogic Question",MessageBoxButtons.YesNo,MessageBoxIcon.Question)
'set condition based on answer
If question = vbYes Then
    oFileName = ThisDoc.FileName(False) 'without extension
    oRevNum = iProperties.Value("Project", "Revision Number")
    
    Else
    
    End If
    

    
    ' Get the PDF translator Add-In.
    Dim PDFAddIn As TranslatorAddIn
    PDFAddIn = ThisApplication.ApplicationAddIns.ItemById _
                            ("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")

    'Set a reference to the active document (the document to be published).
    Dim oDocument As Document
    oDocument = ThisApplication.ActiveDocument
     Dim oContext As TranslationContext
    oContext =  ThisApplication.TransientObjects.CreateTranslationContext
    oContext.Type = kFileBrowseIOMechanism
    'Create a NameValueMap object
    Dim oOptions As NameValueMap 
     oOptions = ThisApplication.TransientObjects.CreateNameValueMap
    ' Create a DataMedium object
    Dim oDataMedium As DataMedium
    oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
    ' Check whether the translator has 'SaveCopyAs' options
    If PDFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
        
        ' Options for drawings...
        'oOptions.Value("Launch_Viewer") = launchviewer
        oOptions.Value("All_Color_AS_Black") = 1
        'oOptions.Value("Sheet_Range") = ThisApplication.PrintRangeEnum.kPrintAllSheets
        oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets

        'oOptions.Value("Remove_Line_Weights") = 0
        'oOptions.Value("Vector_Resolution") = 400
        
        'oOptions.Value("Custom_Begin_Sheet") = 2
        'oOptions.Value("Custom_End_Sheet") = 4
    End If
    'get PDF target folder path
    oFolder = Left(ThisDoc.Path, InStrRev(oPath, "\")) & "PDF"
    'Check for the PDF folder and create it if it does not exist
        If Not System.IO.Directory.Exists(oFolder) Then
            System.IO.Directory.CreateDirectory(oFolder)
        End If
        
     'Set the PDF target file name
    Dim fname As String
    fname = oFolder & "\" & oFileName & " Rev" & oRevNum & "-CUST.pdf" 
    oDataMedium.FileName = fname
    'Publish document.
    If  System.IO.Directory.Exists(fname) Then
        System.IO.File.Delete(fname)
        MessageBox.Show("Earlier PDF deleted! ", "Inventor")
    End If
    PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
    MessageBox.Show("Print Created in default Projects -  "  & fname, "Inventor")

End Sub

First I was hoping I could have the project name added after the question in the project file. Also I was going to try and set up a browser the would pop up if you were to hit no where you can manually map the file where you'd like it to save?

Any ideas? I am pretty new to all of this and its getting a little too complex for my experience.

machiel.veldkamp · ‎09-30-2016

I made somthing VERY similar just last week!

Check out this topic: you can ask me any questions whatsoever.
http://forums.autodesk.com/t5/inventor-customization/automated-pdf-export-question/m-p/6577551#M6696...

Did you find this reply helpful ? If so please use the Accept as Solution or Kudos button below.

___________________________

Anonymous · ‎09-30-2016

Gosh that is helpful! But I am kind of lost..

First, where did you input your changes?? and also I was hoping to make it so it would print all the sheets as individual PDFs

Anonymous · ‎09-30-2016

I am really new to the extensive coding, I do more if then and suppression codes

Anonymous · ‎09-30-2016

This is the updated code... But I still cant distinguish the yes/no and how to map when no is selected.

Format:HTML Format Version:1.0 StartHTML: 165 EndHTML: 38787 StartFragment: 314 EndFragment: 38755 StartSelection: 314 EndSelection: 314SyntaxEditor Code Snippet

Sub Main
    
    Dim IPJ as String
    Dim IPJ_Name As String
    Dim IPJ_Path As String
    Dim FNamePos As Long
    'set a reference to the FileLocations object. 
    IPJ = ThisApplication.FileLocations.FileLocationsFile
    'get the location of the last backslash seperator 
    FNamePos = InStrRev(IPJ, "\", -1)     
    'get the project file name with the file extension
    IPJ_Name = Right(IPJ, Len(IPJ) - FNamePos) 
    'get the project name (without extension)
    IPJ_ShortName = Left(IPJ_Name, Len(IPJ_Name) - 4)
    'get the path of the folder containing the project file
    IPJ_Folder_Location = Left(IPJ, Len(IPJ) - Len(IPJ_Name))


    MessageBox.Show("Would you like to print to the current Project Folder?" & vbLf & "Project Name:" & IPJ_Name _
    & vbLf & "Project Path:" & IPJ_Folder_Location _ 
     ,"iLogic Question",MessageBoxButtons.YesNo,MessageBoxIcon.Question)
     
    Dim i As Integer
    iLogicVb.RunRule("CustOn")
    oFileName = ThisDoc.FileName(False) 'without extension
    oRevNum = iProperties.Value("Project", "Revision Number")
    oFolder = Left(ThisDoc.Path, InStrRev(oPath, "\")) & "PDF"
    'Check for the PDF folder and create it if it does not exist
        If Not System.IO.Directory.Exists(oFolder) Then
            System.IO.Directory.CreateDirectory(oFolder)
        End If
    
    Dim fname As String
    Dim PrintedSheets as String
        For i=1 To ThisDrawing.Document.sheets.count
            ActiveSheet = ThisDrawing.Sheet(ThisDrawing.Document.Sheets(i).Name)
            fname = oFileName & "-sht"& i  & "-Rev" & oRevNum & " .pdf"
            printedSheets = fname & vbCrLf & printedSheets
            printsheet (oFolder,fname)        
        Next i
        'iProperties.Value("Custom", "2Shop ShtTotal")= Chr(i + 64)
    MessageBox.Show("Print Created in default Projects -  " &  oFolder & " \" &  vbCrLf & vbCrLf & printedSheets , "Inventor")
        
End Sub




Function PrintSheet(sheetPath As String, sheetName As String  )


    ' Get the PDF translator Add-In.
    Dim PDFAddIn As TranslatorAddIn
    PDFAddIn = ThisApplication.ApplicationAddIns.ItemById _
                            ("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")

    'Set a reference to the active document (the document to be published).
    Dim oDocument As Document
    oDocument = ThisApplication.ActiveDocument
     Dim oContext As TranslationContext
    oContext =  ThisApplication.TransientObjects.CreateTranslationContext
    oContext.Type = kFileBrowseIOMechanism
    'Create a NameValueMap object
    Dim oOptions As NameValueMap 
     oOptions = ThisApplication.TransientObjects.CreateNameValueMap
    ' Create a DataMedium object
    Dim oDataMedium As DataMedium
    oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
    ' Check whether the translator has 'SaveCopyAs' options
        If PDFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
        
        ' Options for drawings...
        'oOptions.Value("Launch_Viewer") = launchviewer
        oOptions.Value("All_Color_AS_Black") = 1
        'oOptions.Value("Sheet_Range") = ThisApplication.PrintRangeEnum.kPrintAllSheets
        oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintCurrentSheet
        
        'oOptions.Value("Remove_Line_Weights") = 0
        'oOptions.Value("Vector_Resolution") = 400
        
        'oOptions.Value("Custom_Begin_Sheet") = 2
        'oOptions.Value("Custom_End_Sheet") = 4
    End If
    'get PDF target folder path
    
     'Set the PDF target file name
    
    oDataMedium.FileName = sheetPath & "\" & sheetName 
    'Publish document.
    If  System.IO.Directory.Exists( sheetPath & "\" & sheetName ) Then
        System.IO.File.Delete( sheetPath & "\" & sheetName )
        MessageBox.Show("Earlier PDF deleted! ", "Inventor")
    End If
    PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)


End Function

machiel.veldkamp · ‎09-30-2016

Public Sub Main()
	Dim oPath = ThisDoc.Path
	oFileName = ThisDoc.FileName(False) 'without extension
	oDuctName = iProperties.Value("Project", "Description")
	oRevNum = iProperties.Value("Project", "Revision Number")
	oPDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
	Dim oDWGAddIn As TranslatorAddIn
	oDWGAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}")
	oDrafstman = ThisApplication.UserName
	oDocument = ThisApplication.ActiveDocument
	oContext = ThisApplication.TransientObjects.CreateTranslationContext
	oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
	oOptions = ThisApplication.TransientObjects.CreateNameValueMap
	oDataMediumPDF = ThisApplication.TransientObjects.CreateDataMedium
	oDataMediumDWG = ThisApplication.TransientObjects.CreateDataMedium


 Dim FolderNameLoc As String
 
 'Declare projects in the "2016" Projects Folder
 Dim oChoice
 Dim ProjectChoice As New ArrayList
 ProjectChoice.Add("HOME") 'Drawings will be saved on a seperate location
 ProjectChoice.Add("ProjectExample1")
 ProjectChoice.Add("ProjectExample2")
 
 oQuestion2 = InputListBox("Project specification - in doubt select HOME", ProjectChoice, ProjectChoice, Title := "CHOOSE PROJECT", ListName := "ProjectChooser")
 
 FolderNameLoc = Mid(oPath, InStrRev(oPath , "\"))
 
 If oQuestion2 = "HOME"
 oFolder = "C:\TEMP\INVENTOR\Save As PDF DWG location\" & oDrafstman & "\"
 Else
 oFolder = "C:\TEMP\Projects\"& oQuestion2 &"\Specific Foldername"& FolderNameLoc & "\"
 End If





	'PDF Setup
	If oPDFAddIn.HasSaveCopyAsOptions(oDataMediumPDF, oContext, oOptions) Then
		oOptions.Value("All_Color_AS_Black") = 0
		oOptions.Value("Remove_Line_Weights") = 1
		oOptions.Value("Vector_Resolution") = 500
		oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets
	End If
	
	' DWG SETUP - Check whether the translator has 'SaveCopyAs' options
	If oDWGAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
		Dim strIniFile As String
		strIniFile = "G:\folder\INVENTOR\iLogic\Save as DWG aparte sheets.ini"' THIS PIECE IS NECECARY> CREATE A .INI FILE FROM AUTODESK AUTOCAD FIRST AND MAKE A SET THIS LINE TO THAT INI FILE>
		' Create the name-value that specifies the ini file to use.
		oOptions.Value("Export_Acad_IniFile") = strIniFile
	End If
	
	'get  target folder path
	If Not System.IO.Directory.Exists(oFolder) Then
		System.IO.Directory.CreateDirectory(oFolder)
	End If
	
		'Set the destination file name
	Dim fileName As String
	fileName = ThisDoc.FileName(False) & " - " & oDuctName & " - REV " & iProperties.Value("Project", "Revision Number")
	oDataMediumDWG.FileName = oFolder & fileName  & ".dwg"
	oDataMediumPDF.FileName = oFolder & fileName  & ".pdf"
	
	'Ask the User if he wants PDF or PDF+DWG
	oQuestion =  MessageBox.Show("For PDF select YES         for PDF+DWG select NO", "PDF or PDF/DWG", MessageBoxButtons.YesNoCancel, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
	
	'Publish document.
	If oQuestion = vbYes Then
		oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMediumPDF)
		Else If oQuestion = vbNo Then
			oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMediumPDF)
			oDWGAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMediumDWG)
			Else
			'MessageBox.Show("Canceled", "We're doing nothing now...")
	End If
		
	If oQuestion = vbYes Or oQuestion = vbNo Then
		OpenFolder=  MessageBox.Show("Would you open the folder?", "PDF EXPORTED", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
		'open the folder where the new files are saved
		If OpenFolder = vbYes Then
			Process.Start(Proc, Args)
			Else
			'Return
		End If
		Else
	End If 

End Sub

Alright. This should kinda do 'the' EDIT NOPE. Make an .ini file for the dwg export first EDIT trick for now. First thing monday morning i'll grab my copy at work and fix this bit so you can also select a custom folder.

So if this works as intended you should get a few notifications.

oQuestion2 = InputListBox("Project specification - in doubt select HOME", ProjectChoice, ProjectChoice, Title := "CHOOSE PROJECT", ListName := "ProjectChooser")

(/\ PIECE OF CODE)This questionbox grabs the input of the array that I specified above ( protip: make projectname for yourself)

	'Ask which project the User uses
	oQuestion2 = InputListBox("Choose where the exports need to be saved to", ProjectChoice, ProjectChoice, Title := "CHOOSE PROJECT", ListName := "ProjectChooser")

(/\ PIECE OF CODE)This Questionbox Does what it says inside the (" TEXT") piece of code. It's in english now. (whoops)

OpenFolder=  MessageBox.Show("Would you open the folder?", "PDF EXPORTED", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)

(/\ PIECE OF CODE) See how to read lines of code now?

Also. Look through the API a lot. Read through the things you want to use.
Try and search for:

HasSaveCopyAsOptions

I have a working piece of code at work that I can't acces at the moment that will do more than the code shown above.

for now. This is the best I can do. I'm no expert so forgive me for the lack of information 🙂

Did you find this reply helpful ? If so please use the Accept as Solution or Kudos button below.

___________________________

Community

Project File Mapping

Project File Mapping

Project File Mapping