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

Following this thread:

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.

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

SolidworksApi/macros