Friday, March 2, 2012

iLogic to Select all of the Closed Profiles Found in a Sketch

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.



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 -------


 ---------------------------------------------------------------------------------------------------------------------
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:



'----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 -------