Inventor采用VBA代码批量导出模型中的一些问题

[chenhongyun_yx]

环境：inventor 2025

代码：vba

流程：用inventor将手上已有的step模型打开（此时还未保存），执行代码（代码功能：批量导出保文件为dwg文件），代码执行后会先在打开的文件的路径文件夹中新建一个文件夹，然后在其中保存文件为ipt文件，再次打开ipt文件执行代码才会在ipt所在文件夹中导出dwg文件。

问题：1.不理解为什么保存的时候为什么会于源路径自行新建一个同名文件夹后保存；2.当打开另外一个文件夹中的step文件执行代码后，理论上本应该是保存在打开的文件所在文件夹中，但是实际还是保存在了第一次代码执行成功后保存的位置，在此之后，不论是修改代码还是重启程序还是重启电脑，不论打开哪里的文件，执行代码后都是保存在哪一个文件夹中，不能再修改保存路径。

vba代码：

Sub ExportAndClose()
Dim oDoc As Document
Dim oPath As String
Dim oName As String
Dim oDWGTranslator As TranslatorAddIn
Dim oContext As TranslationContext
Dim oOptions As NameValueMap
Dim oData As DataMedium

Set oDWGTranslator = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}")

    On Error Resume Next
ThisApplication.SilentOperation = True
Do While ThisApplication.Documents.Count > 0
Set oDoc = ThisApplication.ActiveDocument
oPath = Left(oDoc.FullFileName, InStrRev(oDoc.FullFileName, ""))
oName = Left(oDoc.DisplayName, InStrRev(oDoc.DisplayName, ".") - 1)

Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = kFileBrowseIOMechanism
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
Set oData = ThisApplication.TransientObjects.CreateDataMedium

If oDWGTranslator.HasSaveCopyAsOptions(oDoc, oContext, oOptions) Then

oOptions.Value("Export_Acad_Layout") = False
oOptions.Value("Export_Acad_PaperSpace") = False
oOptions.Value("Export_3D_Geometry") = True
End If

        oData.FileName = oPath & oName & ".dwg"

Call oDWGTranslator.SaveCopyAs(oDoc, oContext, oOptions, oData)

oDoc.Saved = True ' Set the document as saved to avoid the save prompt
oDoc.Close
Loop
ThisApplication.SilentOperation = False
On Error GoTo 0
End Sub

[Stakin · Accepted solution]

You can start from autocad vba,skip all of pre steps of inventor.

[chenhongyun_yx]

Sorry, I didn't follow your train of thought. Can you be more specific

[chenhongyun_yx]

I understand, thank you

[Stakin]

if you just want to translate stp to Autocad dwg version,  open the stp file from AutoCAD vba ,skip Inventor steps.

[Stakin]

Sub main()
	Dim oDoc As Document	
	Dim oPath As String = ThisApplication.DesignProjectManager.ActiveDesignProject.WorkspacePath
	Dim oName As String
	Dim oDWGTranslator As TranslatorAddIn
	Dim oContext As TranslationContext
	Dim oOptions As NameValueMap
	Dim oData As DataMedium
	oDWGTranslator = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}")
	On Error Resume Next	
	Dim oStpFileName As String
	oContext = ThisApplication.TransientObjects.CreateTranslationContext
	oContext.Type = kFileBrowseIOMechanism
	oData = ThisApplication.TransientObjects.CreateDataMedium	
	oStpFileName = oSelectSTPFile(oPath)
	
	Dim oStepFileInfo As New System.IO.FileInfo(oStpFileName)	
	If oStpFileName = "" Then
		MsgBox("No File Select",,"Ilogic")
		Exit Sub
	Else	
		oDoc=oOpenSTEP(oStpFileName, oStepFileInfo.DirectoryName & "\Inv_From_" &  Replace(oStepFileInfo.Name ,".", "_") )
	End If
	ThisApplication.SilentOperation = True
	oDoc.Save	
	oPath = Left(oDoc.FullFileName, InStrRev(oDoc.FullFileName, "\"))
	oName = Left(oDoc.DisplayName, InStrRev(oDoc.DisplayName, ".") -1)	
	Dim oStepPath As New System.IO.DirectoryInfo(oPath)
	Dim oCount As Integer=0
	If oDWGTranslator.HasSaveCopyAsOptions(oDoc, oContext, oOptions) Then
			oOptions.Value("Export_Acad_Layout") = False
			oOptions.Value("Export_Acad_PaperSpace") = False
			oOptions.Value("Export_3D_Geometry") = True
	End If	
	Dim oDWGPath As String = oStepPath.Parent.FullName & "\DWG_From_" & Replace(oStepFileInfo.Name ,".", "_") & "\"	
	If Not System.IO.Directory.Exists(oDWGPath) Then
		System.IO.Directory.CreateDirectory(oDWGPath)
	End If	
	oData.FileName = oDWGPath & oName & ".dwg"
	oCount += 1
	Call oDWGTranslator.SaveCopyAs(oDoc, oContext, oOptions, oData)
	If oDoc.DocumentType = Inventor.DocumentTypeEnum.kAssemblyDocumentObject Then		
		Dim oAsm As AssemblyDocument
		oAsm = oDoc
		Dim oSubDoc As Document
		For Each oSubDoc In oAsm.ReferencedDocuments
			If oDWGTranslator.HasSaveCopyAsOptions(oSubDoc, oContext, oOptions) Then
				oOptions.Value("Export_Acad_Layout") = False
				oOptions.Value("Export_Acad_PaperSpace") = False
				oOptions.Value("Export_3D_Geometry") = True
			End If			
			oName = Left(oSubDoc.DisplayName, InStrRev(oSubDoc.DisplayName, ".") -1) 
			oData.FileName = oDWGPath & oName & ".dwg"		
			Call oDWGTranslator.SaveCopyAs(oSubDoc, oContext, oOptions, oData)
			oCount += 1
		Next
	End If
	oDoc.Close
	ThisApplication.SilentOperation = False
	MsgBox("The  STEP  file name:" & vbLf  & vbTab & oStpFileName & vbLf & "The Inventor file Path:" & vbLf  & vbTab & oPath & vbLf & _
	        "The AutoCAD file Path:" & vbLf  & vbTab & oDWGPath & vbLf & vbLf & _
	        "There are " & oCount & " models are translated to Autocad Drawing", , "Translate Info")
	On Error GoTo 0
End Sub

Function oSelectSTPFile(oPath As String) As String
	Dim oStpFileName As String
	Dim oOpenDlg As New System.Windows.Forms.OpenFileDialog
	oOpenDlg.Title = "Select a STEP File"
	oOpenDlg.ShowPreview = True
	oOpenDlg.Filter="STEP files (*.stp)|*.stp|All files (*.*)|*.*"
	oOpenDlg.FilterIndex = 1
	oOpenDlg.RestoreDirectory =True
	oOpenDlg.InitialDirectory= oPath
	If oOpenDlg.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
    	   oStpFileName= oOpenDlg.FileName	  
	End If
	Return oStpFileName
End Function

Function oOpenSTEP(strSTEP As String, strPath As String) As Document
	Dim oSTEPTranslator As TranslatorAddIn
	Dim oContext As TranslationContext
	Dim oOptions As NameValueMap
	Dim oDataMedium As DataMedium
	Dim oTarget As Object
	Dim oDoc As Document
	Dim i As Integer
	oSTEPTranslator = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")
	oContext = ThisApplication.TransientObjects.CreateTranslationContext
	oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
	oOptions = ThisApplication.TransientObjects.CreateNameValueMap
	oOptions.Value("SaveComponentDuringLoad") = False
	oOptions.Value("SaveInSubFolder") = False
	oOptions.Value("SaveLocationIndex") = 1
	oOptions.Value("ComponentDestFolder") = strPath
	oOptions.Value("SaveAssemSeperateFolder") = False
	oOptions.Value("AssemDestFolder") = strPath
	oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
	oDataMedium.FileName = strSTEP
	If oSTEPTranslator.HasOpenOptions(oDataMedium, oContext, oOptions) Then
	    oOptions.Value("EmbedInDocument") = False
	    Call oSTEPTranslator.Open(oDataMedium, oContext, oOptions, oTarget)
	    oDoc = oTarget
	    Call oDoc.Views.Add    
	End If
	Return oDoc
End Function

Try this,I think this maybe is what you want.