Not perfect, but I've been working on similar for a while now.
This is the best I've got. You have to name your solids appropriately and tailor the options to your liking but this may give you a start. It goes through a part, finds each solid and cuts out or intersects the interference solid based on which routine you run. This is all done after you derive a new solid into your part. It won't help automate deriving the part, just combining afterward.
Option Explicit
Dim oSurfBody As SurfaceBody
Dim oCompDef As ComponentDefinition
Dim oPartCompDef As PartComponentDefinition
Dim oPartDoc As PartDocument
Public Sub DeriveCaution()
On Error GoTo error_checking
Dim lngErr As Long
Dim i As Long
Dim oSurfBodies As SurfaceBodies
Set oPartDoc = ThisApplication.ActiveDocument
Set oPartCompDef = oPartDoc.ComponentDefinition
Dim oSBInt As SurfaceBody
Dim oSBCaut As SurfaceBody
Dim oSBMain As SurfaceBody
Set oSurfBodies = oPartCompDef.SurfaceBodies
For Each oSurfBody In oPartCompDef.SurfaceBodies
If oSurfBody.Name = "Int" Then
Set oSBInt = oSurfBody
ElseIf oSurfBody.Name = "Caut" Then
Set oSBCaut = oSurfBody
ElseIf oSurfBody.Name = "Main" Then
Set oSBMain = oSurfBody
End If
Next oSurfBody
Dim test As Long
oSBInt.Visible = False
oSBCaut.Visible = False
oSBMain.Visible = False
For i = 1 To oPartCompDef.SurfaceBodies.Count
Set oSurfBodies = oPartCompDef.SurfaceBodies
For Each oSurfBody In oPartCompDef.SurfaceBodies
If oSurfBody.Name = "Int" Then
Set oSBInt = oSurfBody
ElseIf oSurfBody.Name = "Caut" Then
Set oSBCaut = oSurfBody
ElseIf oSurfBody.Name = "Main" Then
Set oSBMain = oSurfBody
End If
Next oSurfBody
Set oSurfBody = oPartCompDef.SurfaceBodies.Item(i)
Call IntCombine(oSurfBody, oSBCaut)
Next i
error_checking:
lngErr = Err.Number
End Sub
Public Sub DeriveInterference()
On Error GoTo error_checking
Dim lngErr As Long
Dim i As Long
Dim oSurfBodies As SurfaceBodies
Set oPartDoc = ThisApplication.ActiveDocument
Set oPartCompDef = oPartDoc.ComponentDefinition
Dim oSBInt As SurfaceBody
Dim oSBCaut As SurfaceBody
Dim oSBMain As SurfaceBody
Set oSurfBodies = oPartCompDef.SurfaceBodies
For Each oSurfBody In oPartCompDef.SurfaceBodies
If oSurfBody.Name = "INT" Then
Set oSBInt = oSurfBody
ElseIf oSurfBody.Name = "CAUT" Then
Set oSBCaut = oSurfBody
ElseIf oSurfBody.Name = "Main" Then
Set oSBMain = oSurfBody
End If
Next oSurfBody
Dim test As Long
oSBInt.Visible = False
oSBCaut.Visible = False
oSBMain.Visible = False
For i = 1 To oPartCompDef.SurfaceBodies.Count
Set oSurfBodies = oPartCompDef.SurfaceBodies
For Each oSurfBody In oPartCompDef.SurfaceBodies
If oSurfBody.Name = "INT" Then
Set oSBInt = oSurfBody
ElseIf oSurfBody.Name = "CAUT" Then
Set oSBCaut = oSurfBody
ElseIf oSurfBody.Name = "Main" Then
Set oSBMain = oSurfBody
End If
Next oSurfBody
Set oSurfBody = oPartCompDef.SurfaceBodies.Item(i)
Call IntCombine(oSurfBody, oSBInt)
Next i
error_checking:
lngErr = Err.Number
End Sub
Public Sub DeriveMain()
On Error GoTo error_checking
Dim lngErr As Long
Dim i As Long
Dim oSurfBodies As SurfaceBodies
Set oPartDoc = ThisApplication.ActiveDocument
Set oPartCompDef = oPartDoc.ComponentDefinition
Dim oSBInt As SurfaceBody
Dim oSBCaut As SurfaceBody
Dim oSBMain As SurfaceBody
Set oSurfBodies = oPartCompDef.SurfaceBodies
For Each oSurfBody In oPartCompDef.SurfaceBodies
If oSurfBody.Name = "INT" Then
Set oSBInt = oSurfBody
ElseIf oSurfBody.Name = "CAUT" Then
Set oSBCaut = oSurfBody
ElseIf oSurfBody.Name = "Main" Then
Set oSBMain = oSurfBody
End If
Next oSurfBody
oSBInt.Visible = False
oSBCaut.Visible = False
oSBMain.Visible = False
For i = 1 To oPartCompDef.SurfaceBodies.Count
Set oSurfBody = oPartCompDef.SurfaceBodies.Item(i)
Call CutCombine(oSurfBody, oSBInt, oSBCaut)
Next i
error_checking:
lngErr = Err.Number
MsgBox Now
End Sub
Public Sub CutCombine(sbBase As SurfaceBody, ocRemove1 As SurfaceBody, ocRemove2 As SurfaceBody)
Dim oCombFeat As CombineFeature
Dim oCombFeats As CombineFeatures
Dim ocRemove As ObjectCollection
Dim oTO As TransientObjects
Set oTO = ThisApplication.TransientObjects
Set ocRemove = oTO.CreateObjectCollection
Call ocRemove.Add(ocRemove1)
Call ocRemove.Add(ocRemove2)
If Not (sbBase.Name = "INT") And Not (sbBase.Name = "CAUT") _
And Not (sbBase.Name = "Main") Then
sbBase.Visible = True
Set oCombFeats = oPartCompDef.Features.CombineFeatures
If Not (CombineFeatureExists(sbBase)) Then
Set oCombFeat = oCombFeats.Add _
(sbBase, ocRemove, kCutOperation, True)
End If
End If
End Sub
Public Sub IntCombine(sbBase As SurfaceBody, sbIntersect As SurfaceBody)
Dim oCombFeat As CombineFeature
Dim oCombFeats As CombineFeatures
Dim ocRemove As ObjectCollection
Dim oTO As TransientObjects
Set oTO = ThisApplication.TransientObjects
Set ocRemove = oTO.CreateObjectCollection
Call ocRemove.Add(sbIntersect)
If Not (sbBase.Name = "INT") And Not (sbBase.Name = "CAUT") _
And Not (sbBase.Name = "Main") Then
sbBase.Visible = True
Set oCombFeats = oPartCompDef.Features.CombineFeatures
If Not (CombineFeatureExists(sbBase)) Then
Set oCombFeat = oCombFeats.Add _
(sbBase, ocRemove, kIntersectOperation, True)
End If
End If
End Sub
Private Function CombineFeatureExists(sbCombFeatSB As SurfaceBody) As Boolean
Dim cfExists As Boolean
Dim j As Long
Dim oCombFeats As CombineFeatures
Set oCombFeats = oPartCompDef.Features.CombineFeatures
cfExists = False
For j = 1 To oCombFeats.Count
If (oCombFeats.Item(j).SurfaceBodies.Item(1).Name = sbCombFeatSB.Name) Then
cfExists = True
End If
Next j
CombineFeatureExists = cfExists
End Function