You'll need ini file with DWG export setting.
VBA Macro:
Sub SplitPath(Fullname As String, Path As String, Filename As String)
Dim PathLength As Integer
Dim PathEnd As Integer
Dim i As Integer
i = 1
PathLength = Len(Fullname)
While i <= PathLength
If Mid(Fullname, i, 1) = "\" Then
PathEnd = i
End If
i = i + 1
Wend
Path = Left(Fullname, PathEnd)
Filename = Mid(Fullname, PathEnd + 1, PathLength - PathEnd - 4)
End Sub
Public Sub PublishPDF()
' Get the PDF translator Add-In.
Dim PDFAddIn As TranslatorAddIn
Set 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
Set oDocument = ThisApplication.ActiveDocument
Dim oContext As TranslationContext
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = kFileBrowseIOMechanism
' Create a NameValueMap object
Dim oOptions As NameValueMap
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
' Create a DataMedium object
Dim oDataMedium As DataMedium
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
' Check whether the translator has 'SaveCopyAs' options
If PDFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
' Options for drawings...
oOptions.value("All_Color_AS_Black") = 0
oOptions.value("Remove_Line_Weights") = 0
' Resolutions: 150, 200, 300, 400, 600, 720, 1200, 2400, 4800
oOptions.value("Vector_Resolution") = 1200
oOptions.value("Sheet_Range") = kPrintAllSheets
'oOptions.Value("Custom_Begin_Sheet") = 2
'oOptions.Value("Custom_End_Sheet") = 4
End If
Dim DrawingName As String
DrawingName = " "
Dim DrawingPath As String
DrawingPath = " "
Dim DrawingFullName As String
DrawingFullName = oDocument.FullFileName
Call SplitPath(DrawingFullName, DrawingPath, DrawingName)
'Check if folder exist, create if not
On Error Resume Next
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.CreateFolder(DrawingPath + "PDF")
'Set the destination file name
oDataMedium.Filename = DrawingPath + "PDF\" + DrawingName + ".pdf"
'Publish document.
Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
End Sub
Public Sub PublishDWG()
' Get the DWG translator Add-In.
Dim DWGAddIn As TranslatorAddIn
Set DWGAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}")
'Set a reference to the active document (the document to be published).
Dim oDocument As Document
Set oDocument = ThisApplication.ActiveDocument
Dim oContext As TranslationContext
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = kFileBrowseIOMechanism
' Create a NameValueMap object
Dim oOptions As NameValueMap
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
' Create a DataMedium object
Dim oDataMedium As DataMedium
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
' Check whether the translator has 'SaveCopyAs' options
If DWGAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
Dim strIniFile As String
strIniFile = "C:\DWGOut.ini"
' Create the name-value that specifies the ini file to use.
oOptions.value("Export_Acad_IniFile") = strIniFile
End If
Dim DrawingName As String
DrawingName = " "
Dim DrawingPath As String
DrawingPath = " "
Dim DrawingFullName As String
DrawingFullName = oDocument.FullFileName
Call SplitPath(DrawingFullName, DrawingPath, DrawingName)
'Check if folder exist, create if not
On Error Resume Next
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.CreateFolder(DrawingPath + "DWG")
'Set the destination file name
oDataMedium.Filename = DrawingPath + "DWG\" + DrawingName + ".dwg"
'Publish document.
Call DWGAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
End Sub
Public Sub Publish_All_IDW()
Dim fs, f
Dim oDoc As Document
Dim oApp As Inventor.Application
Dim IDWFile As String
Set oApp = ThisApplication
Dim DrawingName As String
DrawingName = " "
Dim DrawingPath As String
DrawingPath = " "
Dim DrawingFullName As String
DrawingFullName = SelectFileDialog(4)
If DrawingFullName <> "" Then
Call SplitPath(DrawingFullName, DrawingPath, DrawingName)
Set fs = CreateObject("Scripting.FileSystemObject")
ChDir (DrawingPath)
Debug.Print DrawingPath
IDWFile = Dir(DrawingPath + "\*.IDW")
While IDWFile <> ""
Debug.Print IDWFile
Set oDoc = oApp.Documents.Open(DrawingPath + "\" + IDWFile)
PublishPDF
PublishDWG
oDoc.Close
IDWFile = Dir
Wend
End If
End Sub
