Issue:
You find yourself needing to select a large number of closed profiles in a sketch of a logo or something similar. This is quite tedious and because you reuse the sketch over and over, you find yourself wishing you had a better way to do this.
Here is an example of a logo that was copied from AutoCAD and placed in an Inventor sketch block. It's a bit tedious to select all of these profiles each time the logo is used on a laser engraved part.
Here is an example of a logo that was copied from AutoCAD and placed in an Inventor sketch block. It's a bit tedious to select all of these profiles each time the logo is used on a laser engraved part.
Solution:
You can use the following iLogic rule to select all of the closed profiles found in the sketch, and create an Extrude feature from them.
'----start of ilogic -------
If Typeof ThisApplication.ActiveEditObject Is Sketch Then
'Do nothing
Else
MessageBox.Show("Activate a Sketch First then Run this Rule", "ilogic")
Return
End If
Dim oPartDoc As PartDocument
oPartDoc = ThisApplication.ActiveDocument
Dim oCompDef As PartComponentDefinition
oCompDef = oPartDoc.ComponentDefinition
Dim oSketch As PlanarSketch
oSketch = ThisApplication.ActiveEditObject
' Create a profile.
Dim oProfile As Profile
On Error Goto NoProfile
oProfile = oSketch.Profiles.AddForSolid
'get user input
oDistance = InputBox("Enter Extrude Distance", "iLogic", "10 mm")
oDirection = InputRadioBox("Select Extrude Direction", "Up (+)", "Down (-)", True, Title := "iLogic")
oJoinOrCut = InputRadioBox("Select Extrude Solution", "Join", "Cut", True, Title := "iLogic")
If oDirection = True then
oDirection = kPositiveExtentDirection
Else
oDirection = kNegativeExtentDirection
End if
If oJoinOrCut = True then
oJoinOrCut = kJoinOperation
Else
oJoinOrCut = kCutOperation
End if
' Create an extrusion
Dim oExtrude As ExtrudeFeature
On Error Goto NoExtrude
oExtrude = oCompDef.Features.ExtrudeFeatures.AddByDistanceExtent( _
oProfile, oDistance, oDirection, oJoinOrCut)
ThisApplication.CommandManager.ControlDefinitions.Item("FinishSketch").Execute
iLogicVb.UpdateWhenDone = True
exit sub
NoProfile:
MessageBox.Show("No closed profile found", "iLogic")
Return
NoExtrude:
MessageBox.Show("No extrusion created, check your inputs.", "iLogic")
Return
'----end of ilogic -------
By request here is another version of this rule that automatically cuts through all:
Update ( 5/14/2014 ):
By request here is another version of this rule that creates a revolved feature, revolved around the X axis:
---------------------------------------------------------------------------------------------------------------------
Update ( 8/21/2012 ):By request here is another version of this rule that automatically cuts through all:
'----start of ilogic -------
If Typeof ThisApplication.ActiveEditObject Is Sketch Then
'Do nothing
Else
MessageBox.Show("Activate a Sketch First
then Run this Rule", "ilogic")
Return
End If
Dim oPartDoc As PartDocument
oPartDoc = ThisApplication.ActiveDocument
Dim oCompDef As PartComponentDefinition
oCompDef = oPartDoc.ComponentDefinition
Dim oSketch As PlanarSketch
oSketch = ThisApplication.ActiveEditObject
' Create a profile.
Dim oProfile As Profile
On Error Goto NoProfile
oProfile = oSketch.Profiles.AddForSolid
'set direction
oDirection = kSymmetricExtentDirection
'set operation
oJoinOrCut = kCutOperation
' Create an extrusion
Dim oExtrude As ExtrudeFeature
On Error Goto NoExtrude
oExtrude = oCompDef.Features.ExtrudeFeatures.AddByThroughAllExtent( _
oProfile, oDirection, oJoinOrCut)
ThisApplication.CommandManager.ControlDefinitions.Item("FinishSketch").Execute
iLogicVb.UpdateWhenDone = True
exit sub
NoProfile:
MessageBox.Show("No closed profile
found", "iLogic")
Return
NoExtrude:
MessageBox.Show("No extrusion created,
check your inputs.", "iLogic")
Return
'----end of ilogic -------
------------------------------------------------------------------------------------------------------------------------------------------
Update ( 8/21/2012 ):
By request here is another version of this rule that extrudes using the To Next method:
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Update ( 8/21/2012 ):
By request here is another version of this rule that extrudes using the To Next method:
'----start of ilogic -------
If Typeof ThisApplication.ActiveEditObject Is Sketch Then
'Do nothing
Else
MessageBox.Show("Activate a Sketch First
then Run this Rule", "ilogic")
Return
End If
Dim oPartDoc As PartDocument
oPartDoc = ThisApplication.ActiveDocument
Dim oCompDef As PartComponentDefinition
oCompDef = oPartDoc.ComponentDefinition
Dim oSketch As PlanarSketch
oSketch = ThisApplication.ActiveEditObject
' Create a profile.
Dim oProfile As Profile
On Error Goto NoProfile
oProfile = oSketch.Profiles.AddForSolid
oDirection = InputRadioBox("Select Extrude
Direction", "Up (+)", "Down (-)", True, Title := "iLogic")
oJoinOrCut = InputRadioBox("Select Extrude
Solution", "Join", "Cut", True, Title := "iLogic")
If oDirection = True then
oDirection = kPositiveExtentDirection
Else
oDirection = kNegativeExtentDirection
End if
If oJoinOrCut = True then
oJoinOrCut = kJoinOperation
Else
oJoinOrCut = kCutOperation
End if
Dim oTerminator As SurfaceBody
oTerminator = oCompDef.SurfaceBodies(1)
' Create an extrusion
Dim oExtrude As ExtrudeFeature
On Error Goto NoExtrude
oExtrude = oCompDef.Features.ExtrudeFeatures.AddByToNextExtent( _
oProfile, oDirection, oTerminator, oJoinOrCut)
ThisApplication.CommandManager.ControlDefinitions.Item("FinishSketch").Execute
iLogicVb.UpdateWhenDone = True
exit sub
NoProfile:
MessageBox.Show("No closed profile
found", "iLogic")
Return
NoExtrude:
MessageBox.Show("No extrusion created,
check your inputs.", "iLogic")
Return
'----end of ilogic -------
Update ( 5/14/2014 ):
By request here is another version of this rule that creates a revolved feature, revolved around the X axis:
'----start of ilogic -------
If Typeof ThisApplication.ActiveEditObject Is Sketch Then
'Do nothing
Else
MessageBox.Show("Activate a Sketch First
then Run this Rule", "ilogic")
Return
End If
Dim oPartDoc As PartDocument
oPartDoc = ThisApplication.ActiveDocument
Dim oCompDef As PartComponentDefinition
oCompDef = oPartDoc.ComponentDefinition
Dim oSketch As PlanarSketch
oSketch = ThisApplication.ActiveEditObject
Dim oTG As TransientGeometry
oTG = ThisApplication.TransientGeometry
' Create a profile.
Dim oProfile As Profile
On Error Goto NoProfile
oProfile = oSketch.Profiles.AddForSolid
'Create Centerline
Dim points(2) As SketchPoint
points(0) = oSketch.SketchPoints.Add(oTG.CreatePoint2d(0, 0), False)
points(1) = oSketch.SketchPoints.Add(oTG.CreatePoint2d(5, 0), False)
Dim oCenterLine As SketchLine
oCenterLine = oSketch.SketchLines.AddByTwoPoints(points(0), points(1))
' Create the revolved feature
Dim oRev As RevolveFeature
On Error Goto NoFeature
oRev = oCompDef.Features.RevolveFeatures.AddFull(oProfile, oCenterLine, kJoinOperation)
ThisApplication.CommandManager.ControlDefinitions.Item("FinishSketch").Execute
iLogicVb.UpdateWhenDone = True
exit sub
NoProfile:
MessageBox.Show("No closed profile
found", "iLogic")
Return
NoFeature:
MessageBox.Show("No feature created,
check your inputs.", "iLogic")
Return
'----end of ilogic -------
