Fifi Riri

Cut notches at each bends extremities on a sheet metal part for laser cut

Discussion created by Fifi Riri on Apr 1, 2019
Latest reply on Dec 3, 2019 by Neville Williams

Following this thread: Draw lines at each bend lines extremities on a sheet metal drawing for engraving

Here is a macro to add notches at each bends extremities on a sheet metal part.

It will add an Unfold and fold feature, and create a cut feature with fully defined triangles.

 

1.jpg

2.jpg

3.jpg

4.jpg

 

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPreviousSketchSeg As SldWorks.SketchSegment

Sub main()
Dim swFeat As SldWorks.Feature
Dim swSubFeat As SldWorks.Feature
Dim swFixedFace As SldWorks.Face2
Dim swBends() As SldWorks.Feature
Dim swFlatPatt As SldWorks.FlatPatternFeatureData
Dim swSketch As SldWorks.Sketch
Dim boolstatus As Boolean

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swPreviousSketchSeg = Nothing

swModel.ClearSelection2 True
Dim i As Integer
Set swFeat = swModel.FirstFeature
While Not swFeat Is Nothing
'Debug.Print swFeat.Name & " " & swFeat.GetTypeName2
'get Fixed Face
If swFeat.GetTypeName2 = "FlatPattern" Then
Set swFlatPatt = swFeat.GetDefinition
swFlatPatt.AccessSelections swModel, Nothing
Set swFixedFace = swFlatPatt.FixedFace
swFlatPatt.ReleaseSelectionAccess
End If

'get Bends
If swFeat.IsSuppressed = False Then
'Debug.Print swFeat.Name & " " & swFeat.GetTypeName2 & swFeat.IsSuppressed
Set swSubFeat = swFeat.GetFirstSubFeature
While Not swSubFeat Is Nothing
If swSubFeat.GetTypeName2 = "SketchBend" Or swSubFeat.GetTypeName2 = "OneBend" Or swSubFeat.GetTypeName2 = "UiFreeformBend" Then
ReDim Preserve swBends(i)
Set swBends(i) = swSubFeat
i = i + 1
End If
Set swSubFeat = swSubFeat.GetNextSubFeature
Wend
End If
Set swFeat = swFeat.GetNextFeature
Wend

'select fixed face and bends
boolstatus = swFixedFace.Select2(False, 1)
For i = 0 To UBound(swBends)
Set swFeat = swBends(i)
boolstatus = swFeat.Select2(True, 4)
Next
'insert Unfold feature
swModel.InsertSheetMetalUnfold

'create sketch
boolstatus = swFixedFace.Select2(False, -1)
swModel.SketchManager.InsertSketch True
swModel.SetAddToDB True
swModel.ClearSelection2 True
Set swFeat = swModel.FirstFeature
While Not swFeat Is Nothing
If swFeat.GetTypeName2 = "FlatPattern" Then
Set swSubFeat = swFeat.GetFirstSubFeature
While Not swSubFeat Is Nothing
If swSubFeat.GetTypeName2 = "ProfileFeature" Then
Set swSketch = swSubFeat.GetSpecificFeature2
ProcessSketch swSketch
End If
Set swSubFeat = swSubFeat.GetNextSubFeature()
Wend
End If
Set swFeat = swFeat.GetNextFeature
Wend
swModel.SetAddToDB False
swModel.SketchManager.InsertSketch True

'create notch cut
Set swFeat = swModel.FeatureManager.FeatureCut3(True, False, False, 1, 0, 0.01, 0.01, False, False, False, False, 0, 0, False, False, False, False, True, True, True, True, True, False, 0, 0, False)

'select fixed face and bends
boolstatus = swFixedFace.Select2(True, 1)
For i = 0 To UBound(swBends)
Set swFeat = swBends(i)
boolstatus = swFeat.Select2(True, 4)
Next
'insert Fold feature
swModel.InsertSheetMetalFold
End Sub

Sub ProcessSketch(swSketch As SldWorks.Sketch)
Dim vSketchSegs As Variant
Dim vSketchSeg As Variant
Dim swSketchLine As SldWorks.SketchLine
Dim swSkStartPt As SldWorks.SketchPoint
Dim swSkEndPt As SldWorks.SketchPoint
vSketchSegs = swSketch.GetSketchSegments
For Each vSketchSeg In vSketchSegs
Set swSketchLine = vSketchSeg
If swSketchLine.IsBendLine Then
Set swSkStartPt = swSketchLine.GetStartPoint2
Set swSkEndPt = swSketchLine.GetEndPoint2
DrawTriangle swSkStartPt, swSkEndPt, swSketchLine
DrawTriangle swSkEndPt, swSkStartPt, swSketchLine
End If
Next
End Sub

Sub DrawTriangle(swSkPt1 As SldWorks.SketchPoint, swSkPt2 As SldWorks.SketchPoint, swSketchLine As SldWorks.SketchLine)
Dim swSketch As SldWorks.Sketch
Dim swSketchSeg1 As SldWorks.SketchSegment, swSketchSeg2 As SldWorks.SketchSegment, swSketchSeg3 As SldWorks.SketchSegment
Dim swSketchRelationManager As SldWorks.SketchRelationManager
Dim swSketchRelation As SldWorks.SketchRelation
Dim X1 As Double, Y1 As Double, X2 As Double, Y2 As Double
Dim X3 As Double, Y3 As Double, X4 As Double, Y4 As Double
Dim Length As Double, Delta As Double
Dim swObjects(1) As Object

X1 = swSkPt1.X
Y1 = swSkPt1.Y
X2 = swSkPt2.X
Y2 = swSkPt2.Y

'set base triangle length to 1 mm
Delta = 0.001
Length = ((X2 - X1) ^ 2 + (Y2 - Y1) ^ 2) ^ 0.5

'create triangle sides
X3 = (X2 - X1) * Delta / Length + X1
Y3 = (Y2 - Y1) * Delta / Length + Y1
X4 = (Y2 - Y1) * Delta / 2 / Length + X1
Y4 = (X2 - X1) * Delta / 2 / Length + Y1
Set swSketchSeg1 = swModel.SketchManager.CreateLine(X3, Y3, 0#, X4, Y4, 0#)
X4 = -(Y2 - Y1) * Delta / 2 / Length + X1
Y4 = -(X2 - X1) * Delta / 2 / Length + Y1
Set swSketchSeg2 = swModel.SketchManager.CreateLine(X3, Y3, 0#, X4, Y4, 0#)

'create triangle base
X3 = (Y2 - Y1) * Delta / 2 / Length + X1
Y3 = (X2 - X1) * Delta / 2 / Length + Y1
X4 = -(Y2 - Y1) * Delta / 2 / Length + X1
Y4 = -(X2 - X1) * Delta / 2 / Length + Y1
Set swSketchSeg3 = swModel.SketchManager.CreateLine(X3, Y3, 0#, X4, Y4, 0#)

Set swSketch = swSketchSeg3.GetSketch
Set swSketchRelationManager = swSketch.RelationManager

'add equal length constraint between triangle sides
Set swObjects(0) = swSketchSeg1
Set swObjects(1) = swSketchSeg2
Set swSketchRelation = swSketchRelationManager.AddRelation(swObjects, swConstraintType_e.swConstraintType_SAMELENGTH)

'add middle constraint between triangle base and point
Set swObjects(0) = swSkPt1
Set swObjects(1) = swSketchSeg3
Set swSketchRelation = swSketchRelationManager.AddRelation(swObjects, swConstraintType_e.swConstraintType_ATMIDDLE)

'add perpendicular constraint between bend line and triangle base
Set swObjects(0) = swSketchLine
Set swObjects(1) = swSketchSeg3
Set swSketchRelation = swSketchRelationManager.AddRelation(swObjects, swConstraintType_e.swConstraintType_PERPENDICULAR)

If swPreviousSketchSeg Is Nothing Then
'add triangle base dimension
Dim swMathUtil As SldWorks.MathUtility
Dim swModelToSketchXForm As SldWorks.MathTransform
Set swModelToSketchXForm = swSketch.ModelToSketchTransform.Inverse
Set swMathUtil = swApp.GetMathUtility
Dim nPt(2) As Double
Dim vPt As Variant
nPt(0) = -(X2 - X1) * 0.001 / Length + X1
nPt(1) = -(Y2 - Y1) * 0.001 / Length + Y1
nPt(2) = 0
vPt = nPt
Dim swPt As SldWorks.MathPoint
Set swPt = swMathUtil.CreatePoint(vPt)
Set swPt = swPt.MultiplyTransform(swModelToSketchXForm)
swSketchSeg3.Select4 False, Nothing
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, False
Dim myDisplayDim As SldWorks.DisplayDimension
Set myDisplayDim = swModel.AddDimension2(swPt.ArrayData(0), swPt.ArrayData(1), swPt.ArrayData(2))
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, True
Else
'add equal length constraint between triangle base and previous triangle base
Set swObjects(0) = swPreviousSketchSeg
Set swObjects(1) = swSketchSeg3
Set swSketchRelation = swSketchRelationManager.AddRelation(swObjects, swConstraintType_e.swConstraintType_SAMELENGTH)
End If

'add equal length constraint between triangle base and side
Set swObjects(0) = swSketchSeg1
Set swObjects(1) = swSketchSeg3
Set swSketchRelation = swSketchRelationManager.AddRelation(swObjects, swConstraintType_e.swConstraintType_SAMELENGTH)

'save base triangle to constrain next triangle
Set swPreviousSketchSeg = swSketchSeg3
End Sub

Outcomes