Derived assembly using Sketch blocks as the base.

[AlexFielder]

Thanks to @adam.nagy's excellent post here:

http://adndevblog.typepad.com/manufacturing/2014/06/make-components-command-implemented-via-api.html

I have been able to turn a multi-solid sheet metal part into a derived assembly but can't seem to track down an example that will work for (nested) Sketch blocks*.

The API documentation is sketchy on the subject at best so I figured it was time to ask here.

Many thanks in advance,

Alex.

*I know I can do this manually using the "Make Components" function but it will only work on solid/surface bodies or Sketch blocks, never seemingly at the same time.

[AlexFielder]

Hi all,

I have hit a snag that looks like a bug in the Inventor 2017 API or perhaps my understanding of it?

If I run this iLogic code:

' Run this inside a Multi-Solid part
Sub MakeComponentsProgrammatically(ByVal ThisPart As PartDocument, ByVal ResultsFolder As String)
    ' Folder to place the new components:
    ' assembly and subcomponents
    'Dim ResultsFolder As String = System.IO.Path.GetDirectoryName(ThisPart.FullFileName) & "\" & System.IO.Path.GetFileNameWithoutExtension(ThisPart.DisplayName) & "\"

    Dim Thispartname As String = System.IO.Path.GetFileNameWithoutExtension(ThisPart.FullFileName)
    ThisApplication.StatusBarText = ResultsFolder & " - " & Thispartname
    If Not System.IO.Directory.Exists(ResultsFolder) Then
        System.IO.Directory.CreateDirectory(ResultsFolder)
    End If

    ' Create the assembly
    Dim asm As AssemblyDocument = ThisApplication.Documents.Add(DocumentTypeEnum.kAssemblyDocumentObject)

    Call asm.SaveAs(ResultsFolder + System.IO.Path.GetFileNameWithoutExtension(ThisPart.DisplayName) + ".iam", False)

    Dim solidbody As SurfaceBody
    For Each solidbody In ThisPart.ComponentDefinition.SurfaceBodies
        If solidbody.Name.StartsWith("Solid") Then
            Continue For
        End If
        ' Create part for each body
        Dim prt As PartDocument = ThisApplication.Documents.Add(DocumentTypeEnum.kPartDocumentObject)

        ' Set iProperties >> Project >> Description
        ' It's inside "Design Tracking Properties"
        Dim p As Inventor.Property = prt.PropertySets("{32853F0F-3444-11D1-9E93-0060B03C1CA6}")("Description")
        p.Expression = solidbody.Name

        Dim dpcs As DerivedPartComponents = prt.ComponentDefinition.ReferenceComponents.DerivedPartComponents

        Dim dpd As DerivedPartUniformScaleDef = dpcs.CreateUniformScaleDef(ThisPart.FullDocumentName)

        ' Exclude the other solid bodies
        Dim dpe As DerivedPartEntity
        For Each dpe In dpd.Solids
            If Not dpe.ReferencedEntity Is solidbody Then
                dpe.IncludeEntity = False
            End If
        Next

        Call dpcs.Add(dpd)

        'DOES NOT WORK!!
        ' Could have any name but we use the solid body's name
        'if we can work out how to use the sketch blocks in this part they too need a material. which isn't one of these:
        'If solidbody.name.contains("Panel") Then
        '    SetMaterialToPart(prt, "Glass")
        'Else
        '    SetMaterialToPart(prt, "Aluminum 6061")
        'End If
        Dim newfilename As String = Regex.Replace(solidbody.Name, "([a-z](?=[A-Z])|[A-Z](?=[A-Z][a-z]))", "$1 ")

        Call prt.SaveAs(ResultsFolder + Thispartname + "-" + newfilename + ".ipt", False)

        ' Place an instance of it inside the assembly
        Dim mx As Matrix = ThisApplication.TransientGeometry.CreateMatrix()
        Call asm.ComponentDefinition.Occurrences.AddByComponentDefinition(prt.ComponentDefinition, mx)

        ' Don't need it anymore
        Call prt.Close
    Next

    Call asm.Close
End Sub

It runs just fine - a little on the slow side but the multi-body part is 16MB and has up to 40 bodies contained within.

Yet if I run this version in a .NET addin I have written that otherwise functions perfectly normally I always get an error on the second time the "for next" loop calls surfacebody.name (highlighted in red below):

' Run this inside a Multi-Solid part
        Sub MakeComponentsProgrammatically(ByVal ThisPart As PartDocument, ByVal ResultsFolder As String)
            ' Folder to place the new components:
            ' assembly and subcomponents
            'Dim ResultsFolder As String = System.IO.Path.GetDirectoryName(ThisPart.FullFileName) & "\" & System.IO.Path.GetFileNameWithoutExtension(ThisPart.DisplayName) & "\"

            Dim Thispartname As String = System.IO.Path.GetFileNameWithoutExtension(ThisPart.FullFileName)
            g_inventorApplication.StatusBarText = ResultsFolder & " - " & Thispartname
            If Not System.IO.Directory.Exists(ResultsFolder) Then
                System.IO.Directory.CreateDirectory(ResultsFolder)
            End If

            ' Create the assembly
            Dim asm As AssemblyDocument = g_inventorApplication.Documents.Add(DocumentTypeEnum.kAssemblyDocumentObject)

            Call asm.SaveAs(ResultsFolder + System.IO.Path.GetFileNameWithoutExtension(ThisPart.DisplayName) + ".iam", False)

            For Each solidbody As SurfaceBody In ThisPart.ComponentDefinition.SurfaceBodies
                Try
                    If solidbody.Name.StartsWith("Solid") Then ' errors here on the second loop through the collection in VB.NET
                        Continue For
                    End If
                Catch ex As Exception
                    Continue For
                End Try

                ' Create part for each body
                Dim prt As PartDocument = g_inventorApplication.Documents.Add(DocumentTypeEnum.kPartDocumentObject)

                ' Set iProperties >> Project >> Description
                ' It's inside "Design Tracking Properties"
                Dim p As Inventor.Property = prt.PropertySets("{32853F0F-3444-11D1-9E93-0060B03C1CA6}")("Description")
                p.Expression = solidbody.Name
                Dim newfilename As String = Regex.Replace(solidbody.Name, "([a-z](?=[A-Z])|[A-Z](?=[A-Z][a-z]))", "$1 ")

                Dim DerivedPartComponentsColl As DerivedPartComponents = prt.ComponentDefinition.ReferenceComponents.DerivedPartComponents

                Dim DerivedPartUniformScaleDefObj As DerivedPartUniformScaleDef = DerivedPartComponentsColl.CreateUniformScaleDef(ThisPart.FullDocumentName)

                ' Exclude everything
                DerivedPartUniformScaleDefObj.ExcludeAll()
                'and then only include the solidbody
                For Each DerivedPartEntityObj As DerivedPartEntity In DerivedPartUniformScaleDefObj.Solids
                    If Not DerivedPartEntityObj.ReferencedEntity Is solidbody Then
                        DerivedPartEntityObj.IncludeEntity = False
                    Else
                        DerivedPartEntityObj.IncludeEntity = True
                    End If
                Next



                Call DerivedPartComponentsColl.Add(DerivedPartUniformScaleDefObj)

                'DOES NOT WORK!!
                ' Could have any name but we use the solid body's name
                'if we can work out how to use the sketch blocks in this part they too need a material. which isn't one of these:
                'If solidbody.name.contains("Panel") Then
                '    SetMaterialToPart(prt, "Glass")
                'Else
                '    SetMaterialToPart(prt, "Aluminum 6061")
                'End If


                Call prt.SaveAs(ResultsFolder + Thispartname + "-" + newfilename + ".ipt", False)

                ' Place an instance of it inside the assembly
                Dim mx As Matrix = g_inventorApplication.TransientGeometry.CreateMatrix()
                Call asm.ComponentDefinition.Occurrences.AddByComponentDefinition(prt.ComponentDefinition, mx)

                ' Don't need it anymore
                Call prt.Close()
            Next

            Call asm.Close()
        End Sub

Can anyone shed any light on this?

EDIT: This is the code from Adam's original post, not anything to do with Sketch blocks, but since I linked to the original article I figured it would be silly to start a new thread.

[AlexFielder]

Right, so I managed to test the ilogic rule I wrote in comparison to the .NET addin and I've found that whilst the ilogic rule is able to pull out the surfacebody.name value every time, the exact replica code inside of a .NET addin fails after the first iteration through the loop every time.

It's alsmost as if there's some kind of timeout that means that the .NET addin forgets it was looking at the surfacebodies collection for this specific part file.

???

[wayne.brill]

Hi Alex,

I copied your code and got it working in this SDK sample. (I have it run your code instead of drawing the slot)

C:\Users\Public\Documents\Autodesk\Inventor 2016\SDK\DeveloperTools\Samples\VB.NET\AddIns\SimpleAddIn

I do not have Regex to get the newfilename so I am just adding an number to the solidBody.Name.

I am not getting any errors and the assembly, and three parts are created. (In my test ipt there are three solid bodies)

What is the error you are getting?

If you debug does the second solid body look ok in the VB watch window?

Can you see something different than you see with the first solid body?

Is there a name? (In my test assembly they are just Solid1, Solid2, Solid3)

If this does not help you could upload your assembly. (let me know if you want to send it to me directly).

Thanks,

Wayne

[AlexFielder]

Hi Wayne,

Apologies for not getting back to this sooner!

For whatever reason, having reinstalled my Windows 10 system all of the issues I was having with this code have disappeared.

For completeness here is the code that is currently working: (hopefully this is followed by a :spoiler: tag as there is a LOT of code!)

Spoiler

Private Sub RunCreateBalconies(Context As NameValueMap)
            Dim StartTime As DateTime
            Dim ElapsedTime As TimeSpan
            ToggleWorkfeaturesAndSketches(False)
            'check for invisible bodies since Inventor will ignore them by default.
            Dim invisiblebodies As Boolean = False
            Do While invisiblebodies = False
                For i As Integer = 1 To g_inventorApplication.ActiveDocument.ComponentDefinition.SurfaceBodies.Count
                    Dim surfacebody As SurfaceBody = g_inventorApplication.ActiveDocument.ComponentDefinition.SurfaceBodies.Item(i)
                    If surfacebody.Visible = False Then
                        invisiblebodies = True
                        Exit For
                    End If
                Next
            Loop
            Dim result As DialogResult = Nothing
            If invisiblebodies = True Then
                result = MessageBox.Show("We found invisible bodies!" & vbCrLf & "Should we stop and check this is correct before continuing?", "Found Invisible Bodies", MessageBoxButtons.YesNo)
            End If
            If result = DialogResult.Yes Then
                Exit Sub
            End If
            'check debug settings - provides ~10% speed boost if screen updating is disabled.
            If My.Settings.BalconyCreationHiddenOnScreen Then
                g_inventorApplication.ScreenUpdating = True
                g_inventorApplication.UserInterfaceManager.UserInteractionDisabled = False
            Else
                g_inventorApplication.ScreenUpdating = False
                g_inventorApplication.UserInterfaceManager.UserInteractionDisabled = True
            End If
            g_inventorApplication.SilentOperation = True
            Dim ThisDoc As PartDocument = g_inventorApplication.ActiveDocument
            Dim RootFolder As String = System.IO.Path.GetDirectoryName(ThisDoc.FullFileName) & "\"
            UpdateStatusBar("Parameter update after each parameter change is set to: " & UpdateAfterEachParameterChange.ToString)
            'Excel objects
            Dim xlApp As Excel.Application
            Dim wb As Workbook
            Dim ws As Worksheet
            Dim range As Range

            Try
                xlApp = GetOrCreateInstance("Excel.Application")
                wb = xlApp.Workbooks.Open(RootFolder & System.IO.Path.GetFileNameWithoutExtension(ThisDoc.FullFileName) & ".xlsx")
                'MessageBox.Show("Successfully opened: " & RootFolder & System.IO.Path.GetFileNameWithoutExtension(ThisDoc.FullFileName) & ".xlsx")
                ws = wb.Worksheets(1)
                range = ws.UsedRange
            Catch ex As Exception
                MessageBox.Show("Error info: " & vbNewLine & ex.ToString)
                g_inventorApplication.ScreenUpdating = True
                g_inventorApplication.UserInterfaceManager.UserInteractionDisabled = False
                Exit Sub
            End Try

            StartTime = Now()
            Try
                Dim BalconyList As List(Of Balcony) = New List(Of Balcony)
                Dim TmpBalconyList As List(Of Balcony) = New List(Of Balcony)
                'need to start after the row headers
                For ExcelRow As Integer = 2 To range.Rows.Count
                    Dim cellval As Excel.Range = range.Cells(ExcelRow, 1)
                    If cellval.Value2 = "Total" Then ' we reached the last row of the table!
                        Exit For
                    End If
                    'data collection


                    Dim partnumber As String = range.Cells(ExcelRow, 6).Value2 & "-" & range.Cells(ExcelRow, 2).Value2
                    Dim BayNumber As String = range.Cells(ExcelRow, 1).Value2 'Column A
                    Dim StackNumber As String = range.Cells(ExcelRow, 2).Value2 'Column B
                    Dim DimAFeatureFinCentres As Double = range.Cells(ExcelRow, 3).Value2 'Column C
                    Dim DimBOverallBalconyLength As Double = range.Cells(ExcelRow, 4).Value2 'Column D
                    Dim BalconyType As String = range.Cells(ExcelRow, 5).Value2 'Column E
                    Dim Bnumber As String = range.Cells(ExcelRow, 6).Value2 'Column F
                    Dim SolidLeft As Boolean = IIf(range.Cells(ExcelRow, 7).Value2 = "SolidLeft", True, False) 'Column G
                    Dim SolidRight As Boolean = IIf(range.Cells(ExcelRow, 8).Value2 = "SolidRight", True, False) 'Column H
                    Dim IsMirrored As Boolean = IIf(SolidRight, True, False)
                    Dim GlassBoth As Boolean = IIf(range.Cells(ExcelRow, 9).Value2 = "GlassBoth", True, False) 'Column I
                    Dim NumGlassPanels As Double = Convert.ToDouble(range.Cells(ExcelRow, 10).Value2) 'Column J

                    Dim tmpbalcony As Balcony
                    tmpbalcony = New Balcony(partnumber,
                                             BayNumber,
                                             StackNumber,
                                             DimAFeatureFinCentres,
                                             DimBOverallBalconyLength,
                                             BalconyType,
                                             Bnumber,
                                             SolidLeft,
                                             SolidRight,
                                             IsMirrored,
                                             GlassBoth,
                                             NumGlassPanels)

                    TmpBalconyList.Add(tmpbalcony)
                Next

                'need to iterate through the tmpbalcony list and differentiate between solidleft,solidright and glassboth instances.
                'because we know we (currently) have glassboth versions for everything we can safely disable it.

                For Each tmpbalcony As Balcony In TmpBalconyList
                    If tmpbalcony.SolidLeft Then
                        Dim leftbalcony As New Balcony(tmpbalcony.PartNo,
                                             tmpbalcony.BayNum,
                                             tmpbalcony.stackno,
                                             tmpbalcony.DimAFeatureFinCentre,
                                             tmpbalcony.DimBOverallBalconyLength,
                                             tmpbalcony.BalconyTypeNum,
                                             tmpbalcony.BayNo,
                                             tmpbalcony.SolidLeft,
                                             tmpbalcony.SolidRight,
                                             tmpbalcony.IsMirrored,
                                             tmpbalcony.Glassboth,
                                             tmpbalcony.NumPanels)
                        leftbalcony.IsMirrored = False
                        leftbalcony.PartNo = leftbalcony.PartNo & "-L"
                        leftbalcony.Glassboth = False
                        BalconyList.Add(leftbalcony)
                    ElseIf tmpbalcony.SolidRight Then
                        Dim rightbalcony As New Balcony(tmpbalcony.PartNo,
                                             tmpbalcony.BayNum,
                                             tmpbalcony.stackno,
                                             tmpbalcony.DimAFeatureFinCentre,
                                             tmpbalcony.DimBOverallBalconyLength,
                                             tmpbalcony.BalconyTypeNum,
                                             tmpbalcony.BayNo,
                                             tmpbalcony.SolidLeft,
                                             tmpbalcony.SolidRight,
                                             tmpbalcony.IsMirrored,
                                             tmpbalcony.Glassboth,
                                             tmpbalcony.NumPanels)
                        rightbalcony.IsMirrored = True
                        rightbalcony.PartNo = rightbalcony.PartNo & "-R"
                        rightbalcony.Glassboth = False
                        BalconyList.Add(rightbalcony)

                    End If
                    'add glassboth variant to balconylist
                    Dim glassbothbalcony As New Balcony(tmpbalcony.PartNo,
                                             tmpbalcony.BayNum,
                                             tmpbalcony.stackno,
                                             tmpbalcony.DimAFeatureFinCentre,
                                             tmpbalcony.DimBOverallBalconyLength,
                                             tmpbalcony.BalconyTypeNum,
                                             tmpbalcony.BayNo,
                                             tmpbalcony.SolidLeft,
                                             tmpbalcony.SolidRight,
                                             tmpbalcony.IsMirrored,
                                             tmpbalcony.Glassboth,
                                             tmpbalcony.NumPanels)
                    glassbothbalcony.SolidRight = False
                    glassbothbalcony.SolidLeft = False
                    glassbothbalcony.IsMirrored = False
                    glassbothbalcony.PartNo = glassbothbalcony.PartNo & "-B"
                    glassbothbalcony.Glassboth = True
                    BalconyList.Add(glassbothbalcony)
                Next

                UpdateStatusBar("List of Balconies to create = " & BalconyList.Count & " Long")

                'uses the Excel data.
                For Each balcony As Balcony In BalconyList
                    Dim GlassBothSides As Boolean = balcony.GlassBoth
                    Dim BalconyIsMirrored As Boolean = balcony.IsMirrored

                    'need to map relevant class objects to Inventor Parameters.
                    SetParameter(My.Settings.BalconyLengthParamName, balcony.DimBOverallBalconyLength)

                    Select Case balcony.BalconyTypeNum
                        Case My.Settings.BalconyT1Params(0) 'T1
                            SetParameter(My.Settings.BalconyNumArmsParamName, My.Settings.BalconyT1Params(1))
                            SetParameter(My.Settings.BalconyArmSpacingParamName, My.Settings.BalconyT1Params(2))
                        Case My.Settings.BalconyT2Params(0) 'T2
                            SetParameter(My.Settings.BalconyNumArmsParamName, My.Settings.BalconyT2Params(1))
                            SetParameter(My.Settings.BalconyArmSpacingParamName, My.Settings.BalconyT2Params(2))
                        Case My.Settings.BalconyT3Params(0) 'T3
                            SetParameter(My.Settings.BalconyNumArmsParamName, My.Settings.BalconyT3Params(1))
                            SetParameter(My.Settings.BalconyArmSpacingParamName, My.Settings.BalconyT3Params(2))
                        Case Else
                            'nothing
                    End Select

                    'Try
                    Dim ResultsFolder As String = RootFolder & System.IO.Path.GetFileNameWithoutExtension(balcony.PartNo) & "\"
                    Dim NewFileName As String = ResultsFolder & balcony.PartNo & ".ipt"

                    'need to update here otherwise we will not see any errors in the updated parameter values.
                    'InventorVb.DocumentUpdate()

                    UpdateStatusBar(NewFileName)
                    ThisDoc.SaveAs(NewFileName, False)
                    ' Catch
                    'MessageBox.Show("If we're having trouble saving, the PartNo could be referencing a vaulted part " & vbCrLf & "Or you copied the spreadsheet and haven't fully updated every row!")
                    'Exit Sub
                    'End Try
                    Dim oErrorMgr As ErrorManager = g_inventorApplication.ErrorManager

                    Dim oMessageSection As MessageSection = oErrorMgr.StartMessageSection
                    'only continue if we have zero errors or warnings
                    If Not oMessageSection.HasErrors Or Not oMessageSection.HasWarnings Then
                        MakeComponentsProgrammatically(ThisDoc, ResultsFolder, BalconyIsMirrored, GlassBothSides)
                    End If
                    ' End section by clearing all messages in section
                    oMessageSection.ClearMessages()
                    If My.Settings.BalconyCreationStepByStepDebugging Then
                        result = MessageBox.Show("Want to continue exporting files?", "Say Yes To continue, No to stop!", MessageBoxButtons.YesNoCancel)
                        If result = vbNo Then
                            MessageBox.Show("Processing stopped after completion of: " & System.IO.Path.GetFileNameWithoutExtension(ThisDoc.FullFileName))
                            Exit For
                        End If
                    End If
                Next
                'modify parameters to suit

                'MessageBox.Show("Parameters Updated, Continuing")
                'ThisDoc.Document.SaveAs(originalfilename, False)
                'MessageBox.Show("Files Created, Finished")
                BalconyList = Nothing
            Catch ex As Exception
                'if some error occurs then this code will be executed
                g_inventorApplication.ScreenUpdating = True
                g_inventorApplication.UserInterfaceManager.UserInteractionDisabled = False
                g_inventorApplication.SilentOperation = False
                MessageBox.Show("Error info: " & vbNewLine & ex.ToString)
            Finally
                g_inventorApplication.ScreenUpdating = True
                g_inventorApplication.UserInterfaceManager.UserInteractionDisabled = False
                g_inventorApplication.SilentOperation = False
                wb.Close(False)
                xlApp.Quit()
                If Not xlApp Is Nothing Then
                    xlApp.ReleaseInstance()
                    'xlApp = Nothing
                End If
            End Try

            ElapsedTime = Now().Subtract(StartTime)

            MessageBox.Show("Operation took " & ElapsedTime.TotalMinutes & " Minutes")
        End Sub

        Private UpdateAfterEachParameterChange As Boolean = False

        ''' <summary>
        ''' This is re-copied from the iLogic rule in the hope that it fixes whatever went wrong.
        ''' Need to make sure that all workfeatures are visibility = false prior to running it.
        ''' CURRENTLY THIS DOES NOT TAKE INTO ACCOUNT THE NAMING DIFFERENCE REQUIRED FOR THE GLASSONBOTHSIDES OPTION!
        ''' </summary>
        ''' <param name="ThisPart"></param>
        ''' <param name="ResultsFolder"></param>
        Sub MakeComponentsProgrammatically(ByVal ThisPart As PartDocument, ByVal ResultsFolder As String, ByVal IsMirrored As Boolean, ByVal GlassOnBothSides As Boolean)
            ' Folder to place the new components:
            ' assembly and subcomponents
            'Dim ResultsFolder As String = System.IO.Path.GetDirectoryName(ThisPart.FullFileName) & "\" & System.IO.Path.GetFileNameWithoutExtension(ThisPart.DisplayName) & "\"

            Dim Thispartname As String = System.IO.Path.GetFileNameWithoutExtension(ThisPart.FullFileName)
            g_inventorApplication.StatusBarText = ResultsFolder & " - " & Thispartname
            If Not System.IO.Directory.Exists(ResultsFolder) Then
                System.IO.Directory.CreateDirectory(ResultsFolder)
            End If

            'Also check if the glassonbothsides option is true and react accordingly.
            If GlassOnBothSides Then
                'this should take care of the feature suppression/unsuppression where required:
                SetParameter("GlassBoth", "1")
                'Throw New NotImplementedException
                'This method needs to include the ability to suppress/unsuppress key Part features OR Suppress/Unsupress components within the resultant assembly.
                'it should also provide functionality to rename any parts and/or the parent Assembly for those part files to make them unique.
            Else
                SetParameter("GlassBoth", "0")
            End If

            ' Create the assembly
            Dim assemblydocument As AssemblyDocument = g_inventorApplication.Documents.Add(DocumentTypeEnum.kAssemblyDocumentObject)

            Call assemblydocument.SaveAs(ResultsFolder + System.IO.Path.GetFileNameWithoutExtension(ThisPart.DisplayName) + ".iam", False)

            'Dim solidbody As SurfaceBody

            For i As Integer = 1 To ThisPart.ComponentDefinition.SurfaceBodies.Count
                Dim surfacebody As SurfaceBody = ThisPart.ComponentDefinition.SurfaceBodies.Item(i)
                Dim surfaceBodyName As String = surfacebody.Name
                If surfaceBodyName.StartsWith("Solid") Then
                    Continue For
                End If
                ' Create part for each body
                Dim partdocument As PartDocument = g_inventorApplication.Documents.Add(DocumentTypeEnum.kPartDocumentObject)

                ' Set iProperties >> Project >> Description
                ' It's inside "Design Tracking Properties"
                Dim p As Inventor.Property = partdocument.PropertySets("{32853F0F-3444-11D1-9E93-0060B03C1CA6}")("Description")
                p.Expression = surfaceBodyName

                Dim derivedpartcomponents As DerivedPartComponents = partdocument.ComponentDefinition.ReferenceComponents.DerivedPartComponents

                Dim derivedpartuniformscaledefinition As DerivedPartUniformScaleDef = derivedpartcomponents.CreateUniformScaleDef(ThisPart.FullDocumentName)

                ' Exclude the other solid bodies
                Dim derivedpartentity As DerivedPartEntity
                For Each derivedpartentity In derivedpartuniformscaledefinition.Solids
                    If Not derivedpartentity.ReferencedEntity Is surfacebody Then
                        derivedpartentity.IncludeEntity = False
                    End If
                Next

                Call derivedpartcomponents.Add(derivedpartuniformscaledefinition)

                'DOES Not WORK!! AF 2016-07-19
                ' Could have any name but we use the solid body's name
                'If we Then can work out how To use the sketch blocks In this part they too need a material. which isn't one of these:
                'If surfaceBodyName.Contains("Panel") Then
                '    SetMaterialToPart(partdocument, "Glass")
                'Else
                '    SetMaterialToPart(partdocument, "Aluminum 6061")
                'End If

                Dim newfilename As String = Regex.Replace(surfaceBodyName, "([a-z](?=[A-Z])|[A-Z](?=[A-Z][a-z]))", "$1 ")

                Call partdocument.SaveAs(ResultsFolder + Thispartname + "-" + newfilename + ".ipt", False)

                'Check whether the part needs to be mirrored based on the IsMirrored variable
                If IsMirrored Then
                    MirrorDerivedPart(partdocument, DerivedPartMirrorPlaneEnum.kDerivedPartMirrorPlaneYZ) 'default is currently YZ Plane
                End If

                ' Place an instance of it inside the assembly
                Dim mx As Matrix = g_inventorApplication.TransientGeometry.CreateMatrix()
                Dim oOcc1 As ComponentOccurrence = assemblydocument.ComponentDefinition.Occurrences.AddByComponentDefinition(partdocument.ComponentDefinition, mx)

                'should really figure out how to add additional occurrences of the relevant 'C' channels and fins where appropriate so we get a completed assembly.
                'base work axes
                Dim XAxis As WorkAxis
                Dim YAxis As WorkAxis
                Dim Zaxis As WorkAxis
                With assemblydocument.ComponentDefinition
                    XAxis = .WorkAxes(1)
                    YAxis = .WorkAxes(2)
                    Zaxis = .WorkAxes(3)
                End With
                If surfaceBodyName = "C2" Then ' or whatever we called this!?
                    Dim objCol As ObjectCollection = g_inventorApplication.TransientObjects.CreateObjectCollection

                    'add the desired occurrence to be patterned
                    objCol.Add(oOcc1)
                    'to get this working we need to look into creating an object collection from this page:
                    ' http://adndevblog.typepad.com/manufacturing/2012/12/inventor-create-pattern-of-component-occurrences.html
                    Call assemblydocument.ComponentDefinition.OccurrencePatterns.AddRectangularPattern(objCol,
                                                                                                       YAxis,
                                                                                                       True,
                                                                                                       GetParameter(My.Settings.BalconyCSpacingParameterName).Expression,
                                                                                                       My.Settings.BalconyChannelsCount)
                ElseIf surfaceBodyName = "Fin" Then ' or whatever we called this!?
                    Dim objCol As ObjectCollection = g_inventorApplication.TransientObjects.CreateObjectCollection

                    'add the desired occurrence to be patterned
                    objCol.Add(oOcc1)
                    'uncomment when the one above works correctly!
                    Call assemblydocument.ComponentDefinition.OccurrencePatterns.AddRectangularPattern(objCol,
                                                                                                       YAxis,
                                                                                                       True,
                                                                                                       GetParameter(My.Settings.BalconyCSpacingParameterName).Expression,
                                                                                                       My.Settings.BalconyFinsCount)
                ElseIf surfaceBodyName.Contains("Panel") Then ' then demote by panel name into sub-assemblies

                ElseIf surfaceBodyName = "LongSpineRight" Then

                ElseIf surfaceBodyName = "LongSpineLeft" Then

                ElseIf surfaceBodyName = "ShortSpine" Then

                ElseIf surfaceBodyName = "SpineConnectingPlateRight" Or surfaceBodyName = "SpineConnectingPlateLeft" Then 'create individual patterns of these components.
                    Dim objCol As ObjectCollection = g_inventorApplication.TransientObjects.CreateObjectCollection
                    'add the desired occurrence to be patterned
                    objCol.Add(oOcc1)
                    'uncomment when the one above works correctly!
                    Call assemblydocument.ComponentDefinition.OccurrencePatterns.AddRectangularPattern(objCol,
                                                                                                       YAxis,
                                                                                                       True,
                                                                                                       GetParameter(My.Settings.BalconySpineFixingHoleParamName).Expression,
                                                                                                       My.Settings.BalconyConnectingPlateCount)
                End If
                ' Don't need it anymore
                Call partdocument.Close()
            Next

            Call assemblydocument.Close()
        End Sub

FWIW: I have not included a bunch of accompanying methods but the above shows how a user might iterate a multi-body part file, export the bodies using the API and also pattern the resultant bodies inside the newly created assembly file.

Which leads me back to my original question: 

Is there any way to also include Sketch blocks in the above method? I know that when running the Make Components tool manually you can select either bodies or sketch blocks but not both at once; does the same restriction apply when using the API?

Thanks,

Alex.

[Anonymous]

Hi Alex

Did you tested this code on solid rectangular pattern? 

For me it looks like it will not take this into derived - is generating the parts but will not derive it. 

Did you have same issue and did you know how to handle this case and take surfacebody of rectangular pattern into consideration?

Thanks

Jens 

[AlexFielder]

Hi @Anonymous,

I haven't looked at this code in ages but as best I can remember it wasn't designed to work with Solid Rectangular patterns.

At the time I thought about doing that, but it made sense (to me at least) to derive the first solid into the assembly, and then use the Assembly pattern function instead. IIRC the two reasons for this were:

1. Because the derived solid components were identical and the code would have created a new derived component with a different name.
2. Because the derive process already took far too long as it was, and adding another step seemed like overkill when the built-in tools would suffice.

Ultimately, the customer I was building this for decided that their "dumb Excel-driven method" was better than my automated approach. Ho-hum.

Cheers,

Alex.

PS. I might resurrect this code to see if improvements in the underlying architecture in the releases since 2016 have improved the derive-component processing speed at all.

[Anonymous]

Hi Alex

Thanks for your quick answer.

The code is great and quick and sometimes - no idea why - it is taking the patterned solids as well into derived, don't ask me why. 

I do understand where you come from but issue starts if you need to modify a pattern - this can only be done on feature level. On assembly level it will take on all components - sure I can use extrude/cut to modify one by one but this will not give real length of a part ( I use Woodwork for Inventor BOM) when modified. 

Think about if you have a framed wall and you want to dump in a window and cut the effected studs in this area as well get the correct length of each modified stud.

Did you have any idea if i can refer back to the pattern in the part and read solids create by this pattern and dump this into derived as well? 

Like this:

Dim oPD As PartDocument= ThisApplication.ActiveDocument
Dim oPCD As PartComponentDefinition = oPD.ComponentDefinition

Dim oCircPatName As String = oPCD.Features.CircularPatternFeatures(1).Name

For Each oSolid As SurfaceBody In oPCD.SurfaceBodies
	For i As Integer = 1 To oSolid.AffectedByFeatures.Count
		If oSolid.AffectedByFeatures(i).Name = oCircPatName Then
			MessageBox.Show(oSolid.Name)
		End If
	Next
Next

As of now I modified the code from Adam to this:

' Run this inside a Multi-Solid part
Sub Main()
  ' Folder to place the new components:
  ' assembly and subcomponents
  Dim f As String: f = "C:\temp\test1\"
  
  ' Make sure the folder exists
  Dim fso As Object
  fso = ThisApplication.FileManager.FileSystemObject
  If Not fso.FolderExists(f) Then Call fso.CreateFolder(f)
  
  Dim doc As PartDocument
  doc = ThisApplication.ActiveDocument
'  doc = ThisDoc.Document
  
  ' Create the assembly
  Dim asm As AssemblyDocument
  asm = ThisApplication.Documents.Add(kAssemblyDocumentObject)
  
  Dim sb As SurfaceBody
  For Each sb In doc.ComponentDefinition.SurfaceBodies
  	' Create part for each body
    Dim prt As PartDocument
	If Not sb.Name.Contains("@") Then
	prt = ThisApplication.Documents.Add(kPartDocumentObject)
    
    ' Set iProperties >> Project >> Description
    ' It's inside "Design Tracking Properties"
    Try
	iProperties.Value("Project", "Part Number") = sb.Name
	Catch
	End Try	
 
    Dim dpcs As DerivedPartComponents
    dpcs = prt.ComponentDefinition.ReferenceComponents. _
      DerivedPartComponents
    
    Dim dpd As DerivedPartUniformScaleDef
    dpd = dpcs.CreateUniformScaleDef(doc.FullDocumentName)

    ' Exclude the other solid bodies
    Dim dpe As DerivedPartEntity
    For Each dpe In dpd.Solids
      If Not dpe.ReferencedEntity Is sb Then
		     dpe.IncludeEntity = False
	   End If
       Next
	 
    
    Call dpcs.Add(dpd)
    
    ' Could have any name but we use the solid body's name
    Call prt.SaveAs(f + sb.Name + ".ipt", False)
        
    ' Place an instance of it inside the assembly
    Dim mx As Matrix
	mx = ThisApplication.TransientGeometry.CreateMatrix()
	If Not sb.Name.Contains("@") Then
    Call asm.ComponentDefinition.Occurrences. _
      AddByComponentDefinition(prt.ComponentDefinition, mx)
     ' Don't need it anymore
	Call prt.Close
   End If
End If
  Next
    
  Call asm.SaveAs( _
    f + Left(doc.DisplayName, Len(doc.DisplayName) - 4) + _
    ".iam", False)
  Call asm.Activate 
End Sub

As you can see I filter parts on sb.name and block the code to generate the part and to dump into the assembly - however, the derived is a big issue and is cross checking with sb - means it will not see the rectangular as of now. 

Would be great if you have some ideas for me. 

Thanks

Jens

[Anonymous]

I think I solved it and now as well rectangular pattern will get incorporated: 

Of course you need to adjust for what you are looking - rectangular, circular, extrusion etc...  and select your correct pattern number.

As well I came up with a solid body renaming rule which is using same logic and will rename all affected solids for each pattern feature by feature name. (see second code) 

' Run this inside a Multi-Solid part
Sub Main()
  ' Folder to place the new components:
  ' assembly and subcomponents
  Dim f As String: f = "C:\temp\test1\"
  
  ' Make sure the folder exists
  Dim fso As Object
  fso = ThisApplication.FileManager.FileSystemObject
  If Not fso.FolderExists(f) Then Call fso.CreateFolder(f)
  
  Dim doc As PartDocument
  doc = ThisApplication.ActiveDocument
'  doc = ThisDoc.Document
  
  ' Create the assembly
  Dim asm As AssemblyDocument
  asm = ThisApplication.Documents.Add(kAssemblyDocumentObject)
  
  Dim sb As SurfaceBody
  For Each sb In doc.ComponentDefinition.SurfaceBodies
  	' Create part for each body
    Dim prt As PartDocument
	If Not sb.Name.Contains("@") Then
	prt = ThisApplication.Documents.Add(kPartDocumentObject)
    
    ' Set iProperties >> Project >> Description
    ' It's inside "Design Tracking Properties"
    Try
	iProperties.Value("Project", "Part Number") = sb.Name
	Catch
	End Try	
 
    Dim dpcs As DerivedPartComponents
    dpcs = prt.ComponentDefinition.ReferenceComponents. _
      DerivedPartComponents
    
    Dim dpd As DerivedPartUniformScaleDef
    dpd = dpcs.CreateUniformScaleDef(doc.FullDocumentName)

    ' Exclude the other solid bodies
    Dim dpe As DerivedPartEntity
	Dim oPCD As PartComponentDefinition = doc.ComponentDefinition
    Dim oRectPatName As String = oPCD.Features.RectangularPatternFeatures(3).Name
    For Each dpe In dpd.Solids
		For Each oSolid As SurfaceBody In oPCD.SurfaceBodies
	        For i As Integer = 1 To oSolid.AffectedByFeatures.Count
		      If oSolid.AffectedByFeatures(i).Name = oRectPatName Then
				 If Not dpe.ReferencedEntity Is oSolid Then 
				   dpe.IncludeEntity = True
		         If Not dpe.ReferencedEntity Is sb Then
					  dpe.IncludeEntity = False
		             		
	   End If	          
	 End If
   End If
	     
      Next
   Next
Next
	
    Call dpcs.Add(dpd)
    
    ' Could have any name but we use the solid body's name
    Call prt.SaveAs(f + sb.Name + ".ipt", False)
        
    ' Place an instance of it inside the assembly
    Dim mx As Matrix
	mx = ThisApplication.TransientGeometry.CreateMatrix()
	If Not sb.Name.Contains("@") Then
    Call asm.ComponentDefinition.Occurrences. _
      AddByComponentDefinition(prt.ComponentDefinition, mx)
     ' Don't need it anymore
	Call prt.Close
   End If
End If
  Next
    
  Call asm.SaveAs( _
    f + Left(doc.DisplayName, Len(doc.DisplayName) - 4) + _
    ".iam", False)
  Call asm.Activate 
End Sub

Dim oPD As PartDocument = ThisApplication.ActiveDocument
Dim oPCD As PartComponentDefinition = oPD.ComponentDefinition
Dim oRectPatName As String = oPCD.Features.RectangularPatternFeatures(3).Name
Dim oRectPatName1 As String = oPCD.Features.RectangularPatternFeatures(4).Name

x = 1
For Each oSolid As SurfaceBody In oPCD.SurfaceBodies
	For i As Integer = 1 To oSolid.AffectedByFeatures.Count
			If oSolid.AffectedByFeatures(i).Name = oRectPatName Then
			oSolid.Name = oRectPatName + IIf (x < 10, "0" + CStr(x), CStr(x))
'			MessageBox.Show(oSolid.Name)
x = x + 1
            End If
	Next
Next	

y = 1
For Each oSolid As SurfaceBody In oPCD.SurfaceBodies
	For i As Integer = 1 To oSolid.AffectedByFeatures.Count
			If oSolid.AffectedByFeatures(i).Name = oRectPatName1 Then
			oSolid.Name = oRectPatName1 + IIf(y < 10, "0" + CStr(y), CStr(y))
'			MessageBox.Show(oSolid.Name)
y = y + 1
		    End If	
		

		Next
Next


InventorVb.DocumentUpdate()