inventor导出tekla_Inventor iLogic - 批量导出PDF,DXF,DWF

'定义当前文档为顶层文档

Dim oAsmDoc As Document

oAsmDoc = ThisApplication.ActiveDocument

oAsmName = ThisDoc.FileName(False) 'without extension

'本规则介绍和确认窗口

RUsure = MessageBox.Show ( _

"本规则将会为当前文档和所有下层工程图创建 PDF,DXF与DWF文档" _

& vbLf & "运行本规则需保证工程图与三维文档存在同一文件夹" _

& vbLf & " " _

& vbLf & "确认需要创建PDF,DXF和DWF文档?" _

& vbLf & "运行时间长短取决于工程图数量", "iLogic - Batch Export - Frank Li",MessageBoxButtons.YesNo)

If RUsure = vbNo Then

Return

Else

End If

'- - - - - - - - - - - - -PDF setup - - - - - - - - - - - -

oPath = ThisDoc.Path

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

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

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

oContext = ThisApplication.TransientObjects.CreateTranslationContext

oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism

oOptions = ThisApplication.TransientObjects.CreateNameValueMap

xOptions = ThisApplication.TransientObjects.CreateNameValueMap

oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

oDocument = ThisApplication.ActiveDocument

'定义PDF导出属性

oOptions.Value("All_Color_AS_Black") = 1

oOptions.Value("Remove_Line_Weights") = 0

oOptions.Value("Vector_Resolution") = 400

oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets

'定义DXF导出属性

Dim strIniFile As String

strIniFile = "C:\temp\dxfout.ini" '来源于手动保存DXF时导出的设置文件

xOptions.Value("Export_Acad_IniFile") = strIniFile

'定义导出文档路径

oFolder = "C:\Users\Public\ExportPDF\" & oAsmName & " " & DateString

'根据检测结果创建导出文件夹

If Not System.IO.Directory.Exists(oFolder) Then

System.IO.Directory.CreateDirectory(oFolder)

End If

'- - - - - - - - - - - - -

'- - - - - - - - - - - - -下层工程图 - - - - - - - - - - - -

'循环引用当前文档所有下层零件

Dim oRefDocs As DocumentsEnumerator

oRefDocs = oAsmDoc.AllReferencedDocuments

Dim oRefDoc As Document

'打开与零件存在同一路径的工程图

For Each oRefDoc In oRefDocs

idwPathName = Left(oRefDoc.FullDocumentName, Len(oRefDoc.FullDocumentName) - 3) & "idw"

'检测当前下层零件是否有工程图

If(System.IO.File.Exists(idwPathName)) Then

Dim oDrawDoc As DrawingDocument

oDrawDoc = ThisApplication.Documents.Open(idwPathName, True)

oFileName = IO.Path.GetFileNameWithoutExtension(oRefDoc.FullDocumentName)

On Error Resume Next ' 如果目标PDF已存在并被打开或处于只读属性，跳过当前文档

'设置PDF名字与保存路径

oDataMedium.FileName = oFolder & "\" & oFileName & ".pdf"

'创建PDF

Call PDFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)

'设置DWF名字与保存路径

oDataMedium.FileName = oFolder & "\" & oFileName & ".dwfx"

'创建DWF

Call DWFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)

'设置DXF名字与保存路径

oDataMedium.FileName = oFolder & "\" & oFileName & ".dxf"

'创建DXF

Call DXFAddIn.SaveCopyAs(oDrawDoc, oContext, xOptions, oDataMedium)

'关闭工程图

oDrawDoc.Close

Else

'无操作，如同一文件夹不存在相应工程图

End If

Next

'- - - - - - - - - - - - -

'- - - - - - - - - - - - -顶层工程图 - - - - - - - - - - - -

oAsmDrawing = ThisDoc.ChangeExtension(".idw")

oAsmDrawingDoc = ThisApplication.Documents.Open(oAsmDrawing, True)

oAsmDrawingName = ThisDoc.FileName(False) 'Without extension

On Error Resume Next ' 如果目标PDF已存在并被打开或处于只读属性，跳过当前文档

'设置PDF名字与保存路径

oDataMedium.FileName = oFolder & "\" & oAsmDrawingName & ".pdf"

'创建PDF

Call PDFAddIn.SaveCopyAs(oAsmDrawingDoc, oContext, oOptions, oDataMedium)

'设置DWF名字与保存路径

oDataMedium.FileName = oFolder & "\" & oAsmDrawingName & ".dwfx"

'创建DWF

Call DWFAddIn.SaveCopyAs(oAsmDrawingDoc, oContext, oOptions, oDataMedium)

'设置DXF名字与保存路径

oDataMedium.FileName = oFolder & "\" & oAsmDrawingName & ".dxf"

'创建DXF

Call DXFAddIn.SaveCopyAs(oAsmDrawingDoc, oContext, xOptions, oDataMedium)

'关闭顶层工程图

oAsmDrawingDoc.Close

'- - - - - - - - - - - - -

MessageBox.Show("创建文档保存在: " & vbLf & oFolder, "iLogic - Frank Li")

'打开文档所在文件夹

Shell("explorer.exe " & oFolder,vbNormalFocus)

Frank Li：Inventor iLogic 引用规则设置​zhuanlan.zhihu.comFrank Li：创建Inventor 导出DXF的设置文件.INI​zhuanlan.zhihu.com