Automated hole creation on bend lines

[chrisw01a]

Hope you all are having a great day.

Does anyone here know if it would be possible to use iLogic or other means to build an addon that will find the bend line on a flat pattern and add two holes to it (one on each end)?

The way our CNC machine picks up our centerpunch is we add a .125" hole on the part.  I spends hours opening flat patterns , creating a sketch, projecting the bend lines, adding a point usually .100" away from the edge, then using the hole feature to create the .125" hole.

Example part attached.

We would probably pay money for it if anyone knows of something existing.

Am I just dreaming here?

Thanks

Chris

[chrisw01a · Accepted solution]

Just to update the thread, Curtis & Chandra have this working almost perfect.  The forum is a great tool and the people on here are very much appreciated.

Sub Main
'[ edit these variables as needed
sSketchName = "Flat Pattern Sketch"
sHoleName = "Locator Holes"
oOffset = 0.1 'defines offset from edge of flat pattern
oDiameter = 0.125 'defines hole diameter
']	

'  a reference to the active document.
Dim oPartDoc As PartDocument
oPartDoc = ThisApplication.ActiveDocument

'verify document type is sheet metal
If oPartDoc.ComponentDefinition.Type <> 150995200 Then
	MessageBox.Show("File is not a sheet metal part.", "iLogic")
	Exit Sub
End If

Dim oCompDef As SheetMetalComponentDefinition
oCompDef = oPartDoc.ComponentDefinition

' Check to make sure a flat pattern is open.
If Not TypeOf ThisApplication.ActiveEditObject Is FlatPattern Then
	Try
		If oCompDef.HasFlatPattern = False Then
			oCompDef.Unfold
		Else
			oCompDef.FlatPattern.Edit
		End If
	Catch
		MessageBox.Show("Error editting the flat pattern.", "iLogic")

	End Try
End If

'  a reference to the active flat pattern.
Dim oFlatPattern As FlatPattern
oFlatPattern = ThisApplication.ActiveEditObject

'clean up existing holes
Dim oHole As HoleFeature
For Each oHole In oFlatPattern.Features.HoleFeatures
	oHole.Delete
Next
 
Dim oFace As Face
oFace = oFlatPattern.TopFace

Dim oSketch As PlanarSketch

'clean up existing sketch
For Each oSketch In oFlatPattern.Sketches
	If oSketch.Name = sSketchName Then
		oSketch.Delete
	End If
Next

' Create a new sketch.  
' the Second argument specifies To include/Not include
' the edges of the face in the sketch.
oSketch = oFlatPattern.Sketches.Add(oFace, False)

' Change the name.
oSketch.Name = sSketchName
	
'Dim oPoint As Point2d
Dim oSketchPoint As SketchPoint
oOffset = oOffset * 2.5400013716 'converts cm to inches

Dim oEdges As Edges

' Create a new object collection for the hole center points.
oHoleCenters = ThisApplication.TransientObjects.CreateObjectCollection

' Get all Bend UP edges
'where true = top face
oEdges = _
oFlatPattern.GetEdgesOfType( _
FlatPatternEdgeTypeEnum.kBendUpFlatPatternEdge, True) 

'process the Bend Edges
Call Create_SketchPoints(oSketch, oEdges, oHoleCenters, oOffset)

' Get all Bend Down edges
'where true = top face
oEdges = _
oFlatPattern.GetEdgesOfType( _
FlatPatternEdgeTypeEnum.kBendDownFlatPatternEdge, True) 

'process the Bend Edges
Call Create_SketchPoints(oSketch, oEdges, oHoleCenters, oOffset )

' Create the hole feature
oHole =  oFlatPattern.Features.HoleFeatures.AddDrilledByThroughAllExtent( _
		oHoleCenters, oDiameter * 2.5400013716 , kPositiveExtentDirection)

oHole.Name = sHoleName

oCompDef.FlatPattern.ExitEdit
oPartDoc.Save

End Sub

Sub Create_SketchPoints _
(oSketch As Sketch, oEdges As Edges, _
oHoleCenters As ObjectCollection, oOffset As Double)

    ' Set a reference to the transient geometry object.
    Dim oTransGeom As TransientGeometry
    oTransGeom = ThisApplication.TransientGeometry


For Each oEdge In oEdges

	'create line
    Dim skLine As SketchLine 
	skLine = oSketch.AddByProjectingEntity(oEdge)
	
	Dim oLineSegment1 As LineSegment2d
	oLineSegment1 = skLine.Geometry
	
    Dim startPt As Point2d
    startPt = skLine.StartSketchPoint.Geometry	
	
    Dim endPt As Point2d
    endPt = skLine.EndSketchPoint.Geometry	
	
    Dim startSkPt As SketchPoint
    Dim endSkPt As SketchPoint
	
	Dim oInterSectPoint As Point2d
    Dim oCircle As SketchCircle		

'start point
	'create circle
    oCircle = oSketch.SketchCircles.AddByCenterRadius(startPt, oOffset)
	
	'find intersection of circle and line
	oInterSectPoint = oLineSegment1.IntersectWithCurve(oCircle.Geometry).Item(1)
	'create point for hole
	startSkPt = oSketch.SketchPoints.Add(oInterSectPoint, True)
	
	'constrain geometry
	oCircle.Construction = True
	oSketch.DimensionConstraints.AddDiameter (oCircle, startPt ) 
	oSketch.GeometricConstraints.AddCoincident(startSkPt, skLine)
	oSketch.GeometricConstraints.AddCoincident(startSkPt, oCircle)
	oSketch.GeometricConstraints.AddCoincident _
	(skLine.StartSketchPoint, oCircle.CenterSketchPoint)	
	
	'add to hole center collection
	oHoleCenters.Add(startSkPt)
	
'end point
	'create circle
    oCircle = oSketch.SketchCircles.AddByCenterRadius(endPt, oOffset)
	
	'find intersection of circle and line
	oInterSectPoint = oLineSegment1.IntersectWithCurve(oCircle.Geometry).Item(1)
	endSkPt = oSketch.SketchPoints.Add(oInterSectPoint, True)
	
	'constrain geometry
	oCircle.Construction = True
	oSketch.DimensionConstraints.AddDiameter (oCircle, endPt ) 
	oSketch.GeometricConstraints.AddCoincident(endSkPt, skLine)
	oSketch.GeometricConstraints.AddCoincident(endSkPt, oCircle)
	oSketch.GeometricConstraints.AddCoincident _
	(skLine.EndSketchPoint, oCircle.CenterSketchPoint)
	
    'add to hole center collection
    oHoleCenters.Add(endSkPt)    

Next

End Sub

[chrisw01a]

Curtis,

I have run into a problem on this.  See attached part and note that 2 of the holes are out in the middle of the part now.

When changing geometry on some parts, the points are losing their association with the other geometry.

This was happening on a normal rectangular part with 2 bends in it as well FYI.

Any clue what might cause this?

Thank you.

Chris

[machiel.veldkamp]

I know this is a 2 year old topic but for anyone who's interested this is my solution to the problem.

It also handles Lofted flanges in a neat way. Should work on ALL parts. The Bend Marker will ignore non-sheetmetal ipt's and will skip also if there's no bends to be found. 

Sub Main()
	'Prevents Inventor from crashing.
	'---------------------------------------------------------------------------------------------
	InventorVb.DocumentUpdate()

	'Check if open document is sheetmetal
	'---------------------------------------------------------------------------------------------

	Dim oDoc As Document = ThisApplication.ActiveDocument
	If oDoc.DocumentSubType.DocumentSubTypeID <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
		Exit Sub
	Else
	End If
	'MsgBox("Is sheetmetal")

	'Check if open sheetmetal document has flatpattern view
	'---------------------------------------------------------------------------------------------
	Dim oSMD As SheetMetalComponentDefinition
	oSMD = oDoc.ComponentDefinition
	If Not oSMD.HasFlatPattern Then Exit Sub
	Dim oFlat As FlatPattern = oSMD.FlatPattern
	'MsgBox("Has flatpattern")

	'Check for bend features
	'---------------------------------------------------------------------------------------------
	Try
		Dim BendCount As Integer = oSMD.Bends.Count
		If BendCount < 1 Then Exit Sub
		'MsgBox("# bends " & BendCount)
	Catch
		MsgBox("error: Sheetmetalcomponentdefinition.Bends.Count (Can't find bends?)")
		Exit Sub
	End Try
	
	Try
		Dim oBendCount As Integer = oFlat.FlatBendResults.Count
		'MsgBox("# oBends " & oBendCount)
		If oBendCount < 1 Then Exit Sub
	Catch
		MsgBox("error: FlatBendResults.Count (Can't find bends?)")
		Exit Sub
	End Try

	'Check if feature "BendMarkerHoles" exists
	'---------------------------------------------------------------------------------------------
	Dim FeatureName As String = "BendMarkerHoles"

	Try
		Dim oFTS As FlatPatternFeatures = oFlat.Features
		If oFTS.Count > 0 Then
			For Each oFT As PartFeature In oFTS
				If oFT.Name <> FeatureName Then Continue For
				Try
					oFT.Delete()
				Catch

				End Try
				Exit For
			Next
		End If
	Catch
		MsgBox("error in MAIN()")
	End Try

	BendMarker(oFlat)

End Sub

Sub BendMarker(oFlat As FlatPattern)
	Dim oEdges As Edges
	Dim oHoleCenters As Object = ThisApplication.TransientObjects.CreateObjectCollection
	Dim oSketch As PlanarSketch

	'Flatpattern sketch -------------------------------------------------------------------------
	Try
		oSketch = oFlat.Sketches.Add(oFlat.TopFace, True)
	Catch
		oSketch = oFlat.Sketches.Add(oFlat.BottomFace, True)
	End Try

	oSketch.Edit()

	'Detect bend down ---------------------------------------------------------------------------
	Try
		oEdges = oFlat.GetEdgesOfType(FlatPatternEdgeTypeEnum.kBendDownFlatPatternEdge, True)
		WorkEdges(oHoleCenters, oSketch, oEdges)
	Catch
		MsgBox("error: GetEdgesOfType 64005/kBendDownFlatPatternEdge")
	End Try

	'Detect bend up -----------------------------------------------------------------------------
	Try
		oEdges = oFlat.GetEdgesOfType(FlatPatternEdgeTypeEnum.kBendUpFlatPatternEdge, True)
		WorkEdges(oHoleCenters, oSketch, oEdges)
	Catch
		MsgBox("error: GetEdgesOfType 64004/kBendUpFlatPatternEdge")
	End Try
	Call oFlat.Features.HoleFeatures.AddDrilledByThroughAllExtent(oHoleCenters, 0.1, kPositiveExtentDirection)

	Try
		Dim oHoleFeat As HoleFeature = oFlat.Features.HoleFeatures.Item(1)
		oHoleFeat.Name = "BendMarkerHoles"

		oSketch.ExitEdit()
		oSketch.Name = "MarkedBends"
	Catch
		MsgBox("error: GetEdgesOfType kBendUpFlatPatternEdge (64004) en/of kBendDownFlatPatternEdge (64005) kunnen niet worden gevonden")
	End Try
	
End Sub

Sub WorkEdges(ByRef oHoleCenters As Object, ByRef oSketch As PlanarSketch, oEdges As Edges)

	'Create list of coördinates
	'-------------------------------------------------------------------------------------------
	Dim oDoc As Document = ThisDoc.Document
	Dim oSMD As SheetMetalComponentDefinition
	oSMD = oDoc.ComponentDefinition

	Dim oLoft As Integer = 0
	For Each HFeature As LoftedFlangeFeature In oSMD.Features.LoftedFlangeFeatures
		oLoft = 1
	Next

	Dim oTG As TransientGeometry = ThisApplication.TransientGeometry

	Dim Xi As Integer = 0

	Dim BendCount As Integer = oSMD.Bends.Count
	BendCount *= 4
	Dim oPointGrid(BendCount, 1) As Double

	For Each oEdge As Edge In oEdges
		Try
			Dim oEnt As SketchEntity = oSketch.AddByProjectingEntity(oEdge)

			oPointGrid(Xi, 0) = oEnt.StartSketchPoint.Geometry.X.ToString
			oPointGrid(Xi, 1) = oEnt.StartSketchPoint.Geometry.Y.ToString

			Xi = Xi + 1
			oPointGrid(Xi, 0) = oEnt.EndSketchPoint.Geometry.X.ToString
			oPointGrid(Xi, 1) = oEnt.EndSketchPoint.Geometry.Y.ToString
			Xi = Xi + 1

			oEnt.Delete	'Deleting projected geometry
		Catch
			'MsgBox("error")
		End Try
	Next

	If Xi = 0 Then Exit Sub

	'Loft Filter Start
	'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
	If oLoft = 0 Then GoTo Endloft
	'MsgBox("Loft Code")

	Dim intCount1, intCount2 As Integer
	Dim DictX As Object = CreateObject("Scripting.Dictionary")
	Dim DictY As Object = CreateObject("Scripting.Dictionary")

	'Filter Points within certain promximity of each other
	'-------------------------------------------------------------
	For intCount1 = 0 To Xi
		For intCount2 = 0 To Xi
			If intCount1 <> intCount2 Then
				'																		2D-array
				'																		 |_0__|_1__|
				'																		0|_X__|_Y__|	0,0 = x coördinate 0,1 = y coördinate
				'																		1|_X__|_Y__|	1,0 = x coördinate 1,1 = y coördinate
				'																		2|_X__|_Y__|	2,0 = x coördinate 2,1 = y coördinate			


				'											X-Value intCount1		  X-Value intCount2									Y-Value intCount1	   	  Y-Value intCount2			
				'						Compare			2D Array Cel X,0	With	  2D Array Cel X,0			And		Compare			2D Array Cel X,1	With	  2D Array Cel X,1
				If EqualWithinTolerance(oPointGrid(intCount1, 0), oPointGrid(intCount2, 0), 0.1) And EqualWithinTolerance(oPointGrid(intCount1, 1), oPointGrid(intCount2, 1), 0.1) Then
					Try
						DictX.Add(oPointGrid(intCount2, 0) & " " & oPointGrid(intCount2, 1), oPointGrid(intCount2, 0))
						DictY.Add(oPointGrid(intCount2, 0) & " " & oPointGrid(intCount2, 1), oPointGrid(intCount2, 1))
					Catch
						'Nothing
					End Try
				End If
			End If
		Next intCount2
	Next intCount1
	'MsgBox("IntCount " & intCount1 & " " & intCount2)

	'Filter points.
	'Only the points which are not close to each other remain.
	'-------------------------------------------------------------
	Dim i As Integer = 0
	Dim oPointGridFilteredX As Object = CreateObject("Scripting.Dictionary")
	Dim oPointGridFilteredY As Object = CreateObject("Scripting.Dictionary")

	For i = 0 To Xi
		If Not Xi = 0 Then
			If Not DictX.Exists(oPointGrid(i, 0) & " " & oPointGrid(i, 1)) Then
				oPointGridFilteredX.Add(oPointGrid(i, 0) & " " & oPointGrid(i, 1), oPointGrid(i, 0))
				oPointGridFilteredY.Add(oPointGrid(i, 0) & " " & oPointGrid(i, 1), oPointGrid(i, 1))
			Else
				'Nothing
			End If
		End If
	Next

	'Convert the created dictionary of filtered points into an 2d-array
	'-------------------------------------------------------------
	Dim ArrayFiltered(oPointGridFilteredX.Count - 1, 1) As Double
	Dim ii As Integer = 1

	For ii = 0 To oPointGridFilteredX.Count - 1
		ArrayFiltered(ii, 0) = oPointGridFilteredX.Items()(ii)
		ArrayFiltered(ii, 1) = oPointGridFilteredY.Items()(ii)
	Next

	'Place holecenters
	'--------------------------------------------
	Dim iii As Integer = 0

	For iii = 0 To ii - 1
		Dim oP = oSketch.SketchPoints.Add(oTG.CreatePoint2d(ArrayFiltered(iii, 0), ArrayFiltered(iii, 1)), True)
		'MsgBox("oP " & ArrayFiltered(iii, 0) & " " & ArrayFiltered(iii, 1))
		If Not (ArrayFiltered(iii, 0) = 0 And ArrayFiltered(iii, 1) = 0) Then
			'MsgBox("oP " & ArrayFiltered(iii, 0) & " " & ArrayFiltered(iii, 1))
			oHoleCenters.Add(oP)
		End If
	Next

	'Loft Filter End
	'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------		

	'Place holecenters
	'--------------------------------------------
	If oLoft = 1 Then Exit Sub

	Endloft :
	'MsgBox("Non Loft Code")

	For Each oEdge As Edge In oEdges
		Dim oEnt As SketchEntity = oSketch.AddByProjectingEntity(oEdge)
		Dim P As Point2d = oEnt.StartSketchPoint.Geometry
		Dim oSP As SketchPoint = oSketch.SketchPoints.Add(oTG.CreatePoint2d(P.X, P.Y), True)
		oHoleCenters.Add(oSP)
		P = oEnt.EndSketchPoint.Geometry
		Dim oEP As SketchPoint = oSketch.SketchPoints.Add(oTG.CreatePoint2d(P.X, P.Y), True)
		oHoleCenters.Add(oEP)
	Next
End Sub

[chrisw01a]

Thanks for posting. I'll give it a shot when I get some time.

[anuj16797]

I need to create a triangle of 0.25" on the bend lines on both sides. I'm no coder please help.

[anuj16797]

hi.

I'm also looking for something same. I need a triangle instead of a circle without an offset on both the ends of the bend line.

Please help i really need a rule that can do this.

[hiendc587]

Thanks for the code. But there is a small problem that, at places where there are 2 or 3 bends, it will create circles as shown below. How to make those circles concentric? Thank you very much!!!

[chrisw01a]

For this, I think you can increase the oOffset variable at the top of the code. This will move the point inward on the part.

[hiendc587]

Thanks, I see what you mean, but I want the center of the circle to be at the edge of the part.

[chrisw01a]

That should be easy. Just change it to 0.

[hiendc587]

But where there are 2 to 3 intersecting bends, I want the circles to be concentric, in other places the circle is on the edge of the part. It looks like the picture below. Is this idea feasible?

[chrisw01a]

I see. I cannot answer that one.

[johnsonshiue]

Hi! Please share the ipt file here. I am wondering if other Corner Relief types may work better.

Many thanks!

[hiendc587]

Thank you for your attention. This is the file .ipt

[johnsonshiue]

Hi! I am sorry I don't see the two-circle corner relief in the flat pattern. Could you show me where to see it?

Many thanks!

[hiendc587]

Maybe the file above doesn't run the rule. I fixed it!

[johnsonshiue]

Hi! Many thanks for sharing the file! Now I understand it better. Indeed, Inventor does not have such corner relief on the folded body. You do need to "hack" it in the flat pattern.

Thanks again!