Message 1 of 7
ilogic : How to fill the notch only upwards in the bending direction in the flat
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi?
I am using ilogic in sheet metal parts as below.
How to fill the notch only upwards in the bending direction in the flat pattern?
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.05, 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
