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.
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