How do I copy a selection of objects to another part?

[Anonymous]

I need to take an object collection from one part and copy it to another using VBA.  How do I do this?

[ekinsb]

There are potentially four approaches to this that I can think of, all of them with pros and cons.  Copying objects in Inventor is trickier than you would initially think because of the relationships between objects.  For example, what does it mean to copy a fillet feature from one part to another?  A fillet is completely dependent on a set of edges and can exist on its own.  The fillet feature is an extreme example but most objects have some relationships to other objects that need to be satisfied during a copy.

1. Derive the objects from one file into another.  This has limitations in the kinds of objects and the result is associative back to the original, which can be good or bad depending on what you're doing.

2. Use copy and paste.  The API doesn't have direct support for copy and past, but you can execute the Copy and Paste commands from the API and since they don't have any dialogs but just rely on the current selection, just executing the commands will work.

3. Create an iFeature of the desired objects and then place that in the other part.

4. Use the API to interrogate the objects of interest and then use the API to create the equivalent in the other part.

[Anonymous]

 Sorry, I guess I was looking more for what commands copy an object collection to another part.  T

Public Sub CopySolid()
    ' Open the existing sample assembly.
    Dim ptDoc As PartDocument
    Set ptDoc = ThisApplication.ActiveDocument

    Dim ptcdDef As PartComponentDefinition
    Set ptcdDef = ptDoc.ComponentDefinition
    
    Dim sbBody As SurfaceBody
    
    Dim sbsBodies As SurfaceBodies
    Set sbsBodies = ptcdDef.SurfaceBodies
    
    Dim ocGroup As ObjectCollection
    Set ocGroup = ThisApplication.TransientObjects.CreateObjectCollection
    
    Dim lngOccCount As Long
    Dim lngGroupCount As Long

    'declare and set variables to copy the occurrence's location and name
    Dim strFilePath As String
    Dim strFileName As String
    strFilePath = ptDoc.FullFileName
    strFileName = ptDoc.ComponentDefinition.Document.DisplayName
    strFilePath = Replace(strFilePath, strFileName, "")
    strFileName = Replace(strFileName, ".ipt", "")
   
    'declare and set variables for the full file name of parts to be created
    Dim strGroupFileName As String
    
    ' Create a part for each collection of solids.
    Dim pdTemp As PartDocument
    
    Dim adAssy As AssemblyDocument
    
    If sbsBodies.Count > 50 Then
        'Create and save new assembly housing the three parts
        Set adAssy = ThisApplication.Documents.Add(kAssemblyDocumentObject, _
                    ThisApplication.FileManager.GetTemplateFile _
                    (kAssemblyDocumentObject), True)
        Call adAssy.SaveAs(strFilePath & strFileName & ".iam", False)
        
        ' Set a reference to the transient geometry object.
        'Transient Geometry needed to create new position/rotation matrix
        Dim oTG As TransientGeometry
        Set oTG = ThisApplication.TransientGeometry

        ' Create a position/rotation matrix.  All positions/rotations set to origin.
        Dim oMatrix As Matrix
        Set oMatrix = oTG.CreateMatrix
        Dim lngBody As Long
        lngBody = 0
        lngOccCount = 1
        
        For Each sbBody In sbsBodies
            lngBody = lngBody + 1
            ocGroup.Add sbBody
            If lngGroupCount < 50 Then

                lngGroupCount = lngGroupCount + 1
            Else
                lngGroupCount = lngGroupCount - 49
                strGroupFileName = strFilePath & strFileName & "_" & lngOccCount & ".ipt"
                Set pdTemp = ThisApplication.Documents.Add(kPartDocumentObject, _
                            ThisApplication.FileManager.GetTemplateFile(kPartDocumentObject))
            
                Call pdTemp.SaveAs(strGroupFileName, True)
                
                Call adAssy.ComponentDefinition.Occurrences.Add(strGroupFileName, oMatrix)

                Dim coTemp As ComponentOccurrence
                Set coTemp = adAssy.ComponentDefinition.Occurrences.Item(lngOccCount)
                
                Dim oFeatureDef1 As NonParametricBaseFeatureDefinition
                Set oFeatureDef1 = pdTemp.ComponentDefinition.Features _
                                    .NonParametricBaseFeatures.CreateDefinition
                                
                oFeatureDef1.BRepEntities = ocGroup
                oFeatureDef1.OutputType = kSolidOutputType
                oFeatureDef1.TargetOccurrence = coTemp
                
                Dim oBaseFeature1 As NonParametricBaseFeature
                Set oBaseFeature1 = oPartDef1.Features. _
                                    NonParametricBaseFeatures.AddByDefinition(oFeatureDef1)
                
                Call pdTemp.Save
                
                pdTemp.Close (True)
                lngOccCount = lngOccCount + 1
            End If
            ocGroup.Clear
        Next sbBody
    End If
    Call adAssy.Close
End Sub

This is my code so far.  I'm trying to divide a 1500 solid part into an assy w/ 30 occurrences of 50 solids each.  All the solids are dumb and imported via step.  I'm having trouble running code on a part w/ so many solids so I need a routine that breaks it up into smaller pieces that don't cause the computer to come to a screeching halt. 

[Anonymous]

When the code gets to adding the feature i get error 424.  I assumed it's because I tried to copy a collection of solids rather than each individually.  I was hoping there was an easier way than copying each solid individually.

[ekinsb · Accepted solution]

If you want individual bodies in the result then you will need to create a NonParametricBaseFeature object for each body.  That's what's nice about automating what you're doing though because even though the program is doing more work the work for you is just a few more lines of code.

I don't believe Inventor supports multiple bodies being created by a single base feature.  Playing around in the UI I'm not able to do it, and the API doesn't support it.

[Anonymous]

Thanks

[Anonymous]

Public Sub CreateAssy()

    ThisApplication.SilentOperation = True
    ' Open the existing sample assembly.
    Dim ptDoc As PartDocument
    Set ptDoc = ThisApplication.ActiveDocument

        ' Set a reference to the transient geometry object.
        'Transient Geometry needed to create new position/rotation matrix
        Dim oTG As TransientGeometry
        Set oTG = ThisApplication.TransientGeometry

        ' Create a position/rotation matrix.  All positions/rotations set to origin.
        Dim oMatrix As Matrix
        Set oMatrix = oTG.CreateMatrix
        
    Dim ptcdDef As PartComponentDefinition
    Set ptcdDef = ptDoc.ComponentDefinition
    
    'declare and set variables to copy the occurrence's location and name
    Dim strFilePath As String
    Dim strFileName As String
    strFilePath = ptDoc.FullFileName
    strFileName = ptDoc.ComponentDefinition.Document.DisplayName
    strFilePath = Replace(strFilePath, strFileName, "")
    strFileName = Replace(strFileName, ".ipt", "")
   
    'declare and set variables for the full file name of parts to be created
    Dim strGroupFileName As String
    
    Dim sbBody As SurfaceBody
    
    Dim sbsBodies As SurfaceBodies
    Set sbsBodies = ptcdDef.SurfaceBodies
    
    Dim ocGroup As ObjectCollection
    Set ocGroup = ThisApplication.TransientObjects.CreateObjectCollection
    
    Dim lngOccCount As Long
    Dim lngGroupCount As Long
    
    ' Create a part for each collection of solids.
    Dim pdTemp As PartDocument
    
    Dim adAssy As AssemblyDocument
    Dim coBase As ComponentOccurrence
    Dim coCopy2 As ComponentOccurrence
    
    If sbsBodies.Count > 50 Then
        'Create and save new assembly housing the three parts
        Set adAssy = ThisApplication.Documents.Add(kAssemblyDocumentObject, _
                    ThisApplication.FileManager.GetTemplateFile _
                    (kAssemblyDocumentObject), True)
        Call adAssy.SaveAs(strFilePath & strFileName & ".iam", False)
        Call adAssy.ComponentDefinition.Occurrences.Add(ptDoc.FullFileName, oMatrix)
        Set coBase = adAssy.ComponentDefinition.Occurrences.Item(1)
        
        Dim lngPtCount As Long
        lngPtCount = CLng(Fix(sbsBodies.Count / 50))
        
        Dim lngCount As Long
        
        For lngOccCount = 1 To lngPtCount
            strGroupFileName = strFilePath & strFileName & "_" & lngOccCount & ".ipt"
            
            Set pdTemp = ThisApplication.Documents.Add(kPartDocumentObject, _
                        ThisApplication.FileManager.GetTemplateFile(kPartDocumentObject))
                
            Call pdTemp.SaveAs(strGroupFileName, True)
            Call adAssy.ComponentDefinition.Occurrences.Add(strGroupFileName, oMatrix)
            
            Set coCopy2 = adAssy.ComponentDefinition.Occurrences.Item(1 + lngOccCount)
            Call BodyCopy(coBase, coCopy2, lngOccCount * 50, lngOccCount * 50 - 49)
'            Call pdTemp.Save
    
            pdTemp.Close (True)
        Next lngOccCount
     adAssy.Update
    
     ThisApplication.ActiveView.Update
     
     Call adAssy.Save
     Call adAssy.Close
    End If
        

End Sub

Sub BodyCopy(coPart As ComponentOccurrence, _
                coCopyObject As ComponentOccurrence, _
                lngHigh As Long, lngLow As Long)
    
    ' Get the component definition of the base part.
    Dim baseDef As PartComponentDefinition
    Set baseDef = coPart.Definition
    
    ' Get the component definition of the base part.
    Dim pcdCopy As PartComponentDefinition
    Set pcdCopy = coCopyObject.Definition
    
    '** Create an associative surface base feature in the second part.
   
    ' Create a definition object in the context of the first part.
    Dim baseFeatureDef As NonParametricBaseFeatureDefinition
    Set baseFeatureDef = baseDef.Features.NonParametricBaseFeatures.CreateDefinition

    ' Add the body of the second part to the list of items to be copied.  Since this
    ' is getting the body from the occurrence it is actually a SurfaceBodyProxy
    ' object in the context of the assembly.
    Dim bodyColl As ObjectCollection
    Set bodyColl = ThisApplication.TransientObjects.CreateObjectCollection
    
    Dim sbTemp As SurfaceBody
    Dim lngI As Long
    Dim sbpSourceBodyProxy As SurfaceBodyProxy
    Dim baseFeature As NonParametricBaseFeature
    
    For lngI = lngLow To lngHigh

        Set sbTemp = baseDef.SurfaceBodies.Item(lngI)
        Call coPart.CreateGeometryProxy(sbTemp, sbpSourceBodyProxy)
    
        bodyColl.Add sbpSourceBodyProxy
        ' Set up the definition object.  When setting the IsAssociative flag to True, the
        ' Output type must be either a Surface or Composite.  A solid is not valid in that case.
        baseFeatureDef.BRepEntities = bodyColl
        baseFeatureDef.OutputType = kSolidOutputType
        baseFeatureDef.TargetOccurrence = coCopyObject
        'baseFeatureDef.IsAssociative = True
    
        ' Create the associative copy.

        Set baseFeature = pcdCopy.Features.NonParametricBaseFeatures.AddByDefinition(baseFeatureDef)
        
        bodyColl.Clear
    Next lngI
    


End Sub

 For anyone who can gain from it, here's what I ended up with.