Sub main ThisDoc.Save Dim oName_Rule As String = "To Insert One/Multiple Derived Parts" ' Get current part document (the "recipient" part) Dim oPartDoc As PartDocument = ThisDoc.Document ' Set reference to Derived Part Components manager for recipient part Dim oRefDerivedComps_ThisDoc As DerivedPartComponents = oPartDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents 'MessageBox.Show("oRefDerivedComps_ThisDoc.Count: " & oRefDerivedComps_ThisDoc.Count, oName_Rule) 'Dim oPartDoc As Document 'oPartDoc = ThisDoc.Document Dim oRefFile As FileDescriptor Dim oOrigRefName As Object Dim xx As Integer = 1 Dim oFFN_CurrRefDocs As New ArrayList '(Of String) Dim oLFN_CurrRefDocs As New ArrayList '(Of String) For Each oList_CurrRef2 In oPartDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents 'oRefDerivedComps_ThisDoc oLFN_CurrDP = oRefDerivedComps_ThisDoc.Item(xx).Name ' oFFN_CurrRefDocs.Add(oLFN_CurrDP) 'Add LOCAL FILE NAME into the array. ' MessageBox.Show("oList_CurrRef: " & oRefDerivedComps_ThisDoc.Item(xx).Name, oName_Rule) ' 'MessageBox.Show("oList_CurrRef: " & oRefDerivedComps_ThisDoc(xx).Name, oName_Rule) 'Also OK For Each oRefFile In oPartDoc.File.ReferencedFileDescriptors 'get the full file path to the original internal references oOrigRefName = oRefFile.FullFileName If oOrigRefName.Contains(oLFN_CurrDP) Then 'MessageBox.Show("oOrigRefName: " & oOrigRefName, oName_Rule) oFFN_CurrRefDocs.Add(oOrigRefName) 'Add Full FILE NAME into the array. oLFN_CurrRefDocs.Add(oLFN_CurrDP) 'Add Full FILE NAME into the array. End If Next oRefFile xx += 1 Next oList_CurrRef2 ' Specify parts to derived in (the "source" parts) Dim oFFN_SourcePartDocs As New List(Of String) Dim oExit As String = "EXIT" Dim oOther As String = "Other" oFFN_SourcePartDocs.Add("D:\Vault Workspace\Projects\A_RWEI\FEA Simulation\sk00001-FEA.ipt") oFFN_SourcePartDocs.Add("D:\Vault Workspace\Projects\A_RWEI\FEA Simulation\p00004-FEA.ipt") oFFN_SourcePartDocs.Add("D:\Vault Workspace\Projects\A_RWEI\FEA Simulation\p00008-FEA.ipt") oFFN_SourcePartDocs.Add(oOther) oFFN_SourcePartDocs.Add(oExit) If oFFN_SourcePartDocs.Count > 0 Then ' Start transaction Dim trans As Transaction = ThisApplication.TransactionManager.StartTransaction(oPartDoc, oName_Rule) ' Derive in each specified part Dim failedParts As New List(Of String) Dim oFound_New As String = "No" Dim oFound_Old As String = "No" Dim oFFN_SourcePartDoc_New As New ArrayList For Each oFFN_CurrRefDoc In oFFN_CurrRefDocs L_oFFN_CurrRefDoc : ' MessageBox.Show("oFFN_SourcePartDocs.Count @ TOP: " & oFFN_SourcePartDocs.Count, "oFFN_SourcePartDocs") For Each oFFN_SourcePartDoc As String In oFFN_SourcePartDocs oIndex_Source = oFFN_SourcePartDocs.IndexOf(oFFN_SourcePartDoc) If oFFN_SourcePartDoc = oFFN_CurrRefDoc Then '.Contains(oLFN_CurrRefDoc) Then ' InventorVb.DocumentUpdate() ' MessageBox.Show("Case: Existing! " _ ' & vbLf & "" _ ' & vbLf & "oFFN SourcePartDoc" _ ' & vbLf & "" & oFFN_SourcePartDoc _ ' & vbLf & "" _ ' & vbLf & "oLFN_CurrRefDoc: " _ ' & vbLf & "" & oFFN_CurrRefDoc _ ' & vbLf & "" _ ' & vbLf & "", "Source vs. Current " & oName_Rule) oFFN_SourcePartDocs.Remove(oFFN_SourcePartDocs(oIndex_Source)) GoTo L_oFFN_CurrRefDoc Else ' MessageBox.Show("Case: Not Existing! " _ ' & vbLf & "" _ ' & vbLf & "oFFN SourcePartDoc: " _ ' & vbLf & "" & oFFN_SourcePartDoc _ ' & vbLf & "" _ ' & vbLf & "oLFN_CurrRefDoc: " _ ' & vbLf & "" & oFFN_CurrRefDoc _ ' & vbLf & "" _ ' & vbLf & "", oName_Rule) End If Next oFFN_SourcePartDoc Next oFFN_CurrRefDoc L_oDoc_toInsert: oDoc_toInsert = InputListBox("Prompt", oFFN_SourcePartDocs, "", Title := oName_Rule, ListName := "List") If oDoc_toInsert = "" Then GoTo L_oDoc_toInsert : If oDoc_toInsert = oExit Then Exit Sub If oDoc_toInsert = oOther Then L_Retry: oDoc_toInsert = InputBox("Prompt", "Title", "TYPE IN Full File name (inclusing ext)") If oDoc_toInsert = "" Then GoTo L_Retry End If End If oCreate_DP(oDoc_toInsert, oName_Rule) InventorVb.DocumentUpdate() iLogicVb.UpdateWhenDone = True 'Set Definition back, so DerivedPart Document is updated End Sub Sub oCreate_DP(oDoc_toInsert, oName_Rule) ' Get current part document (the "recipient" part) Dim oPartDoc As PartDocument = ThisDoc.Document ' Set reference to Derived Part Components manager for recipient part Dim oRefDerivedComps_ThisDoc As DerivedPartComponents = oPartDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents ' Start transaction Dim trans As Transaction = ThisApplication.TransactionManager.StartTransaction(oPartDoc, oName_Rule) ' Derive in each specified part Dim failedParts As New List(Of String) If IO.File.Exists(oDoc_toInsert) Then Dim derivedPartDef As DerivedPartUniformScaleDef Try ' Create definition for derived part. derivedPartDef = oRefDerivedComps_ThisDoc.CreateUniformScaleDef(oDoc_toInsert) Catch ex As Exception failedParts.Add("- '" & oDoc_toInsert & "': Error creating derive definition: '" & ex.Message & "'") ' Continue For End Try Try ' Set up the Derive. 'derivedPartDef.IncludeAll 'derivedPartDef.IncludeAllSolids = True Catch ex As Exception failedParts.Add("- '" & oDoc_toInsert & "': Error setting up derive: '" & ex.Message & "'") ' Continue For End Try Try ' Create Derive feature. oRefDerivedComps_ThisDoc.Add(derivedPartDef) Catch ex As Exception failedParts.Add("- '" & oDoc_toInsert & "': Error creating derive feature: '" & ex.Message & "'") End Try Else failedParts.Add("- '" & oDoc_toInsert & "File does not exist!") End If If oDoc_toInsert = "" Then trans.Abort Else trans.End End If If failedParts.Count > 0 Then MessageBox.Show("The following parts could not be Derived:" & vbCr & vbCr & String.Join(vbCr, failedParts), oName_Rule, MessageBoxButtons.OK, MessageBoxIcon.Exclamation) End If 'Else ' MessageBox.Show("Must provide at least one Part to derive in.", oName_Rule, MessageBoxButtons.OK, MessageBoxIcon.Information) 'End If End Sub