Thanks.
I got it around (using your guidance).
Option Explicit On
Sub Main
Dim oThisActiveDoc As PartDocument = ThisApplication.ActiveEditDocument
Dim oThisActiveDerivedDoc As PartDocument = ThisApplication.ActiveEditDocument 'Use where applicable
Dim oThisActiveDocDef As PartComponentDefinition = oThisActiveDoc.ComponentDefinition
Dim oThisActiveDerivedDocDef As PartComponentDefinition = oThisActiveDerivedDoc.ComponentDefinition 'where applicable
Dim oDP_Exists_YN As String = "NO"
If oThisActiveDoc.DocumentType <> kPartDocumentObject Then 'ThisApplication.ActiveDocument.DocumentType <> kPartDocumentObject Then
MsgBox("Make a Part Document the active document")
Exit Sub
End If
Dim sourceFullFileName As String
sourceFullFileName = "D:\Vault Workspace\Projects\A_RWEI\IEIS 10204\10204-skm0001.ipt"
sourceFullFileName = "D:\Vault Workspace\Projects\A_RWEI\SKIP-DOC0034.ipt"
' Add Derived Part Feature
oThisActiveDoc = ThisApplication.ActiveDocument
' Add Derived Part Feature
Dim oDerivedPartComps As DerivedPartComponents = oThisActiveDocDef.ReferenceComponents.DerivedPartComponents
Dim oDerPartComp_Test As DerivedPartUniformScaleDef = oDerivedPartComps.CreateUniformScaleDef(sourceFullFileName)
If oThisActiveDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Count < 1 Then
MsgBox("No Derived Part Components in this part")
Else
'Dim oDoc As Document
'oDoc = ThisDoc.Document
Dim oRefFile As FileDescriptor
Dim oOrigRefName As Object
For Each oRefFile In oThisActiveDerivedDoc.File.ReferencedFileDescriptors
'get the full file path to the original internal ref3erences
oOrigRefName = oRefFile.FullFileName
Next oRefFile
Dim oThisDerPart As DerivedPartComponent 'because this is a derived part
For Each XX In oThisActiveDerivedDocDef.ReferenceComponents.DerivedPartComponents
If oOrigRefName = sourceFullFileName Then oDP_Exists_YN = "YES"
' MessageBox.Show("oOrigRefName: " _
' & vbLf & oOrigRefName, "Title")
Next XX
' For i = 1 To oThisActiveDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Count
' MessageBox.Show("Message-2: " _
' & vbLf & oThisActiveDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Item(i).Name, "LOCAL FILE NAME!")
' Next i
End If
' Exclude all items once.
oDerPartComp_Test.ExcludeAll
' ' Include the first Solid.
' oDerPartComp_Test.Solids.Item(1).IncludeEntity = True
' ' Include the visible sketches.
' For Each entity As DerivedPartEntity In oDerPartComp_Test.Sketches
' If entity.ReferencedEntity.Visible = True Then
' entity.IncludeEntity = True
' End If
' Next entity
' Create the internal dictionary of parameters.
Dim oParamsDictionary As New System.Collections.Generic.Dictionary(Of String, DerivedPartEntity)
For Each entity As DerivedPartEntity In oDerPartComp_Test.Parameters
oParamsDictionary.Add(entity.ReferencedEntity.Name, entity)
Next entity
' Include Parameters which name is started with "Dim_".
For Each oParam_to_Include As System.Collections.Generic.KeyValuePair(Of String, DerivedPartEntity) In oParamsDictionary
If oParam_to_Include.Key.StartsWith("Dim_") Then
oParam_to_Include.Value.IncludeEntity = True
Else If oParam_to_Include.Key.StartsWith("At_Joint") Then
Try
oParam_to_Include.Value.IncludeEntity = True
Catch
End Try
End If
Next oParam_to_Include
' oParamsDictionary("Dim_1").IncludeEntity = True
' oParamsDictionary("Dim_2").IncludeEntity = True
' ' Include other parameters.
Try
oParamsDictionary("HSS_Slot_GapGusset_3d4_PL").IncludeEntity = True
Catch
End Try
Try
oParamsDictionary("HSS_Slot_Rad_Fillet").IncludeEntity = True
Catch
End Try
If oDP_Exists_YN = "NO" Then
' Add the definition and create the DerivedPartFeature.
MessageBox.Show("DP ADDED!", "Title")
Dim oDerivedPartComp As DerivedPartComponent = oDerivedPartComps.Add(oDerPartComp_Test)
End If
Dim oYesNo As String
oYesNo = MessageBox.Show("Do you want to copy custom properties?", "TO COPY CUST. PROPS", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button2)
oSub_Copy_Props(oYesNo)
iLogicVb.UpdateWhenDone = True
End Sub
Sub oSub_Copy_Props(X As String)
If X = vbYes
Dim derivedComponent As Inventor.Document = ThisApplication.ActiveDocument
'if there is only one reference:
Dim referencedComponent As Inventor.Document = derivedComponent.ReferencedDocuments(1)
Dim oProps_DerivedComp As PropertySet = derivedComponent.PropertySets.Item("Inventor User Defined Properties")
Dim oProps_ReferencedComp As PropertySet = referencedComponent.PropertySets.Item("Inventor User Defined Properties")
Dim oProp As Inventor.Property
For Each oProp In oProps_ReferencedComp
Try
oProps_DerivedComp.Add(oProp.Value, oProp.Name)
Catch ex As Exception
oProps_DerivedComp.Add(oProp.Value)
End Try
Next
End If
End Sub
