Project geometry from one component to another in assembly

[malmal02122023]

Hello,

Could you help me?

I'm trying to write code that will project geometry from a component to another that is inserted into an assembly.

I select components from the assembly and their sketches with the same name (for example cut_type 1 or type 2). Then I select another component and its plane. Then you need to project the geometry from the component sketch onto the plane of another component.

The following code does not project geometry.

Thanks for the advice

Sub Main
 Dim oAsm As AssemblyDocument = ThisApplication.ActiveDocument
 Dim oAsmComp As AssemblyComponentDefinition = oAsm.ComponentDefinition
 
 Dim oOcc As ComponentOccurrence
 oOcc = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyLeafOccurrenceFilter, 
  "Select part with sketch")
 Dim oPartComp As PartComponentDefinition
 oPartComp = oOcc.Definition
 If oOcc Is Nothing Then Return
 
 Dim oSketch As Sketch = Nothing
 Dim SketchList As New ArrayList
 For Each oSketchTemp As Sketch In oPartComp.Sketches
  SketchList.Add(oSketchTemp.Name)
 Next
 If SketchList.Count = 0 Then Return
 Dim sSketch As String = InputListBox("Sketches found on the selected part", SketchList, "", 
  "Select sketch for part", "Sketch Found")
 If sSketch = "" Then Return
 oSketch = oPartComp.Sketches.Item(sSketch)
 
  Dim oOcc2 As ComponentOccurrence
 oOcc2 = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyLeafOccurrenceFilter, 
  "Select part to projected sketch to")
 Dim oPartComp2 As PartComponentDefinition
 oPartComp2 = oOcc2.Definition
 Dim WPList As New ArrayList
 For Each oWP As WorkPlane In oPartComp2.WorkPlanes
  WPList.Add(oWP.Name)
 Next
 Dim WP As String = InputListBox("Work planes found on the selected part", WPList, "", 
  "Select a work plane to create sketch", "Work Planes Found")
 If WP = "" Then Return
 Dim oWP2 As WorkPlane' = oPartComp2.WorkPlanes.Item(WP)
  oWP2 = oPartComp2.WorkPlanes.Item(WP)
 '''Dim oSketches2 As PlanarSketches = oPartComp2.Sketches
  ''???????????
Dim oSketch2 As Sketch ' = oSketches2.Add(oWP2)
 oSketch2 = oPartComp2.Sketches.Add(oWP2)
 oSketch2.Name = "New Sketch"
 PlanarSketchProxy.AddByProjectingEntity(oSketch2)
 
End Sub

[Andrii_Humeniuk · Accepted solution]

Hi @malmal02122023 . I made some changes and now the code works fine. In this case, you needed to modify the proxy sketch to successfully project geometry or other sketches. You can also learn more at the link.

Sub Main
	Dim oInvApp As Inventor.Application = ThisApplication
	Dim oAsm As AssemblyDocument = oInvApp.ActiveDocument
	Dim oAsmComp As AssemblyComponentDefinition = oAsm.ComponentDefinition
	
	Dim oOcc As ComponentOccurrence
	oOcc = oInvApp.CommandManager.Pick(SelectionFilterEnum.kAssemblyLeafOccurrenceFilter, 
	"Select part with sketch")
	If oOcc Is Nothing Then Return
	Dim oPartComp As PartComponentDefinition
	oPartComp = oOcc.Definition
	
	Dim oSketch As Sketch = Nothing
	Dim SketchList As New List(Of String)
	For Each oSketchTemp As Sketch In oPartComp.Sketches
		SketchList.Add(oSketchTemp.Name)
	Next
	If SketchList.Count = 0 Then Return
	Dim sSketch As String = InputListBox("Sketches found on the selected part", SketchList, "", 
	"Select sketch for part", "Sketch Found")
	If String.IsNullOrEmpty(sSketch) Then Return
	oSketch = oPartComp.Sketches(sSketch)
	Dim oSketchProxy As PlanarSketchProxy
	Call oOcc.CreateGeometryProxy(oSketch, oSketchProxy)
	
	Dim oOcc2 As ComponentOccurrence
	oOcc2 = oInvApp.CommandManager.Pick(SelectionFilterEnum.kAssemblyLeafOccurrenceFilter, 
	"Select part to projected sketch to")
	If oOcc2 Is Nothing Then Return
	Dim oPartComp2 As PartComponentDefinition
	oPartComp2 = oOcc2.Definition
	Dim WPList As New List(Of String)
	For Each oWP As WorkPlane In oPartComp2.WorkPlanes
		WPList.Add(oWP.Name)
	Next
	Dim WP As String = InputListBox("Work planes found on the selected part", WPList, "", 
	"Select a work plane to create sketch", "Work Planes Found")
	If String.IsNullOrEmpty(WP) Then Return
	oOcc2.Edit()
	Dim oWP2 As WorkPlane = oPartComp2.WorkPlanes(WP)
	Dim oSketch2 As Sketch = oPartComp2.Sketches.Add(oWP2)
	oSketch2.Name = "New Sketch"
	Dim oSketchProxy2 As PlanarSketchProxy
	Call oOcc2.CreateGeometryProxy(oSketch2, oSketchProxy2)
	For i As Integer = 1 To oSketchProxy.SketchEntities.Count
		oSketchProxy2.AddByProjectingEntity(oSketchProxy.SketchEntities(i))
	Next i
	oOcc2.ExitEdit(ExitTypeEnum.kExitToTop)
End Sub

[WCrihfield]

Hi @malmal02122023.  This can be a pretty complicated task to automate by code.  It involves the understanding and use of what are known as 'proxies'.  Proxies like different pieces of geometry that have been created as a copy of something in another document where the source geometry exists, and placed into the 'context' (3D coordinate space) of an assembly document, in possibly some other position and orientation from the assemblies origin than the original geometry was from the source document's origin.  Proxies only exist in assemblies, because generally all geometry in an assembly is only there because of placing components into the assembly.  All the geometry associated with those components are proxies, not the original geometry.  That concept can be pretty complicated to wrap your mind around.

One of the additional steps that you will need to incorporate into your existing code is that you need to get the proxy of the source sketch, which will be the copy of that sketch that exists within the context of the assembly.  That version of the sketch only exists within the 3D coordinate system space of the assembly, and should be in the same space as the other component within the assembly that you want to project the sketch geometry to.  Then, create a new sketch within the target component, on the WorkPlane of your choice.  Then you will need to get the proxy of that new sketch, that will exist within the assembly's context (the same context as the proxy of the source sketch).  Then you can project each of the entities in the source sketch's proxy into the proxy of the target sketch.  But just before you start projecting entities using a loop, start the 'Edit Mode' of the target component, so that the projection gets directly transferred into the definition of the target component.  Then after the end of the projection loop, you can exit the edit mode.  You enter and exit the edit mode of the component by using its ComponentOccurrence.Edit and ComponentOccurrence.ExitEdit methods.  You get access to the proxy of a component's geometry that exists within its parent assembly by using the ComponentOccurrence.CreateGeometryProxy method.  When using that method, you need to create a variable to hold the proxy object first, with no value assigned to that variable yet, you input that variable as the second input into that method, then that method sets the value for that variable for you.  The first input into that method is the original geometry object that only exists within the context of that component's definition.

Looks like I took too long typing out the explanation of what you needed to do, instead of just attempting to fix your existing code.  I have other codes for doing this process, but they do not use lists of sketch names or lists of WorkPlane names in their processes, because those InputListBox's take away from the automation benefits.

[malmal02122023]

Thank you for the clarification

[malmal02122023]

Thank you very much. The code works fine.

[malmal02122023]

Could you help me please
I would like to extrude this new sketch - make cut out
I understand that should be added a command to create a new solid and it substructng?

Sub Main
	Dim oInApp As Inventor.Application = ThisApplication
	Dim oAsm As AssemblyDocument = oInvApp.ActiveDocument
	Dim oAsmComp As AssemblyComponentDefinition = oAsm.ComponentDefinition
	
	Dim oOcc As ComponentOccurrence
	oOcc = oInvApp.CommandManager.Pick(SelectionFilterEnum.kAssemblyLeafOccurrenceFilter, 
	"Select part with sketch")
	If oOcc Is Nothing Then Return
	Dim oPartComp As PartComponentDefinition
	oPartComp = oOcc.Definition
	
	Dim oSketch As Sketch = Nothing
	Dim SketchList As New List(Of String)
	For Each oSketchTemp As Sketch In oPartComp.Sketches
		SketchList.Add(oSketchTemp.Name)
	Next
	If SketchList.Count = 0 Then Return
	Dim sSketch As String = InputListBox("Sketches found on the selected part", SketchList, "", 
	"Select sketch for part", "Sketch Found")
	If String.IsNullOrEmpty(sSketch) Then Return
	oSketch = oPartComp.Sketches(sSketch)
	Dim oSketchProxy As PlanarSketchProxy
	Call oOcc.CreateGeometryProxy(oSketch, oSketchProxy)
	
	Dim oOcc2 As ComponentOccurrence
	oOcc2 = oInvApp.CommandManager.Pick(SelectionFilterEnum.kAssemblyLeafOccurrenceFilter, 
	"Select part to projected sketch to")
	If oOcc2 Is Nothing Then Return
	Dim oPartComp2 As PartComponentDefinition
	oPartComp2 = oOcc2.Definition
	Dim WPList As New List(Of String)
	For Each oWP As WorkPlane In oPartComp2.WorkPlanes
		WPList.Add(oWP.Name)
	Next
	Dim WP As String = InputListBox("Work planes found on the selected part", WPList, "", 
	"Select a work plane to create sketch", "Work Planes Found")
	If String.IsNullOrEmpty(WP) Then Return
	oOcc2.Edit()
	Dim oWP2 As WorkPlane = oPartComp2.WorkPlanes(WP)
	Dim oSketch2 As Sketch = oPartComp2.Sketches.Add(oWP2)
	oSketch2.Name = "New Sketch"
	Dim oSketchProxy2 As PlanarSketchProxy
	Call oOcc2.CreateGeometryProxy(oSketch2, oSketchProxy2)
	For i As Integer = 1 To oSketchProxy.SketchEntities.Count
		oSketchProxy2.AddByProjectingEntity(oSketchProxy.SketchEntities(i))
	Next i
	oOcc2.ExitEdit(ExitTypeEnum.kExitToTop)
	
	Dim oDestinationOcc2 As ComponentOccurrence = oOccs2
	Dim oCompDef As PartComponentDefinition = oDestinationOcc2.Definition
	Dim oDestinationDef As PartComponentDefinition = oDestinationOcc2.Definition
	Dim profile2 = oSketch2.Profiles.AddForSolid(True)
	Dim oExtFeats As ExtrudeFeatures = oDestinationDef.Features.ExtrudeFeatures
Dim oExtrudeDef2 = oCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(profile2, PartFeatureOperationEnum.kCutOperation)
oExtrudeDef2.SetThroughAllExtent(PartFeatureExtentDirectionEnum.kNegativeExtentDirection)
Dim oExtrude2 = oCompDef.Features.ExtrudeFeatures.Add(oExtrudeDef2)
   Dim oExtFeat As ExtrudeFeature = oExtFeats.Add(oExtDef)
		
End Sub

[Andrii_Humeniuk · Accepted solution]

Hi @malmal02122023 . If I understand everything correctly, this code should work fine for you.

Sub Main
	Dim oInvApp As Inventor.Application = ThisApplication
	Dim oAsm As AssemblyDocument = oInvApp.ActiveDocument
	Dim oAsmComp As AssemblyComponentDefinition = oAsm.ComponentDefinition
	
	Dim oOcc As ComponentOccurrence
	oOcc = oInvApp.CommandManager.Pick(SelectionFilterEnum.kAssemblyLeafOccurrenceFilter, 
	"Select part with sketch")
	If oOcc Is Nothing Then Return
	Dim oPartComp As PartComponentDefinition
	oPartComp = oOcc.Definition
	
	Dim oSketch As Sketch = Nothing
	Dim SketchList As New List(Of String)
	For Each oSketchTemp As Sketch In oPartComp.Sketches
		SketchList.Add(oSketchTemp.Name)
	Next
	If SketchList.Count = 0 Then Return
	Dim sSketch As String = InputListBox("Sketches found on the selected part", SketchList, "", 
	"Select sketch for part", "Sketch Found")
	If String.IsNullOrEmpty(sSketch) Then Return
	oSketch = oPartComp.Sketches(sSketch)
	Dim oSketchProxy As PlanarSketchProxy
	Call oOcc.CreateGeometryProxy(oSketch, oSketchProxy)
	
	Dim oOcc2 As ComponentOccurrence
	oOcc2 = oInvApp.CommandManager.Pick(SelectionFilterEnum.kAssemblyLeafOccurrenceFilter, 
	"Select part to projected sketch to")
	If oOcc2 Is Nothing Then Return
	Dim oPartComp2 As PartComponentDefinition
	oPartComp2 = oOcc2.Definition
	Dim WPList As New List(Of String)
	For Each oWP As WorkPlane In oPartComp2.WorkPlanes
		WPList.Add(oWP.Name)
	Next
	Dim WP As String = InputListBox("Work planes found on the selected part", WPList, "", 
	"Select a work plane to create sketch", "Work Planes Found")
	If String.IsNullOrEmpty(WP) Then Return
	Dim oTG As Transaction = oInvApp.TransactionManager.StartTransaction(oAsm, "Create Extrude...")
	Try
		oOcc2.Edit()
		Dim oWP2 As WorkPlane = oPartComp2.WorkPlanes(WP)
		Dim oSketch2 As Sketch = oPartComp2.Sketches.Add(oWP2)
		oSketch2.Name = "New Sketch"
		Dim oSketchProxy2 As PlanarSketchProxy
		Call oOcc2.CreateGeometryProxy(oSketch2, oSketchProxy2)
		For i As Integer = 1 To oSketchProxy.SketchEntities.Count
			Try : oSketchProxy2.AddByProjectingEntity(oSketchProxy.SketchEntities(i)) : Catch : End Try
		Next i
		oOcc2.ExitEdit(ExitTypeEnum.kExitToTop)
		
		Dim oCompDef As PartComponentDefinition = oOcc2.Definition
		Dim oFeatExt As ExtrudeFeatures = oCompDef.Features.ExtrudeFeatures
		Dim profile2 = oSketch2.Profiles.AddForSolid(True)
		Dim oExtDef As ExtrudeDefinition = oFeatExt.CreateExtrudeDefinition(profile2, PartFeatureOperationEnum.kCutOperation)
		oExtDef.SetThroughAllExtent(PartFeatureExtentDirectionEnum.kSymmetricExtentDirection)
		Dim oFeat As ExtrudeFeature = oFeatExt.Add(oExtDef)
		oTG.End()
	Catch ex As Exception : MsgBox(ex.Message, MsgBoxStyle.Critical) : oTG.Abort() : End Try
End Sub

[malmal02122023]

Works great, thank you very much.
I still have one more question. 

This rule works with one selected component only. Is it possible to select several different components with the same sketch name and then transfer those sketches to the new component with extrusion?
Thanks again for the help.

[Andrii_Humeniuk · Accepted solution]

Hi @malmal02122023 . The new code allows you to cyclically select new components using the Do - Loop statement. Also, now you don't need to choose a plane on which to create a sketch. The code creates a plane corresponding to the one on which the sketch was created. I hope these changes are exactly what you need.

Sub Main
	Dim oInvApp As Inventor.Application = ThisApplication
	Dim oAsm As AssemblyDocument = oInvApp.ActiveDocument
	Dim oAsmComp As AssemblyComponentDefinition = oAsm.ComponentDefinition
	
	Dim oOcc As ComponentOccurrence
	oOcc = oInvApp.CommandManager.Pick(SelectionFilterEnum.kAssemblyLeafOccurrenceFilter, 
	"Select part with sketch")
	If oOcc Is Nothing Then Return
	Dim oPartComp As PartComponentDefinition
	oPartComp = oOcc.Definition
	
	Dim oSketch As PlanarSketch = Nothing
	Dim SketchList As New List(Of String)
	For Each oSketchTemp As Sketch In oPartComp.Sketches
		SketchList.Add(oSketchTemp.Name)
	Next
	If SketchList.Count = 0 Then Return
	Dim sSketch As String = InputListBox("Sketches found on the selected part", SketchList, "", 
	"Select sketch for part", "Sketch Found")
	If String.IsNullOrEmpty(sSketch) Then Return
	oSketch = oPartComp.Sketches(sSketch)
	Dim oSketchProxy As PlanarSketchProxy
	Call oOcc.CreateGeometryProxy(oSketch, oSketchProxy)
	Dim oWPProx As WorkPlaneProxy = Nothing
	Call oOcc.CreateGeometryProxy(oSketch.PlanarEntity, oWPProx)
	Dim oOriginPnt As Point
    Dim oXaxis, oYaxis As UnitVector
	Call oWPProx.GetPosition(oOriginPnt, oXaxis, oYaxis)
	
	Do
		Dim oOcc2 As ComponentOccurrence
		oOcc2 = oInvApp.CommandManager.Pick(SelectionFilterEnum.kAssemblyLeafOccurrenceFilter, 
		"Select part to projected sketch to")
		If oOcc2 Is Nothing Then Exit Sub
		Dim oPartComp2 As PartComponentDefinition = oOcc2.Definition
		Dim oTG As Transaction = oInvApp.TransactionManager.StartTransaction(oAsm, "Create Extrude...")
		Try
			oOcc2.Edit()
			Dim oWP As WorkPlane = oPartComp2.WorkPlanes.AddFixed(oOriginPnt, oXaxis, oYaxis)
			oWP.Visible = False
			Dim oSketch2 As Sketch = oPartComp2.Sketches.Add(oWP)
			oSketch2.Name = "New Sketch"
			Dim oSketchProxy2 As PlanarSketchProxy
			Call oOcc2.CreateGeometryProxy(oSketch2, oSketchProxy2)
			For i As Integer = 1 To oSketchProxy.SketchEntities.Count
				Try : oSketchProxy2.AddByProjectingEntity(oSketchProxy.SketchEntities(i)) : Catch : End Try
			Next i
			oOcc2.ExitEdit(ExitTypeEnum.kExitToTop)
			
			Dim oCompDef As PartComponentDefinition = oOcc2.Definition
			Dim oFeatExt As ExtrudeFeatures = oCompDef.Features.ExtrudeFeatures
			Dim profile2 = oSketch2.Profiles.AddForSolid(True)
			Dim oExtDef As ExtrudeDefinition = oFeatExt.CreateExtrudeDefinition(profile2,
													PartFeatureOperationEnum.kCutOperation)
			oExtDef.SetThroughAllExtent(PartFeatureExtentDirectionEnum.kSymmetricExtentDirection)
			Dim oFeat As ExtrudeFeature = oFeatExt.Add(oExtDef)
			oTG.End()
		Catch ex As Exception : MsgBox(ex.Message, MsgBoxStyle.Critical) : oTG.Abort() : End Try
	Loop
End Sub

[malmal02122023]

Thank you very much.