Public Sub SaveConfigurationsToSTEP() On Error GoTo Canceled ' Get the STEP translator Add-In Dim oSTEPTranslator As TranslatorAddIn Set oSTEPTranslator = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}") If oSTEPTranslator Is Nothing Then MsgBox ("Could not access STEP translator!"), vbCritical, "Error" GoTo Canceled End If Dim oContext As TranslationContext Set oContext = ThisApplication.TransientObjects.CreateTranslationContext Dim oOptions As NameValueMap Dim oDocument As Document Set oDocument = ThisApplication.ActiveDocument Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap 'File Type Check and iLogic Presence Dim iType As Integer iType = 0 '0 - No iLogic, 1 - iPart, 2 - iAssembly If (Right(oDocument.DisplayName, 3) = "ipt") Then If (oDocument.ComponentDefinition.IsiPartFactory) Then iType = 1 End If ElseIf (Right(oDocument.DisplayName, 3) = "iam") Then If (oDocument.ComponentDefinition.IsiAssemblyFactory) Then iType = 2 End If End If If (iType = 0) Then MsgBox ("There are no configurations in the document!"), vbCritical, "Error" GoTo Canceled Else If oSTEPTranslator.HasSaveCopyAsOptions(ThisApplication.ActiveDocument, oContext, oOptions) Then ' Set application protocol ' 2 = AP 203 - Configuration Controlled Design ' 3 = AP 214 - Automotive Design oOptions.Value("ApplicationProtocolType") = 3 ' Other options... 'oOptions.Value("Author") = "" 'oOptions.Value("Authorization") = "" 'oOptions.Value("Description") = "" 'oOptions.Value("Organization") = "" oContext.Type = kFileBrowseIOMechanism Dim oData As DataMedium Set oData = ThisApplication.TransientObjects.CreateDataMedium 'Set filepath as original document filepath Dim FilePath As String FilePath = Left(oDocument.File.FullFileName, InStrRev(oDocument.File.FullFileName, "\")) 'Name prefix request Dim NamePrefix As String NamePrefix = InputBox("Enter the file prefix", "Names", "") If StrPtr(NamePrefix) = 0 Then GoTo Canceled End If 'Directory request Dim Directory As String Directory = InputBox("Enter the sub-directory name for saving to " & FilePath, "Directory name", "STEP") If StrPtr(Directory) = 0 Then GoTo Canceled Else Directory = Directory & "\" End If 'Save number of current configuration Dim ActiveIndex As Integer 'Create a new ProgressBar object. Dim oProgressBar As ProgressBar 'Create Loop Index Dim i As Integer If (iType = 1) Then 'Check to see it it's an iPart 'Set a reference to the iPart Factory Dim oiPartFactory As iPartFactory Set oiPartFactory = oDocument.ComponentDefinition.iPartFactory ActiveIndex = oiPartFactory.DefaultRow.Index Set oProgressBar = ThisApplication.CreateProgressBar(True, oiPartFactory.TableRows.Count, "Saving progress") ' Set the message for the progress bar oProgressBar.Message = "Saving configurations to STEP files" 'Loop through all the rows in the iPart table and set that row to the active iPart For i = 1 To oiPartFactory.TableRows.Count Dim IPF As iPartFactory Set IPF = oDocument.ComponentDefinition.iPartFactory Dim oPRow As iPartTableRow Set oPRow = IPF.TableRows.Item(i) IPF.DefaultRow = oPRow oProgressBar.Message = "Saving " & i & " files" oProgressBar.UpdateProgress oData.FileName = FilePath & Directory & NamePrefix & oPRow.MemberName & ".step" Call oSTEPTranslator.SaveCopyAs(ThisApplication.ActiveDocument, oContext, oOptions, oData) Next 'Reset to active configuration Set oPRow = IPF.TableRows.Item(ActiveIndex) IPF.DefaultRow = oPRow ElseIf (iType = 2) Then 'Check to see it it's an iAssembly 'Set a reference to the iAssembly Factory Dim oiAssemblyFactory As iAssemblyFactory Set oiAssemblyFactory = oDocument.ComponentDefinition.iAssemblyFactory ActiveIndex = oiAssemblyFactory.DefaultRow.Index Set oProgressBar = ThisApplication.CreateProgressBar(True, oiAssemblyFactory.TableRows.Count, "Saving progress") ' Set the message for the progress bar oProgressBar.Message = "Saving configurations to STEP files" 'Loop through all the rows in the iAssembly table and set that row to the active iAssembly For i = 1 To oiAssemblyFactory.TableRows.Count Dim IAF As iAssemblyFactory Set IAF = oDocument.ComponentDefinition.iAssemblyFactory Dim oARow As iAssemblyTableRow Set oARow = IAF.TableRows.Item(i) IAF.DefaultRow = oARow oProgressBar.Message = "Saving " & i & " files" oProgressBar.UpdateProgress oData.FileName = FilePath & Directory & NamePrefix & oARow.MemberName & ".step" Call oSTEPTranslator.SaveCopyAs(ThisApplication.ActiveDocument, oContext, oOptions, oData) Next 'Reset to active configuration Set oARow = IAF.TableRows.Item(ActiveIndex) IAF.DefaultRow = oARow Else GoTo Canceled End If 'Terminate the progress bar oProgressBar.Close 'Create message MsgBox ("Saved " + CStr(i) + " file(s)!"), vbInformation, "Done" Else 'Create error message MsgBox ("STEP translator error!"), vbCritical, "Error" End If End If Canceled: End Sub