AnsweredAssumed Answered

Finding unit vector for each selected line

Question asked by Thomas Bryant on Jan 6, 2016
Latest reply on Jan 20, 2016 by Thomas Bryant



Thanks to some assistance from Ivana Kolin in the thread below, I was able to calculate a unit vector from a line and put the results into an Excel file from there.

The next step in the macro is to select multiple lines and have SolidWorks put all the calculations of the unit vectors in one message box and one Excel file (I would prefer not to have multiple popups). I would prefer to get results from only the lines that the user has selected, but all lines in the sketch would be ok too.


Calculate unit vector from a line?


Here's what I have tried so far:


Option Explicit

Sub Main()

    On Error Resume Next

    Dim swApp As SldWorks.SldWorks

    Dim swModel As SldWorks.ModelDoc2

    Dim swMathUtil As SldWorks.MathUtility

    Dim swSelMgr As SldWorks.SelectionMgr

    Dim swSketchLine As SldWorks.SketchLine

    Dim oMyLine As Object

    Dim oMathVector As SldWorks.MathVector

    Dim oUnitVector As SldWorks.MathVector

    Dim vPt1 As Variant

    Dim vPt2 As Variant

    Dim dArr(2) As Double

    Dim i As Long

    Dim j As Long

    Dim dArrUnit As Variant

    Dim xlApp As Excel.Application

    Dim xlWorkbook As Excel.Workbook

    Dim swStartPt As SldWorks.SketchPoint

    Dim swEndPt As SldWorks.SketchPoint

    Dim NumberOfSelectedItems

    Dim swSelBody As SldWorks.Body2



    Set swApp = Application.SldWorks

    If Not swApp Is Nothing Then

        Set swModel = swApp.ActiveDoc

        Set swMathUtil = swApp.GetMathUtility

        If Not swModel Is Nothing And Not swMathUtil Is Nothing Then

            Set swSelMgr = swModel.SelectionManager

            Set swSketchLine = swSelMgr.GetSelectedObject6(1, -1)

            If Not swSketchLine Is Nothing Then

                Set swEndPt = swSketchLine.GetEndPoint2

                Set swStartPt = swSketchLine.GetStartPoint2

                dArr(0) = swEndPt.X

                dArr(1) = swEndPt.Y

                dArr(2) = swEndPt.Z

                vPt1 = dArr

                vPt2 = dArr


                dArr(0) = swStartPt.X

                dArr(1) = swStartPt.Y

                dArr(2) = swStartPt.Z


                dArr(0) = vPt2(0) - vPt1(0)

                dArr(1) = vPt2(1) - vPt1(1)

                dArr(2) = vPt2(2) - vPt2(2)


                NumberOfSelectedItems = swSelMgr.GetSelectedObjectsCount2(-1)

                For j = 1 To NumberOfSelectedItems

                ReDim swSelBody(1 To NumberOfSelectedItems)

                Set oMathVector = swMathUtil.CreateVector(dArr)

                If Not oMathVector Is Nothing Then

                    Set oUnitVector = oMathVector.Normalise()

                    dArrUnit = oUnitVector.ArrayData()

                    MsgBox ("Line vector is " & dArr(0) & "i + " & dArr(1) & "j + " & dArr(2) & "k" & vbCrLf & "Unit vector is " & dArrUnit(0) & "i + " & dArrUnit(1) & "j + " & dArrUnit(2) & "k"\n)

                    Set oUnitVector = Nothing

                    'set array here


                    Set oMathVector = Nothing

                End If

                Next j

                Set oMyLine = Nothing

                Set swSelMgr = Nothing

            End If

            Set swSketchLine = Nothing

        End If

        Set swModel = Nothing

        Set swMathUtil = Nothing

    End If



    'get the results into excel

    Set xlApp = CreateObject("Excel.Application")

    xlApp.Visible = True

    Set xlWorkbook = xlApp.Workbooks.Add

    With xlWorkbook.Worksheets(1)

        .Cells(1, 1).Value = "i"

        .Cells(1, 2).Value = "j"

        .Cells(1, 3).Value = "k"

        .Cells(i + 2, 1).Value = dArrUnit(0)

        .Cells(i + 2, 2).Value = dArrUnit(1)

        .Cells(i + 2, 3).Value = dArrUnit(2)

    End With

    Set xlWorkbook = Nothing

    Set xlApp = Nothing

End Sub


Thanks for any assistance.