VBA Derive Part From Midsurface

[Anonymous]

Hi everyone,

I'm in the process of attempting to automate creating a derived part from a midsurface view and I'm a bit stuck. I've been able to succesfully automate creating the midsurface view, but the next step in the process I'm trying to automate is to use the "Make Part" command to create a derived part from the Midsurface Shell. 

Here's a link to exactly what I'm trying to mimic: 

https://forums.autodesk.com/t5/inventor-forum/solid-model-to-midplane-surface-model/td-p/6342966

If you open the attached parts in the reply that was labeled as the answer, the contributor (IgorMir) was somehow able to derive the secondary parts from the offset surface bodies he placed in the part (part 2 was derived from 1, 4 from 3). Not quite sure how he did that.

Unfortunately, the command used in the screencast example in the above post ("PartMakePartCmd") is not exposed to the API as far as I can tell. Because of this, I tried applying some code I found from someone else on the forums to perform the functions through the Derive family of objects. The problem with trying to use the normal Derive feature is that it can't see the Midsurface, which should be visible under Surface Bodies. It appears that this is happening because the Shells>Midsurfaces>(part name)>Midsurface tree is only available within the FEA environment. Is there any way that I could either make the Derive function aware of the items in the FEA environment or export the FEA environment shells to the main assembly? Any other suggestions on how to get the end result I'm looking for would be appreciated.

Here's the code I'm trying to use to derive the part, I've also posted a few pictures showing what I mean:

Sub MakePart()
        
    ' set a reference to the active partdocument
    Dim prt As PartDocument
    Set prt = ThisApplication.ActiveDocument

    Dim template As String
    Dim folder As String
    template = "nyb Sheet Metal"
    folder = PathName(prt.FullFileName)
    
    ' create an object collection to store the parts to put in assembly
    Dim prtCol As ObjectCollection
    Set prtCol = ThisApplication.TransientObjects.CreateObjectCollection
    
    Dim a As Integer: a = 0

    ' loop through the filtered selection
    Dim sb As SurfaceBody
    For Each sb In prt.ComponentDefinition.SurfaceBodies
    
        ' create a new part to derive the solid body in
        Dim newPart As PartDocument
        Set newPart = ThisApplication.Documents.Add(kPartDocumentObject, template, True)
        
        ' set a reference to the derivedpartcomponents
        Dim dpcs As DerivedPartComponents
        Set dpcs = newPart.ComponentDefinition.ReferenceComponents.DerivedPartComponents
                    
        ' create the scale definition
        Dim dpd As DerivedPartUniformScaleDef
        Set dpd = dpcs.CreateUniformScaleDef(prt.FullFileName)
                  
        ' set the settings in another sub
        Call settingsDerivedPart(dpd, sb)
        Call dpcs.Add(dpd)
        Call prtCol.Add(newPart)
  
        ' set the part title to the solidbodies name
        newPart.PropertySets.Item("Inventor Summary Information").Item("Title").Value = sb.Name 'sb.CreatedByFeature.Name
      
        a = a + 1

        ' Save the part
        ThisApplication.SilentOperation = True
        Call newPart.SaveAs(folder & sb.Name & "_" & a & ".ipt", False)
        ThisApplication.SilentOperation = False
        
    Next sb

    ' find opened assembly in which the sketch part is
    Dim asm As AssemblyDocument
    Set asm = ThisApplication.Documents.Add(kAssemblyDocumentObject)
    
    ' place in assembly?
    Set prt = Nothing
    For Each prt In prtCol
    
        ' create an empty matrix
        Dim mx As Matrix
        Set mx = ThisApplication.TransientGeometry.CreateMatrix()
        
        Dim occ As ComponentOccurrence
        Set occ = asm.ComponentDefinition.Occurrences.AddByComponentDefinition(prt.ComponentDefinition, mx)
        Call prt.Close(True)
        
    Next
End Sub

Function PathName(FullPath As String) As String
 
 ' return all left of last \
 PathName = Left(FullPath, InStrRev(FullPath, "\"))

End Function
Sub settingsDerivedPart(ByRef dpd As DerivedPartUniformScaleDef, sb As SurfaceBody)
   
    ' set the derive style
    'dpd.DeriveStyle = kDeriveAsSingleBodyNoSeams
    'dpd.UseColorOverridesFromSource = False
    Call dpd.ExcludeAll
    
    ' include solid, exclude the others
    Dim dpe As DerivedPartEntity
    For Each dpe In dpd.Surfaces
        If dpe.ReferencedEntity.Name = sb.Name Then
            dpe.IncludeEntity = True
        End If
    Next
        
End Sub