Create a solid for each loop

[DavidTruyens]

Hi,

I create a sketch and project cut edges. Now I would like to create a new body for each loop. 

At this moment I have something like this:

 
       Dim contoursketch As PlanarSketch = _CompDef.Sketches.Add(SlicePlane)
        Dim ExtrudeThickness = CDbl(SliceThickness.Value)
        contoursketch.ProjectedCuts.Add()

        Dim exturdeprofiletest As Profile
        exturdeprofiletest = contoursketch.Profiles.AddForSolid(True)
        Debug.Print(exturdeprofiletest.Count)

So the extrudeprofile test could contain more than one loop.

No I can't seem to find a way to select only one to create an extrusion. I would like to create a for each profile in extrudeprofile test, but that isn't going to work like that off course...

Any suggestions?

Thanks,

David

[ekinsb · Accepted solution]

Hi David,

When you create a profile is creates all of the closed loops it can.  You can delete loops out of the profile and then use the modifed profile to create an extrusion.  The code below does this.

Public Sub CreateBodies()
    Dim partDoc As PartDocument
    Set partDoc = ThisApplication.ActiveDocument
    
    ' Have a work plane selected to create the new sketch on.
    Dim plane As WorkPlane
    Set plane = ThisApplication.CommandManager.Pick(kWorkPlaneFilter, "Pick work plane")
    
    ' Create a new sketch.
    Dim sk As PlanarSketch
    Set sk = partDoc.ComponentDefinition.Sketches.Add(plane)
    
    Dim extFeatures As ExtrudeFeatures
    Set extFeatures = partDoc.ComponentDefinition.features.ExtrudeFeatures
    
    ' Create the cut geometry.
    Call sk.ProjectedCuts.Add
    
    ' Create a profile, which will include all loops.
    Dim prof As Profile
    Set prof = sk.Profiles.AddForSolid
    
    ' Iterate through the loops creating an extrusion for each loop.
    Dim i As Integer
    For i = 1 To prof.Count
        ' Create a new profile.
        Dim newprof As Profile
        Set newprof = sk.Profiles.AddForSolid
        
        ' Delete all of the loops in the profile except for one.
        Dim j As Integer
        Dim deleteIndex As Integer
        deleteIndex = 1
        For j = 1 To prof.Count - 1
            If i = j Then
                deleteIndex = 2
            End If
            
            newprof.Item(deleteIndex).Delete
        Next
        
        ' Create the extrusion.
        Dim extDef As ExtrudeDefinition
        Set extDef = extFeatures.CreateExtrudeDefinition(newprof, kNewBodyOperation)
        Call extDef.SetDistanceExtent(2, kPositiveExtentDirection)
        Call extFeatures.Add(extDef)
    Next
End Sub

[DavidTruyens]

Thanks Brian,

Works like a charm!!

[SandmanINV]

Hello everybody, 

My problem same that situation, i think i can solve my problem. But something wrong.

I have a ACAD file, i imported to inventor, projected geometry, then I want each closed profile is one solid body.

But After debuged, the count of profile is 4. But I can not delete profile item number 3, i just want extrude number 4. 

Could you help me about this. Thank you very much.

This is my picture profile and my code.

Private Sub btn_testcode_Click(sender As Object, e As EventArgs) Handles btn_testcode.Click
        Dim oDoc As PartDocument
        oDoc = oinv.Documents.Add(DocumentTypeEnum.kPartDocumentObject, oinv.FileManager.GetTemplateFile(DocumentTypeEnum.kPartDocumentObject, SystemOfMeasureEnum.kMetricSystemOfMeasure, DraftingStandardEnum.kISO_DraftingStandard))
        Dim ocompdef As ComponentDefinition = oDoc.ComponentDefinition
        Dim otransi As TransientGeometry = oinv.TransientGeometry
        Dim opartdef As PartComponentDefinition = oDoc.ComponentDefinition
        'Dim osketch1 As PlanarSketch = opartdef.Sketches.Add(oDoc.ComponentDefinition.WorkPlanes.Item(2))
        'import dwg profile random
        Dim oRefComponents_2400 As ReferenceComponents
        oRefComponents_2400 = ocompdef.ReferenceComponents

        ' Create a ImportedComponentDefinition based on an AutoCAD file.
        Dim oImportedCompDef_2400 As ImportedComponentDefinition
        oImportedCompDef_2400 = oRefComponents_2400.ImportedComponents.CreateDefinition(oFileDlg.FileName)
        Dim oImportedDWGDef_2400 As ImportedDWGComponentDefinition

        If oImportedCompDef_2400.Type = ObjectTypeEnum.kImportedDWGComponentDefinitionObject Then
            oImportedDWGDef_2400 = oImportedCompDef_2400
        Else
            End
        End If

        Dim oImportedComponent_2400 As ImportedComponent
        oImportedComponent_2400 = oRefComponents_2400.ImportedComponents.Add(oImportedDWGDef_2400)

        Dim oImportedDWGComponent_2400 As ImportedDWGComponent
        Dim oSk_2400 As PlanarSketch
        If oImportedComponent_2400.Type = ObjectTypeEnum.kImportedDWGComponentObject Then
            oImportedDWGComponent_2400 = oImportedComponent_2400


            oSk_2400 = ocompdef.Sketches.Add(opartdef.WorkPlanes.Item(3))
            ' oSk = ocompdef.Sketches.Add(oworkplane1)
            ' Get the DWGBlockDefinition for model space.
            Dim oDWGModelSpaceDef As DWGBlockDefinition
            oDWGModelSpaceDef = oImportedDWGComponent_2400.ModelSpaceDefinition

            ' Project DWG entities to planar sketch.
            Dim oDWGEntity As DWGEntity
            For Each oDWGEntity In oDWGModelSpaceDef.Entities

                Call oSk_2400.AddByProjectingEntity(oDWGEntity)
            Next
            oinv.ActiveView.GoHome()
            oImportedDWGComponent_2400.Visible = False
            oSk_2400.Visible = False
            Dim oprofile2 As Profile = oSk_2400.Profiles.AddForSolid()
            Dim iprocount As Integer
            iprocount = oprofile2.Count()

            Dim oprofile3 As Profile = oSk_2400.Profiles.AddForSolid
            oprofile3.Item(1).Delete()
            oprofile3.Item(2).Delete()
            oprofile3.Item(3).Delete()

            Dim oextrudef2 As ExtrudeDefinition = opartdef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oprofile3,
                                                                                 PartFeatureOperationEnum.kNewBodyOperation)
            oextrudef2.SetDistanceExtent(340, PartFeatureExtentDirectionEnum.kPositiveExtentDirection)
            Dim oextrude2 As ExtrudeFeature = opartdef.Features.ExtrudeFeatures.Add(oextrudef2)
                   End If
    End Sub

[SandmanINV]

Oh, i found error, i need countdown item from sketch from highest to 1 🙂 

[ngocson8335]

Hello Mr. Ekensb,

I am using your code to extrude each loop in a profile but 2 profiles are used for an extruding.

Could you give me a good solution to this situation?

My situation:

Many thanks

Ngoc Son