Batch Export Drawing DXF.iLogicVB

Imports System.IO
Imports System.IO.File

Sub Main()

	Dim usrTimeAck = MessageBox.Show("This rule will find all drawings of parts referenced in the BOM and Export them as ACAD DXFs to your desktop.  "  _
		& vbLf & "This process can take some time to run, and cannot be stopped once started.  ", "Time Warning", MessageBoxButtons.OKCancel, MessageBoxIcon.Warning)
		
	If usrTimeAck = vbCancel Then
		Exit Sub
	End If
	
	Dim VaultAddin As Inventor.ApplicationAddIn = ThisApplication.ApplicationAddIns.ItemById("{48B682BC-42E6-4953-84C5-3D253B52E77B}")
	VaultAddin.Deactivate()

	Try 
		Dim oDoc as Document = ThisApplication.ActiveDocument
		Dim FileNameMinLong as Integer = 21
		
		'check if active document is an assembly
		If isAsm(oDoc) = False
			MsgBox("Please run from an Assembly")
			Return
		End If
		
		'write to iLogic Log
		SharedVariable("LogVar") = "Batch Export Drawing DXF" 
		iLogicVB.RunExternalRule("Write SV to Log.iLogicVB")
		

		Dim oAppend As System.IO.StreamWriter
		noWrite = True
		
		Dim lstDrawings as New List(of String)
		
		Dim BOMDocs As New List(of String)
	
		'get list of part numbers from Structured BOM
		GetDocsFromBOM(ThisApplication.ActiveDocument, BOMDocs)
		
		
		 Dim oProgressBar as Inventor.ProgressBar
		' Dim DocCount = oRefDocs.Count
		 oProgressBar = ThisApplication.CreateProgressBar(False, BOMDocs.Count, "Finding Drawings...")

		'Attempt to find a drawing file of the same name as the assembly doc
		RefDwgFullFileName = FindDrawingFilePN(oDoc)
		
		oProgressBar.Message = "Checking for drawing of " & oDoc.FullFileName
		oProgressBar.UpdateProgress
		
		If RefDwgFullFileName.Length > FileNameMinLong Then 
		
			lstDrawings.Add(RefDwgFullFileName)
			
		End If
		
		
		'Dim bDoc as Document
		For Each BOMDoc as String In BOMDocs
			bDoc = ThisApplication.Documents.ItemByName(BOMDoc) 'convert full file name to document object
			
			oProgressBar.Message = "Checking for drawing of " & BOMDoc 'oRefDoc.FullFileName
			oProgressBar.UpdateProgress

			'Attempt to find a drawing file of the same name as the model doc
			RefDwgFullFileName = FindDrawingFilePN(bDoc)
			
			If RefDwgFullFileName.Length > FileNameMinLong Then 
			
				lstDrawings.Add(RefDwgFullFileName)

			End If
			
		Next
		
		oProgressBar.Close		

		ExportDwgs(oDoc.FullFileName, lstDrawings)
		
		' CopyPostInfo(oDoc)

		
	Catch Ex as Exception
	
		MsgBox("Main error: " & Ex.Message)
		
	Finally 
	
		VaultAddin.Activate
		
	End Try
	
End Sub 'Main

Private Sub ExportDwgs(strFilePath as String, lstDwgsPrint as List(of String))
	
	'Dim PDFCreatorQueue As Queue = New Queue
	'Dim job As Object
	Dim fullPath As String

	Dim oProgressBar As Inventor.ProgressBar = ThisApplication.CreateProgressBar(False, lstDwgsPrint.Count, "Exporting Drawings...")

	Try

		fullPath = DocumentFileName(strFilePath) 'Path.Combine(Path.GetTempPath, Path.GetTempFileName)
		
		savepath = System.Environment.GetFolderPath(System.Environment.SpecialFolder.Desktop) & "\" & IO.Path.GetFileNameWithoutExtension(strFilePath) & "\" & Now.ToString("yyyyMMddHHmm") & "\"

		System.IO.Directory.CreateDirectory(savepath)
		'MsgBox("Initializing PDFCreator queue...")
		'PDFCreatorQueue.Initialize()
		
		'setup options for open
		Dim oOptions as NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
		oOptions.Value("DeferUpdates") = True
		oOptions.Value("FastOpen") = True
	
	
		'MsgBox("Printing windows test page...")
		For Each DwgName as String In lstDwgsPrint
		
			oProgressBar.Message = "Exporting drawing file: " & DwgName
			oProgressBar.UpdateProgress
			DWG = ThisApplication.Documents.OpenWithOptions(DwgName, oOptions, True)

			ExportDXF(DWG, savepath)
			'DWG.SaveAs(savepath & IO.Path.GetFileNameWithoutExtension(DwgName) & ".dxf", True)
			'DwgPrint("PDFCreator")
			DWG.Close(True)
			
		Next
		
		Process.Start("explorer.exe", "/select," & savepath)
		
	Catch Ex As Exception
	
		MessageBox.Show("ExportDwgs Error: " & Ex.Message)
		
	Finally

		oProgressBar.Close
		
	End Try
	
End Sub

Sub ExportDXF(oDoc as DrawingDocument, Path as String)
	
	'setup translator addin options
	Dim DXFAddIn As TranslatorAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")
	Dim oContext As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext
	oContext.Type = kFileBrowseIOMechanism
	Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
	Dim oDataMedium As DataMedium = ThisApplication.TransientObjects.CreateDataMedium
	Dim strIniFile As String = "C:\_vaultWIP\Designs\Templates\Library\iLogic\dxf_export.ini"
	Dim oSheets as Sheets = oDoc.Sheets
	Dim oSheet as Sheet '= oSheets.Item(1)

	'Iterate through all sheets, exporting and attaching each sheet individually
	For Each oSheet in oSheets
		
		oSheet.Activate
		
		'Get sheet number
		oCurrentSheet = Mid(oDoc.ActiveSheet.Name, InStr(1, oDoc.ActiveSheet.Name, ":")+1)
		
		'get filename w/o extension
		FileName = Path & IO.Path.GetFileNameWithoutExtension(oDoc.FullFileName)
		
		'Append sheet number if more than one sheet
		If oSheets.Count > 1 Then
			FileNameDXF = FileName & " p" & oCurrentSheet & ".dxf"
		Else 
			FileNameDXF = FileName & ".dxf"
		End If
		
		'Writes all configured options to translator addin
		If DXFAddIn.HasSaveCopyAsOptions(oDoc, oContext, oOptions) Then
				oOptions.Value("Export_Acad_IniFile") = strIniFile
		End If
		
		'sets DXF filename to Translator addin
		oDataMedium.FileName = FileNameDXF 
		
		'Check if we have write access to file, error if not
		Try
			DXFAddin.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium) 'set all options 
		Catch Ex As Exception
			MessageBox.Show("WHAT DID I JUST SAY!!!!  You do not have permission to write to this file, likely because you DIDNT CHECK IT OUT!!!!  " & vbLF & Ex.Message, "Permission Denied", MessageBoxButtons.OK, MessageBoxIcon.Error)
			Exit Sub
		End Try
		
	Next
End Sub 'ExportDXF


Sub GetDocsFromBOM(oDoc as Document, ByRef BOMDocs as List(of String))
	
	If oDoc.DocumentType <> kAssemblyDocumentObject Then
		MsgBox("This rule can only be run from an assembly")
		Exit Sub
	End If
	
	Dim oDocBOM As BOM = oDoc.ComponentDefinition.BOM

	oDocBOM.StructuredViewEnabled = True
	oDocBOM.StructuredViewFirstLevelOnly = False
	oDocBOM.PartsOnlyViewEnabled = False
	
	Dim oBOMView as BOMView = oDocBOM.BOMViews.Item("Structured")	
	Dim oBOMRows As BOMRowsEnumerator = oBOMView.BOMRows
	Dim oCompDef As ComponentDefinition
	Dim oPNProp as Inventor.Property
	
	For Each oRow as BOMRow in oBOMRows
		
			GetBOMRowDocFile(oRow, BOMDocs)
		
	Next 
	
End Sub

Sub GetBOMRowDocFile(oRow as BOMRow, ByRef BOMDocs as List(of String))
	
	Dim oCompDef As ComponentDefinition
	
	'Add the part number of the current row, for parts that have children
	oCompDef = oRow.ComponentDefinitions.Item(1)
	
	If oCompDef.Type = 100675072 Then 'exclude Virtual Components
		'do nothing
	Else

		DocName = oCompDef.Document.FullFileName

		If Not BOMDocs.Contains(DocName) Then
			BOMDocs.Add(DocName)
		End If
		
	End If
		
	If Not oRow.ChildRows Is Nothing Then
	
		For Each oChildRow as BOMRow in oRow.ChildRows		
			GetBOMRowDocFile(oChildRow, BOMDocs)
		Next
		
	End If
	
End Sub

Function FindDrawingFilePN(PartOrAssemblyDoc As Document) As String
    Dim fullFilenamePN As String
    fullFilenamePN = PartOrAssemblyDoc.fullFilename
   
    ' Extract the path from the full filename.
    Dim path As String = ThisApplication.DesignProjectManager.ActiveDesignProject.WorkspacePath

	Dim iProps as PropertySet = PartOrAssemblyDoc.PropertySets.Item("Design Tracking Properties")
	Dim pn = iProps.Item("Part Number")
	
    Dim filename As String = pn.Value

    ' Find if the drawing exists.
    Dim drawingFilename As String
    drawingFilename = ThisApplication.DesignProjectManager.ResolveFile(path, filename & ".dwg")
   
    ' Check the result.
    If drawingFilename = "" Then
       
        ' Find if the drawing exists.
        drawingFilename = ThisApplication.DesignProjectManager.ResolveFile(path, filename & ".idw")
   
        ' Return the result.
        If drawingFilename <> "" Then
            Return drawingFilename
        Else
            Return ""
        End If
    Else
        ' Return the result.
         Return drawingFilename
    End If
End Function 'FindDrawingFilePNN

Private Sub DwgPrint(PrinterName as String)
	Dim oPrintMgr As DrawingPrintManager = ThisApplication.ActiveDocument.PrintManager
	' Get the name of the printer that will be used.
	oPrintMgr.Printer = PrinterName
	
	' Set to print in color.
	oPrintMgr.ColorMode = 13313 'kPrintColorPalette
	
	' Set to print one copies.
	oPrintMgr.NumberOfCopies = 1
	
	' Set to print using landscape orientation.
	oPrintMgr.Orientation = 13570
		'13570 'kLandscapeOrientation
		'13569 'kPortraitOrientation
	
	' Set the paper size.
	oPrintMgr.PaperSize = 14338
		'14338 'kPaperSize11x17
	
	' Set to print all sheets.
	oPrintMgr.PrintRange = 14082 'kPrintAllSheets
	
	' Set to print full scale.
	oPrintMgr.ScaleMode = 13825 'kPrintFullScale
	
	' Submit the print.
	oPrintMgr.SubmitPrint
End Sub 'DwgPrint

Private Sub printTestFile()
	Dim ShellObj As Object

	ShellObj = CreateObject("Shell.Application")
	ShellObj.ShellExecute("RUNDLL32.exe", "PRINTUI.DLL,PrintUIEntry /k /n ""PDFCreator""", "", "open", 1)
End Sub

Function DocumentFileName(Doc As String) As String
	DocumentFileName = Left(Doc, Doc.Length - 4)
	'MsgBox(DocumentFileName)
End Function 'DocumentFileName

Function isAsm(ThisDoc As Document) As Boolean
	Debug.Print (ThisDoc.DocumentType)
	If ThisDoc.DocumentType = kAssemblyDocumentObject Then
		isAsm = True
	Else
		isAsm = False
	End If
End Function 'isAsm