Copy Component (Derived) and Replace

[Peterjan.Schakel]

I am looking for a solution which will function as the 'normal' Copy component feature in an assembly.

However i would like to optimize this so i can change the name & material and copy the drawing with this operation in one.

Rule Should work as follow:

1. Select a/or multiple components in a assembly.

2. Create new part with derived component (selected Component).

3. save new part and replace in assembly

I have a rule running for now which functions as mentioned above, howeever by following this route the geometry of the new part doesn't correspondend. replacing the new part will result in a loss of constraints (and attached drawing is quit useless since these references are lost as well).

My rule for now is as following, (p.s. i am not a structured programmer so don't blame me on that ;))

Hope you guys can help me!

AddReference "Autodesk.Connectivity.WebServices.dll"
Imports ACW = Autodesk.Connectivity.WebServices
AddReference "Autodesk.DataManagement.Client.Framework.Vault.dll"
AddReference "Autodesk.DataManagement.Client.Framework.dll"
Imports VDF = Autodesk.DataManagement.Client.Framework
AddReference "Connectivity.Application.VaultBase.dll"
Imports VB = Connectivity.Application.VaultBase
'set a reference to the assembly component definintion.
'this assumes an assembly document is open.

Sub main
	Dim oAsmCompDef As AssemblyComponentDefinition
	Try
		oAsmCompDef = ThisApplication.ActiveDocument.ComponentDefinition
	Catch
		MessageBox.Show("Rule can only be Executed from an assembly.", "iLogic")
		Return
	End Try

	Dim Activedoc As Document
	Activedoc = ThisApplication.ActiveDocument
	'Create collection To hold selected Components
	Dim oSelected As ObjectCollection
	oSelected = ThisApplication.TransientObjects.CreateObjectCollection

	Dim oCount As Integer
	oCount = Activedoc.SelectSet.Count

	If oCount = 0 Then
		MessageBox.Show("Please select a component before running this rule.", "iLogic")
		Return
	Else
	End If

	Dim i As Long
	For i = 1 To oCount

		If Activedoc.SelectSet.Item(i).Type = ObjectTypeEnum.kComponentOccurrenceObject Then
			'Activedoc.SelectSet.Item(i).type
			oSelected.Add(Activedoc.selectSet.Item(i))
		End If
	Next

	'question = MessageBox.Show("Do you want To create a New assembly", "iLogic", MessageBoxButtons.YesNo, MessageBoxIcon.Exclamation)
	'If question = vbYes Then

	'Else
	'End If

	Dim doc As Document
	Dim CurFileName As String
	Dim NewFileName As String
	Dim oUParams As UserParameters = oAsmCompDef.Parameters.UserParameters
	Dim oType As UserParameter
	'oOccurrence = ThisDoc.Document.SelectSet.Item(1)
	Try
		oType = oUParams.Item("MaterialType")
	Catch
		oType = oUParams.AddByValue("MaterialType", "", UnitsTypeEnum.kTextUnits)
		oType.IsKey = True
		MultiValue.SetValueOptions(True, 0)
		MultiValue.UpdateAfterChange = True
		oType = oUParams.Item("MaterialType")
	End Try

	'MsgBox(oType.Value)
	MultiValue.SetList("MaterialType", "S235JR (1.0038) / DC01 (1.0330)", "AISI 304 (1.4301)", "AISI 316 (1.4401)", "ALMG3 (3.3535)")
	iLogicForm.ShowGlobal("Create Derived Parts Materials")

	Try
		oTypeSimple = oUParams.AddByValue("MaterialTypesimple", "", UnitsTypeEnum.kTextUnits)
	Catch
	End Try


	oTypeSimple = oUParams.Item("MaterialTypesimple")
	oTypeSimple.IsKey = True

	If oType.Value = "AISI 304 (1.4301)" Then
		oTypeSimple.Value = "304"
	Else If oType.Value = "AISI 316 (1.4401)" Then
	oTypeSimple.Value = "316"
	Else If oType.Value = "ALMG3 (3.3535)" Then
	oTypeSimple.Value = "ALMG3"
	Else If oType.Value = "S235JR (1.0038)/ DC01 (1.0330)" Then

	End If

	For Each oItem In oSelected
		doc = oItem.Definition.Document
		If doc.DocumentType <> kPartDocumentObject Then
			MessageBox.Show("Assemblys can not be run through this rule, component will be skipped", "iLogic")
			'GoTo handler1
		End If
	Next

	'Handler1 :
	'Dim i As Long
	'For i = 1 To oCount
	For Each oItem In oSelected

		'oOccurrence = ThisDoc.Document.SelectSet.Item(i)
		doc = oItem.Definition.Document
		
		Dim oCustomprops As Inventor.PropertySet = doc.PropertySets.Item("Inventor user defined properties")
		Try
			oThickness = oCustomprops.Item("Thickness").Value
		Catch
		End Try

		If oType.Value = "S235JR (1.0038) / DC01 (1.0330)" Then
			If oThickness < 4 Then
				oType.Value = "DC01 (1.0330)"
				oTypeSimple.Value = "DC01"
			Else
				oType.Value = "S235JR (1.0038)"
				oTypeSimple.Value = "S235JR"
			End If
		End If

		modelFullFileName = doc.fullfilename
		modelDirectoryName = IO.Path.GetDirectoryName(modelFullFileName)
		modelFileName = IO.Path.GetFileName(modelFullFileName)
		modelFileNamewithoutextentionsion = IO.Path.GetFileNameWithoutExtension(modelFullFileName)
		'modelFullFileNamewithoutextentionsion = modelFullFileName
		
		fullnewname = modelDirectoryName & "\" & modelFileNamewithoutextentionsion & "-" & oTypeSimple.Value & ".ipt"
		
		' MsgBox(fullnewname)
		'NewFileName = modelFileName & "-" & oTypeSimple.Value

		'MsgBox(modelFullFileNamewithoutextentionsion)

		If System.IO.File.Exists(fullnewname) Then
	 		GoTo handler99
		End If  

		If doc.DocumentType <> kPartDocumentObject Then Return

		CurFullFileName = doc.FullFileName
		'MsgBox(CurFullFileName)
		Dim oApp As Inventor.Application = ThisApplication
		'MsgBox("1")
		'Exit Sub

		Dim docfullfilename As String = doc.FullFileName
		Dim docfilename As String = RPointToBackSlash(doc.FullFileName)

		'Alle Zeichnungen aus dem Vault abrufen
		'Auf Vault-Connection zugreifen und ggf. rausgehen
		Dim mVltCon As VDF.Vault.Currency.Connections.Connection = VB.ConnectionManager.Instance.Connection
		If mVltCon Is Nothing Then Exit Sub
		'Auf ACW-PropertyDefininition Status zugreifen
		Dim filePropDefs As ACW.PropDef() = mVltCon.WebServiceManager.PropertyService.GetPropertyDefinitionsByEntityClassId("FILE")
		Dim ACWNamePropDef As ACW.PropDef
		For Each def As ACW.PropDef In filePropDefs
			If def.DispName = "Name" Then
				ACWNamePropDef = def
				Exit For
			End If
		Next def
		'Suchoptionen festlegen
		Dim namesucheoptionen As New ACW.SrchCond() With { _
		.PropDefId = ACWNamePropDef.Id, _
		.PropTyp = ACW.PropertySearchType.SingleProperty, _
		.SrchOper = 1, _
		.SrchRule = ACW.SearchRuleType.Must, _
		.SrchTxt = docfilename & " idw" _
		}

		Dim bookmark As String = String.Empty
		Dim status As ACW.SrchStatus = Nothing
		Dim results As ACW.File() = mVltCon.WebServiceManager.DocumentService.FindFilesBySearchConditions(New ACW.SrchCond() {namesucheoptionen }, Nothing, Nothing, False, True, bookmark, status)

		Dim settings As New VDF.Vault.Settings.AcquireFilesSettings(mVltCon)
		If results Is Nothing Then
			MessageBox.Show("Voor tekening " & docfilename & " is geen tekening voorhanden.", "Info")
			GoTo handler1
		Else
			For Each res In results
				Dim oFileIteration As VDF.Vault.Currency.Entities.FileIteration = New VDF.Vault.Currency.Entities.FileIteration(mVltCon, res)
				settings.OptionsRelationshipGathering.FileRelationshipSettings.IncludeRelatedDocumentation = True
				settings.OptionsRelationshipGathering.FileRelationshipSettings.VersionGatheringOption = VDF.Vault.Currency.VersionGatheringOption.Latest
				settings.AddFileToAcquire(oFileIteration, VDF.Vault.Settings.AcquireFilesSettings.AcquisitionOption.Download)
			Next
		End If
		Dim aquiresults As VDF.Vault.Results.AcquireFilesResults = mVltCon.FileManager.AcquireFiles(settings)

		'Alle heruntergeladenen idw's in Liste
		Dim idwList As New ArrayList
		For Each aquiresult As VDF.Vault.Results.FileAcquisitionResult In aquiresults.FileResults
			Dim aquiresultpath As String = aquiresult.LocalPath.FullPath
			If UCase(aquiresultpath).Contains(".IDW") Then
				idwList.Add(aquiresultpath)
			End If
		Next

		'oText = idwList(i)
		'msgbox(idw)
		'idw's öffnen

		For Each idw As String In idwList
			'oApp.Documents.Open(idw, True)
			oApp.Documents.Open(idw, True)
		Next

		Dim oDrawingDoc As DrawingDocument = ThisApplication.ActiveDocument
Handler1:
		Dim oSummeryprops As Inventor.PropertySet = doc.PropertySets.Item("Inventor Summary Information")
		Try
			otitle = oSummeryprops.Item("Title").Value
			'MsgBox(otitle)
		Catch
			exit sub
		End Try
		Try
			oArticleGroup = oCustomprops.Item("Article Group").Value
		Catch
		End Try
		Try
			oArticlesubGroup = oCustomprops.Item("Article SubGroup").Value
		Catch
		End Try
		Try
			oProductionLocation = oCustomprops.Item("Production Location").Value
		Catch
		End Try
		Try
			oPallet = oCustomprops.Item("Pallet").Value
		Catch
		End Try

		Try
			oPalletPE = oCustomprops.Item("PalletPE").Value
		Catch
		End Try

		Try
			oThickness = oCustomprops.Item("Thickness").Value
		Catch
		End Try

		Dim oPartDoc As PartDocument
		oPartDoc = ThisApplication.Documents.Add(kPartDocumentObject, "C:\Workspace\Settings\2022\Inventor\Templates\Sheet Metal.ipt", True)
		'(kPartDocumentObject, ThisApplication.FileManager.GetTemplateFile(kPartDocumentObject)) 
				
		Dim oDerPartDoc As PartDocument
		oDerPartDoc = ThisApplication.ActiveDocument
		'Dim oDef As PartComponentDefinition
		'oDef = oDerPartDoc.ComponentDefinition

		'materiaal is nu nog DC01 --> default
		'		Dim oAsset As Asset
		'		Dim oAssets As Assets
		'		al = ThisApplication.AssetLibraries.Item("Metagro Sheet Metal")
		'			For Each oAsset In al.MaterialAssets
		'				If oAsset.DisplayName = oType Then
		'					oNewMaterial = ThisApplication.AssetLibraries.Item("Metagro Sheet Metal").MaterialAssets.Item(oType)
		'					MsgBox(oNewMaterial.Name)
		'				End If
		'				Next
		'MsgBox(oType)
		Dim oPartMat As MaterialAsset
		Dim AssetLibs As AssetLibraries = ThisApplication.AssetLibraries
		Dim AssetLib As AssetLibrary
		For Each AssetLib In AssetLibs
			Dim oMaterialAssets As AssetsEnumerator = AssetLib.MaterialAssets
			Dim oMaterial As MaterialAsset
			For Each oMaterial In oMaterialAssets
				If oMaterial.DisplayName = oType.Value Then
					oPartMat = oMaterial
					Exit For
				End If
			Next
		Next

		'oDerPartDoc.ActiveMaterial = oPartMat

		Dim oDerPartDocdef As PartComponentDefinition
		oDerPartDocdef = ThisApplication.ActiveDocument.ComponentDefinition
		Dim oParams As Parameters = oDerPartDocdef.Parameters

		Dim oPartDocument As Inventor.PartDocument
		oPartDocument = ThisApplication.ActiveDocument
		Dim oSheetMetalComp As Inventor.SheetMetalComponentDefinition
		oSheetMetalComp = oPartDocument.ComponentDefinition

		Dim Outputsample As String = (oType.Value.ToString & " - " & oThickness & "mm")
		
		Dim oStyle As SheetMetalStyle
		For Each oStyle In oSheetMetalComp.SheetMetalStyles
			If oStyle.Name = Outputsample Then	
				Exit For
			End If
		Next
'MsgBox(oSheetMetalComp.ActiveSheetMetalStyle.Name)
oSheetMetalComp.ActiveSheetMetalStyle.Name = Outputsample
'MsgBox(oSheetMetalComp.ActiveSheetMetalStyle.Name)
'Exit Sub
		Try
			
	
			'MsgBox(Outputsample)
			'MsgBox(SheetMetal.GetActiveStyle)
			'msgbox(SheetMetal.GetActiveStyle.tostring)
			'SheetMetal.SetActiveStyle(Outputsample)
			'oSheetMetalComp.SheetMetalStyles.Item
			'SheetMetal.SetActiveStyle("DC01 (1.0330) - 2.5mm")
			
			'EXIT SUB
			'oPartDocument.Update2(True)
			oSheetMetalComp.UseSheetMetalStyleMaterial = True
			oSheetMetalComp.UseSheetMetalStyleThickness = True
			oSheetMetalComp.UseSheetMetalStyleUnfoldMethod = True
			ThisApplication.StatusBarText = "Sheet Metal Rule Successfully Changed..."
		Catch
			'doc.Parent.ErrorManager.Messages
			Question = MessageBox.Show("Failed to update the following sheet metal part without errors: " & vbLf & vbLf & oPartDocument.FullFileName & "." & vbLf & vbLf &
			"1) Please check there is a sheet metal rule called '" & SheetRuleSelection & "' available in these parts" & _
			" and spelled correctly!" & vbLf & _
			"2) Please check that the sheet metal rule can be applied manually without an error occurring" & vbLf & vbLf & "Do you want to open the 'Sheet Metal Defaults'", "Error on Update Sheetmetalrule", MessageBoxButtons.YesNo, MessageBoxIcon.Exclamation)
			If Question = vbYes Then
				ThisApplication.CommandManager.ControlDefinitions.Item("SheetMetalStylesCmd").Execute2(False)
			Else
			End If

		End Try

		iLogicVb.UpdateWhenDone = True


		''''///
		'''		Dim oDef As PartDocument
		'''		Dim oPart As ComponentOccurrence
		'''	   ' oDef = oDerPartDoc.Definition.Document	
		'''		Dim oMaterialAssets As AssetsEnumerator
		'''		oMaterialAssets = oDerPartDoc.MaterialAssets
		'''		Dim oAsset As Asset

		'''		Dim oAsset_Array As New ArrayList
		'''		For Each oAsset_Array_X In ThisApplication.ActiveMaterialLibrary.MaterialAssets
		'''			oAsset_Array.Add(oAsset_Array_X.DisplayName)
		'''			oAsset_Array.Sort()
		'''		Next
		'''		'present the user with the list to choose from
		'''		100:
		'''		'oAsset_Array_Selected = InputListBox("CHOOSE TEXTURE FROM ABOVE LIST", oAsset_Array, oAsset_Array.Item(0), "TEXTURE SELECTION", "LIST OF TEXTURES")
		'''		'If oAsset_Array_Selected = "" Then GoTo 100:
		'''		oDerPartDoc.ComponentDefinition.Material = oDef.Materials.Item(oType)
		'''		'(oAsset_Array_Selected)
		'''		iLogicVb.UpdateWhenDone = True	

		'	oDerPartDoc.ActiveMaterial = oNewMaterial

		Dim oDerivedCustomprops As Inventor.PropertySet = oDerPartDoc.PropertySets.Item("Inventor user defined properties")
		Dim oDerivedSummeryprops As Inventor.PropertySet = oDerPartdoc.PropertySets.Item("Inventor Summary Information")

		'MsgBox(otitle)

		oDerPartDoc.PropertySets.Item("Inventor Summary Information").Item("Title").Value = otitle
		'oNewParttitle = oDerivedSummeryprops.Item("Title").Value

		'oNewPartArticleGroup = oDerivedCustomprops.Item("Article Group").Value 
		oDerPartDoc.PropertySets.Item("Inventor user defined properties").Item("Article Group").Value = oArticleGroup
		oDerPartDoc.PropertySets.Item("Inventor user defined properties").Item("Article SubGroup").Value = oArticlesubGroup
		oDerPartDoc.PropertySets.Item("Inventor user defined properties").Item("Production Location").Value = oProductionLocation
		oDerPartDoc.PropertySets.Item("Inventor user defined properties").Item("Pallet").Value = oPallet
		oDerPartDoc.PropertySets.Item("Inventor user defined properties").Item("Thickness").Value = oThickness
		Try
			oDerPartDoc.PropertySets.Item("Inventor user defined properties").Item("PalletPE").Value = oPalletPE
		Catch
		End Try


		Dim oDerivedPartDef As DerivedPartUniformScaleDef
		oDerivedPartDef = oPartDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.CreateUniformScaleDef(CurFullFileName)
		
		oDerivedPartDef.ScaleFactor = 1
		'oDerivedPartDef.MirrorPlane = 27393 
		oDerivedPartDef.UseColorOverridesFromSource = False
		'oDerivedPartDef.
		oPartDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Add(oDerivedPartDef)

		NewFileName = (oitem.Name)' & "S235JR")
		'msgbox(doc.FullDocumentName)
		'oDerPartDoc.m

		aPath = CurFullFileName
		If Not aPath = "" Then aPath = Left(aPath, InStrRev(aPath, "\"))
		Dim sFilePath As String = aPath

		modelFullFileName = doc.FullFileName
		' modelDirectoryName = IO.Path.GetDirectoryName(modelFullFileName)
		modelFileName = IO.Path.GetFileName(modelFullFileName)
		modelFileNamewithoutextentionsion = IO.Path.GetFileNameWithoutExtension(modelFullFileName)


		'MsgBox(sFilePath & modelFileNamewithoutextentionsion & "-SS304" & ".ipt")
		NewFileName = modelFileNamewithoutextentionsion & "-" & oTypeSimple.Value
		'oPartDoc.ActiveMaterial.
		'msgbox(NewFileName)
		'results = mVltCon.WebServiceManager.DocumentService.FindFilesBySearchConditions(New ACW.SrchCond() {namesucheoptionen }, Nothing, Nothing, False, True, bookmark, status)
		Try
		'file already exists
		oPartDoc.SaveAs(sFilePath & NewFileName & ".ipt", False)
		Catch
		End Try
			If results Is Nothing Then
			' MessageBox.Show("Voor tekening " & docfilename & " is geen tekening voorhanden.", "Info")
			GoTo handler2
		End If
		
		Try
		oDrawingDoc.SaveAs(sFilePath & NewFileName & ".idw", False)
		
		Dim oFD As FileDescriptor
		oDrawingDoc.Activate
		oDrawingDoc.File.ReferencedFileDescriptors.Item(1).ReplaceReference(sFilePath & NewFileName & ".ipt")
		'oFD = oDrawingDoc.ReferencedDocuments.Item(1)
		'ReferencedDocumentDescriptors(1).DocumentDescriptor.ReferencedFileDescriptor
		'	oFD.ReplaceReference(sFilePath & modelFileNamewithoutextentionsion & "-SS304" & ".ipt")
		oDrawingDoc.Close
		Catch
		End Try
handler2:
		oPartDoc.Close
		
		'Set a reference To the transient geometry Object.

		Dim oTG As TransientGeometry
		oTG = ThisApplication.TransientGeometry
		' Create a  placement matrix
		Dim oMatrix As Matrix
		oMatrix = oTG.CreateMatrix
		'set the matrix coordinates
		oMatrix.SetTranslation(oTG.CreateVector(3, 2, 1))
Handler99:
		' Add a new occurrence of the derived part to the assembly

		'Replace the originally selected part With the derived part
		'note: True = Replace All
		oItem.Replace(fullnewname, False)
		'sFilePath & NewFileName & ".ipt", False)
		
		
	Next

End Sub

Function RPointToBackSlash(ByVal strText As String) As String
	strText = Left(strText, InStrRev(strText, ".") -1)
	RPointToBackSlash = Right(strText, Len(strText) -InStrRev(strText, "\"))
End Function