- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Automating derive part
Hi everyone,
I searched the forum and web but couldn't find anything conclusive so guess i had to ask....
Basically i have a standard part (say part_1)and from that part i need to derive another part (part_2) in and then combine & cut part_2 away which leaves me with a cavity in my original part (part_1)
Is there a way of automating this via rules or even vba ?, i've had a little play about with forms etc but i can't seem to get anywhere.
Ideally this would be a option in a form that you'd just pick the part that you wish to derive and the form would work it's magic leaving you with a nice mould at the end.
I think it should be easy enough but i can't seem to crack the case :'-(
Any suggestions chaps ?
p.s im using inventor professional 2015 if it helps?!
Thanks in advance
Regards
Andy
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Andy, the way you start writing a rule or VBA or Plugin is first you need to find out how you do the tasks manualy. Determine which steps you take when you do it your own, than translate these steps to a rule. Find with each step the equivalent code. Give it a try of your own first. If you still have no idea, maybe somebody can help you furter.
Rob.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
In addition to the sample above, there is also a sample in the API help titled "Derived Parts and Assemblies API Sample".
