Option Explicit

'--------------------------------------------------------------------------------------------------
Sub Main
On Error Goto ErrorHandler
Dim oMainDrawing As DrawingDocument
Dim oDrawing As DrawingDocument
Dim oSheet As Sheet
Dim lPos As Long
Dim sSheetName As String
Dim iSheetNumber As Integer
Dim sSheetSize As String
Dim sName As String
Dim sPath As String
Dim sFileName As String
Dim sFullFileName As String
Dim sIniFileName As String
Dim sModelName As String
Dim sActiveSheetName As String
Dim oPartList As PartsList
Dim iNumberOffRows as Integer
Dim iRow As Integer
Dim oRow As PartsListRow
Dim oCell As PartsListCell
Dim sDescription As String
Dim sDrawingNumber As String
Dim ExportPartList As Boolean
Dim Response As Integer

'çheck if active document is drawing
'If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then Exit Sub

'set general variables and define drawing
sPath = ThisDoc.Path
sFileName = ThisDoc.FileName(False) 'without extension
oMainDrawing = ThisDoc.Document
sIniFileName = "G:\Inventor\IDW to DWG\IV2Acad Den Herder.ini"
'set the active sheet name
sActiveSheetName = ActiveSheet.Name

'set the model name for this drawing
sModelName = IO.Path.GetFileName(ThisDrawing.ModelDocument.FullFileName)
sName = iProperties.Value(sModelName, "Project", "Description")

'check for partlist and ask if it needs to be exported
If CheckForPartlist Then
	Response = MessageBox.Show("Do you want to export the partlist too?", "Partlist Export", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
	If response = vbYes Then
		oPartList = oMainDrawing.ActiveSheet.PartsLists.Item(1)
		iNumberOffRows = oPartList.PartsListRows.Count
		ExportPartList = True
	Else
		iNumberOffRows = 1
		ExportPartList = False
	End If
Else
	iNumberOffRows = 1
	ExportPartList = False
End If

'export the main drawing first
ExportDrawing (oMainDrawing, sName ,sFileName, sPath, sIniFileName)

'export the drawings in the partlist if needed
If ExportPartList Then
	'step through the partslist
	For iRow = 1 To iNumberOffRows
		sDescription = GetCurrRowValue(oPartList, iRow, "DESCRIPTION")
		sDrawingNumber = GetCurrRowValue(oPartList, iRow, "ITEM/DRW.NUMBER")
		If System.IO.File.Exists(sPath & "\" & sDrawingNumber & ".idw") Then
			oDrawing = ThisApplication.Documents.Open(sPath & "\" & sDrawingNumber & ".idw", False)
			ExportDrawing (oDrawing, sDescription ,sDrawingNumber, sPath, sIniFileName)
			oDrawing.Close(True)
		End If
	Next iRow
End If

' activate first sheet
ActiveSheet = ThisDrawing.Sheet(sActiveSheetName)
Exit Sub

ErrorHandler:
MessageBox.Show("Error # " & Str(Err.Number) & " was generated by " & Err.Source & ControlChars.CrLf & Err.Description , "Error", MessageBoxButtons.OK, MessageBoxIcon.Hand, MessageBoxDefaultButton.Button1)
Resume Next
End Sub

'--------------------------------------------------------------------------------------------------
Sub ExportDrawing (oDrawing As DrawingDocument, sName As String, sFileName As String, sPath As String, sIniFileName As String)
Dim oSheet As Sheet
Dim lPos As Long
Dim sLen As Long
Dim sSheetName As String
Dim iSheetNumber As Integer
Dim sSheetSize As String
Dim iSheetCount As Integer
Dim sRevision As String
Dim sFolder As String
Dim sFullFileName As String

iSheetCount = oDrawing.Sheets.Count

For Each oSheet In oDrawing.Sheets
	oSheet.Activate
	'find the seperator in the sheet name:number
	lPos = InStr(oSheet.Name, ":")
	'find the number of characters in the sheet name
	sLen = Len(oSheet.Name)
	'find the sheet name
	sSheetName = Left(oSheet.Name, lPos -1)
	'find the sheet number
	iSheetNumber = CInt(Right(oSheet.Name, sLen -lPos))
	'find the sheet size
	sSheetsize = GetSheetSize(oSheet.Size)
	'find the revision number
	sRevision = iProperties.Value("Project", "Revision Number")
	
	'get target folder path
	sFolder =  sPath & "\DWG & PDF"
	'Check for the folder and create it if it does not exist
	If Not System.IO.Directory.Exists(sFolder) Then System.IO.Directory.CreateDirectory(sFolder)
	If iSheetCount > 1 Then
		sFullFileName = sFolder & "\" & sFileName & sRevision & " (" & sSheetSize & ") " & sName & " (" & sSheetName & " " & iSheetNumber & " of " & iSheetCount & ")"
	Else
		sFullFileName = sFolder & "\" & sFileName & sRevision & " (" & sSheetSize & ") " & sName
	End If
	SaveToPDF (sFullFileName & ".pdf", iSheetNumber)
	SaveToDWG (sFullFileName & ".dwg", sIniFileName)
'	MessageBox.Show("Exported sheet: " & iSheetNumber & " of " & iSheetCount, "Export Drawing", MessageBoxButtons.OK, MessageBoxIcon.Asterisk, MessageBoxDefaultButton.Button1)
Next oSheet

End Sub

'--------------------------------------------------------------------------------------------------
Function GetCurrRowValue(ByRef oPartList As PartsList, iRowNumber As Integer, sTitle As String) As String
Dim oRow As PartsListRow
Dim iColumn As Integer
Dim oCell As PartsListCell

oRow = oPartList.PartsListRows.Item(iRowNumber)
'step through the columns
For iColumn = 1 To oPartList.PartsListColumns.Count
	oCell = oRow.Item(iColumn)
	If oPartList.PartsListColumns.Item(iColumn).Title = sTitle Then
		GetCurrRowValue = oCell.Value
		Exit For
	End If
Next iColumn
'MessageBox.Show("Current row value: " & GetCurrRowValue, "Row Value", MessageBoxButtons.OK, MessageBoxIcon.Asterisk, MessageBoxDefaultButton.Button1)

End Function

'--------------------------------------------------------------------------------------------------
Sub SaveToPDF (sFileName As String, iSheetNumber As Integer)
Dim oPDFAddIn As TranslatorAddIn
Dim oDocument As Document
Dim oContext As TranslationContext
Dim oOptions As NameValueMap 
Dim oDataMedium As DataMedium 

oPDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")

'Set a reference to the active document 
oDocument = ThisApplication.ActiveDocument
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

'set PDF Options
If oPDFAddIn.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions) Then
	oOptions.Value("All_Color_AS_Black") = 0
	oOptions.Value("Remove_Line_Weights") = 0
	oOptions.Value("Vector_Resolution") = 400
	oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintSheetRange
	oOptions.Value("Custom_Begin_Sheet") = iSheetNumber
	oOptions.Value("Custom_End_Sheet") = iSheetNumber
End If

'Set the PDF target file name
oDataMedium.FileName = sFileName
'Publish document
oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
	
End Sub

'--------------------------------------------------------------------------------------------------
Sub SaveToDWG (sFileName As String, sIniFileName As String)
Dim oDWGAddIn As TranslatorAddIn
Dim oDocument As Document
Dim oContext As TranslationContext 
Dim oOptions As NameValueMap 
Dim oDataMedium As DataMedium 

oDWGAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}") 

'Set a reference to the active document 
oDocument = ThisApplication.ActiveDocument 
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium 

'set DWG Options
If oDWGAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then 
    ' DWG version: 23 = ACAD 2000, 25 = ACAD 2004, 27 = ACAD 2007, 29 = ACAD 2010
    oOptions.Value("DwgVersion") = 25
	' Create the name-value that specifies the ini file to use. 
	oOptions.Value("Export_Acad_IniFile") = sIniFileName
	
End If 

'Set the DWG target file name
oDataMedium.FileName = sFileName
'Publish document
oDWGAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium) 

End Sub

'--------------------------------------------------------------------------------------------------
Function CheckForPartlist () As Boolean
On Error Goto ErrorHandler
Dim oPartList As PartsList

oPartList = ThisDoc.Document.ActiveSheet.PartsLists.Item(1)
CheckForPartlist = True
oPartList = Nothing
Exit Function

ErrorHandler:
CheckForPartlist = False
oPartList = Nothing
End Function

'--------------------------------------------------------------------------------------------------
Function GetSheetSize(Number As Integer) As String
Select Case Number
	Case 9993
		GetSheetSize = "A0"
	Case 9994
		GetSheetSize = "A1"
	Case 9995
		GetSheetSize = "A2"
	Case 9996
		GetSheetSize = "A3"
	Case 9997
		GetSheetSize = "A4"
End Select
End Function