Copy a 3D sketch from one part to another part (iLogic)

[jaconoorland45]

I have an assembly.

In this assembly i have part "X" which contains a 3d sketch called "Base" with a 3d line in it. Then I want an ilogic rule to copy this 3d sketch called "Base" with the 3d line, and paste it in another part called  to another part called "Y".

I have tried many different approaches with Ilogic but nothing works. 

Is it possible to do?

I have Inventor 2023

Thanks in advance!

[Ivan_Sinicyn · Accepted solution]

Hi,

Here's the simplest and most primitive way.

Sub Main()
    ' --- Configurator (Settings) ---
    ' Component name segments for search
    Dim searchX As String = "X"          ' Name segment for part X (e.g., "X" or "PartX")
    Dim searchY As String = "Y"          ' Name segment for part Y (e.g., "Y" or "PartY")
    
    ' Name of the 3D sketch to copy
    Dim sketchToCopy As String = "Base"  ' Sketch name in part X
    
    ' Settings for renaming the pasted sketch
    Dim renameSketch As Boolean = True   ' Rename the sketch? True - yes, False - no
    Dim newSketchName As String = "Base" ' New name for the sketch in part Y (if renameSketch = True)
    
    ' --- Main Code ---
    ' Get the active assembly
    Dim oAsmDoc As AssemblyDocument
    oAsmDoc = ThisApplication.ActiveDocument
    
    ' Variables for parts
    Dim oPartX As PartDocument
    Dim oPartY As PartDocument
    
    ' Find parts X and Y in the assembly
    For Each oComp As ComponentOccurrence In oAsmDoc.ComponentDefinition.Occurrences
        If oComp.Name.Contains(searchX) Then
            oPartX = oComp.Definition.Document
        ElseIf oComp.Name.Contains(searchY) Then
            oPartY = oComp.Definition.Document
        End If
    Next
    
    ' Check if both parts are found
    If oPartX Is Nothing Or oPartY Is Nothing Then
        MsgBox("Could not find part with '" & searchX & "' or '" & searchY & "' in the assembly.")
        Exit Sub
    End If
    
    ' Switch to part X and copy the 3D sketch
    Copy3DSketchFromPartX(oPartX, sketchToCopy)
    
    ' Switch to part Y, paste, and rename the 3D sketch if needed
    PasteAndRename3DSketchInPartY(oPartY, renameSketch, newSketchName)
End Sub

Sub Copy3DSketchFromPartX(oPartX As PartDocument, sketchToCopy As String)
    ' Activate part X
    ThisApplication.Documents.Open(oPartX.FullFileName, True)
    
    Dim oPartDef As PartComponentDefinition
    oPartDef = oPartX.ComponentDefinition
    
    ' Find the 3D sketch by the specified name
    Dim oSketch As Sketch3D
    For Each oSketch In oPartDef.Sketches3D
        If oSketch.Name = sketchToCopy Then
            ' Select the sketch
            oPartX.SelectSet.Clear
            oPartX.SelectSet.Select(oSketch)
            ' Copy to clipboard
            ThisApplication.CommandManager.ControlDefinitions.Item("AppCopyCmd").Execute
            Exit For
        End If
    Next
End Sub

Sub PasteAndRename3DSketchInPartY(oPartY As PartDocument, renameSketch As Boolean, newSketchName As String)
    ' Activate part Y
    ThisApplication.Documents.Open(oPartY.FullFileName, True)
    
    Dim oPartDef As PartComponentDefinition
    oPartDef = oPartY.ComponentDefinition
    
    ' Count the number of 3D sketches before pasting
    Dim sketchCountBefore As Integer
    sketchCountBefore = oPartDef.Sketches3D.Count
    
    ' Paste the sketch from clipboard
    ThisApplication.CommandManager.ControlDefinitions.Item("AppPasteCmd").Execute
    
    ' Wait for document update
    oPartY.Update
    
    ' Check if a new sketch has been added
    If oPartDef.Sketches3D.Count > sketchCountBefore Then
        ' Get the last added sketch
        Dim oNewSketch As Sketch3D
        oNewSketch = oPartDef.Sketches3D.Item(oPartDef.Sketches3D.Count)
        
        ' Rename if required
        If renameSketch Then
            oNewSketch.Name = newSketchName
        End If
    Else
        MsgBox("Failed to paste the 3D sketch into part Y.")
    End If
    
    ' Update the document
    oPartY.Update
End Sub

[jaconoorland45]

Wow this works perfectly. Thank you for the quick reply!