How can I make a hole through multiple solid bodies with VBA?

[Anonymous]

In the code below, I tried to make a hole through a feature and a derived component. The hole only ever goes through a solid.
Is there someone who has a snippet of code for me with which you can make a hole through several solid bodies?

Sub X()

Dim oCD As PartComponentDefinition
Set oCD = ThisApplication.ActiveDocument.ComponentDefinition

Dim oSketch As PlanarSketch
oSketch = oCD.Sketches.Item(2)

Dim oProfile As Profile
Set oProfile = oSketch.Profiles.AddForSolid

Dim oED As ExtrudeDefinition
Set oED = oCD.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kCutOperation)
Call oED.SetDistanceExtent("1000 mm", kNegativeExtentDirection)

Dim oExtrude As ExtrudeFeature
Set oExtrude = oCD.Features.ExtrudeFeatures.Add(oED)

End Sub

[WCrihfield]

Add this additional line.

Sub X()

Dim oCD As PartComponentDefinition
Set oCD = ThisApplication.ActiveDocument.ComponentDefinition

Dim oSketch As PlanarSketch
Set oSketch = oCD.Sketches.Item(2)

Dim oProfile As Profile
Set oProfile = oSketch.Profiles.AddForSolid

Dim oED As ExtrudeDefinition
Set oED = oCD.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kCutOperation)
Call oED.SetDistanceExtent("1000 mm", kNegativeExtentDirection)

Dim oExtrude As ExtrudeFeature
Set oExtrude = oCD.Features.ExtrudeFeatures.Add(oED)

oExtrude.SetAffectedBodies(oCD.SurfaceBodies)

End Sub

[Anonymous]

Thank you for your answer. You are the only one who answered me. I really appreciate your help.
I tried several times but the code doesn't work.
I get the following error message:

Error in rule: Rule4, in document: DerivedPart.ipt

Unable to cast COM object of type 'System.__ComObject' to interface type 'Inventor.ObjectCollection'. This operation failed because the QueryInterface call on the COM component for the interface with IID '{6939FFDD-BA10-11D2-B779-0060B0F159EF}' failed due to the following error: Interface not supported (Exception from HRESULT: 0x80004002 (E_NOINTERFACE)).

Working with inventor vba is frustrating.
For me, the documentation is extremely thin. It seems that I can't close the gaps between the sparse comments. Sometimes the forum saves me. Here I sometimes get hints that help me. But all in all, it's not enough. i don't get it baked. Too bad that there is no usable documentation with which one can learn vba well. I spend far too much time looking for useful examples and explanations.

Does anyone have any suggestions or ideas on how to learn vba comfortable?

[gcoombridge · Accepted solution]

Hi, this is what I was using for something similar. This was for iLogic not VBA. In this case the extrusions are already created - I just wanted to make sure they cut through every solid. It does require all cut extrusions to come after new solids in the tree I think (otherwise it is adding bodies to the collection that don't exist when the subtraction is taking place). A try/catch operation would probably fix that... I also planned to add revolves in there but haven't had time.

'This rule compiles all the solids created by extrusions and commands all cuts to cut through all solids
'This is required where you have an unknown amount of solids to cut through (i.e. tank strakes)
Dim oDoc As PartDocument
oDoc = ThisDoc.Document
Dim oPartDef As ComponentDefinition
oPartDef = oDoc.ComponentDefinition

'create a collection to hold the solids to act on
Dim oExtrusion As ExtrudeFeature 
Dim NewBodyObjCol As ObjectCollection
NewBodyObjCol = ThisApplication.TransientObjects.CreateObjectCollection

'Iterate through each extrudefeature in part, establish if its a cut and then set to the list of all bodies
For Each oExtrusion In oPartDef.Features.ExtrudeFeatures
	'If an extrusion creates a new solid then add the solid it creates to a collection
	If oExtrusion.Definition.Operation = kNewBodyOperation Then
		NewBodyObjCol.Add(oExtrusion.Definition.AffectedBodies.Item(1))
			'Alternatively if the extrusion is a cut then use the collection created above to cut through everything
	Else If oExtrusion.Definition.Operation = kCutOperation Then
		oExtrusion.SetAffectedBodies(NewBodyObjCol)
	End If
Next oExtrusion


	

Cheers, Glenn

[fullevent · Accepted solution]

Hello @Anonymous,

I have adapted the code of my two previous ones @WCrihfield and @gcoombridge and created this code snippet (VBA).

Sub Hole_throuh_all_Bodies()
    Dim oCD As PartComponentDefinition
    Set oCD = ThisApplication.ActiveDocument.ComponentDefinition
    Dim oSketch As PlanarSketch
    Set oSketch = oCD.Sketches.Item("Skizze4")
    Dim oProfile As Profile
    Set oProfile = oSketch.Profiles.AddForSolid
    Dim oED As ExtrudeDefinition
    Set oED = oCD.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kCutOperation)
    Call oED.SetDistanceExtent("1000 mm", kNegativeExtentDirection)
    Dim oExtrude As ExtrudeFeature
    Set oExtrude = oCD.Features.ExtrudeFeatures.add(oED)
    Dim objCol1 As ObjectCollection
    Set objCol1 = ThisApplication.TransientObjects.CreateObjectCollection
    For Each oExtrude In oCD.Features.ExtrudeFeatures
        If oExtrude.Definition.Operation = kNewBodyOperation Then
            objCol1.add (oExtrude.Definition.AffectedBodies.Item(1))
        ElseIf oExtrude.Definition.Operation = kCutOperation Then
            oExtrude.SetAffectedBodies objCol1
        End If
    Next oExtrude
End Sub

my part bevor running the macro:

and after macro:

I hope it helps you. Maybe you can adapt it to your needs.

Regards,
Aleks

[WCrihfield · Accepted solution]

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.

[Anonymous]

Hi there,

the first time that I get two good answers. Thank you for your efforts. This code is like good music and it works very well.