Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
WCrihfield
in reply to: Anonymous

OK. I opened your part, got an error, because it couldn't find the linked original version of the derived part, but I just skipped that. I used the Module1 of for that document to insert and modify your code untill I got it to work. Try this VBA code.

Sub CreateExtrudeFeat()

    Dim oPDoc As PartDocument
    Set oPDoc = ThisApplication.ActiveDocument
    
    Dim oPDef As PartComponentDefinition
    Set oPDef = oPDoc.ComponentDefinition
    
    Dim oSketch As PlanarSketch
    Set oSketch = oPDef.Sketches.Item(2)
    
    Dim oProfile As Profile
    Set oProfile = oSketch.Profiles.AddForSolid
    
    Dim oExtFeats As ExtrudeFeatures
    Set oExtFeats = oPDef.Features.ExtrudeFeatures
    
    Dim oExtDef As ExtrudeDefinition
    Set oExtDef = oExtFeats.CreateExtrudeDefinition(oProfile, kCutOperation)
    Call oExtDef.SetDistanceExtent("1000 mm", kNegativeExtentDirection)
    
    Dim oExtFeat As ExtrudeFeature
    Set oExtFeat = oExtFeats.Add(oExtDef)
    
    If oPDef.HasMultipleSolidBodies = True Then
        Call AddAffectedBodies(oPDef, oExtFeat)
    End If

End Sub

Private Sub AddAffectedBodies(oPDef As PartComponentDefinition, oExtFeat As ExtrudeFeature)

    Dim oBodies As ObjectCollection
    
    For Each oBody In oPDef.SurfaceBodies
        oBodies.Add (oBody)
    Next
    
    Call oExtFeat.SetAffectedBodies(oBodies)
    
End Sub

Let me know if this works for you.

Wesley Crihfield

EESignature

(Not an Autodesk Employee)