ds-blue-logo
Preview  |  SOLIDWORKS USER FORUM
Use your SOLIDWORKS ID or 3DEXPERIENCE ID to log in.
FRFifi Riri19/03/2019

Hi everyone,

This macro will draw small red lines at each bend lines extremities on a sheet metal drawing.

It is based on John Alexanderreply on this thread:

it will work with rotated views and bend lines with angles.

Part5.JPG

Option Explicit

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swDraw As SldWorks.DrawingDoc

Dim swView As SldWorks.View

Dim swMathUtil As SldWorks.MathUtility

Dim BendlinesArr As Variant

Dim Bendline As Variant

Dim swSketch As SldWorks.Sketch

Dim swModelToViewXForm As SldWorks.MathTransform

Dim swModelToSketchXForm As SldWorks.MathTransform

Dim swDrawingToViewXForm As SldWorks.MathTransform

Dim swSketchLine As SldWorks.SketchLine

Dim swSkStartPt As SldWorks.SketchPoint

Dim swSkEndPt As SldWorks.SketchPoint

Dim swSketchSeg As SldWorks.SketchSegment

Dim nPt(2) As Double

Dim vPt As Variant

Dim swStartPt As SldWorks.MathPoint

Dim swEndPt As SldWorks.MathPoint

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

Sub main()

Set swApp = Application.SldWorks

Set swMathUtil = swApp.GetMathUtility

Set swModel = swApp.ActiveDoc

Set swDraw = swModel

Set swView = swDraw.GetFirstView

Set swView = swView.GetNextView

Dim swLayerMgr As SldWorks.LayerMgr

Set swLayerMgr = swModel.GetLayerManager

Dim SavedLayerName As String

SavedLayerName = swLayerMgr.GetCurrentLayer

'Optional: Add lines to new layer

'swLayerMgr.AddLayer "myNewLayer", "", 0, 0, 0

'Optional: Add lines to existing layer

'swLayerMgr.SetCurrentLayer "myExistingLayer"

While Not swView Is Nothing

If swView.IsFlatPatternView Then

swDraw.ActivateView swView.GetName2

If swView.GetBendLineCount > 0 Then

BendlinesArr = swView.GetBendLines

For Each Bendline In BendlinesArr

Set swSketchLine = Bendline

If swSketchLine.IsBendLine Then

Set swSkStartPt = swSketchLine.GetStartPoint2

Set swSkEndPt = swSketchLine.GetEndPoint2

Set swSketch = swSketchLine.GetSketch

Set swModelToSketchXForm = swSketch.ModelToSketchTransform.Inverse

Set swModelToViewXForm = swView.ModelToViewTransform

Set swDrawingToViewXForm = drawingToViewTransform(swView).Inverse

nPt(0) = swSkStartPt.X

nPt(1) = swSkStartPt.Y

nPt(2) = swSkStartPt.Z

vPt = nPt

Set swStartPt = swMathUtil.CreatePoint(vPt)

Set swStartPt = swStartPt.MultiplyTransform(swModelToSketchXForm)

Set swStartPt = swStartPt.MultiplyTransform(swModelToViewXForm)

Set swStartPt = swStartPt.MultiplyTransform(swDrawingToViewXForm)

nPt(0) = swSkEndPt.X

nPt(1) = swSkEndPt.Y

nPt(2) = swSkEndPt.Z

vPt = nPt

Set swEndPt = swMathUtil.CreatePoint(vPt)

Set swEndPt = swEndPt.MultiplyTransform(swModelToSketchXForm)

Set swEndPt = swEndPt.MultiplyTransform(swModelToViewXForm)

Set swEndPt = swEndPt.MultiplyTransform(swDrawingToViewXForm)

X1 = swStartPt.ArrayData(0)

Y1 = swStartPt.ArrayData(1)

X2 = swEndPt.ArrayData(0)

Y2 = swEndPt.ArrayData(1)

Set swSketchSeg = swSketchLine

'set lines length to 3mm

Delta = 0.003

Length = swSketchSeg.GetLength

X3 = (X2 - X1) * Delta / Length + X1

Y3 = (Y2 - Y1) * Delta / Length + Y1

X4 = (X1 - X2) * Delta / Length + X2

Y4 = (Y1 - Y2) * Delta / Length + Y2

'make lines start at 0.5 mm from edges

Delta = 0.0005

X1 = (X2 - X1) * Delta / Length + X1

Y1 = (Y2 - Y1) * Delta / Length + Y1

X2 = (X1 - X2) * Delta / Length + X2

Y2 = (Y1 - Y2) * Delta / Length + Y2

swModel.SetAddToDB True

Set swSketchSeg = swModel.SketchManager.CreateLine(X1, Y1, 0#, X3, Y3, 0#)

swSketchSeg.Color = RGB(255, 0, 0)

Set swSketchSeg = swModel.SketchManager.CreateLine(X2, Y2, 0#, X4, Y4, 0#)

swSketchSeg.Color = RGB(255, 0, 0)

swModel.SetAddToDB False

End If

Next

End If

End If

Set swView = swView.GetNextView

Wend

swLayerMgr.SetCurrentLayer SavedLayerName

swModel.ClearSelection2 True

End Sub

Function drawingToViewTransform(swView As SldWorks.View) As SldWorks.MathTransform

Dim swMathUtil As SldWorks.MathUtility

Dim transformData(15) As Double

Set swMathUtil = swApp.GetMathUtility

transformData(0) = Cos(swView.Angle)

transformData(1) = Sin(swView.Angle)

transformData(2) = 0#

transformData(3) = -Sin(swView.Angle)

transformData(4) = Cos(swView.Angle)

transformData(5) = 0#

transformData(6) = 0#

transformData(7) = 0#

transformData(8) = 1#

transformData(9) = swView.Position(0)

transformData(10) = swView.Position(1)

transformData(11) = 0#

transformData(12) = swView.ScaleDecimal

transformData(13) = 0#

transformData(14) = 0#

transformData(15) = 0#

Set drawingToViewTransform = swMathUtil.CreateTransform(transformData)

End Function