I would like to create a macro that is similar to Rajat Jain’s in reply #8 of this thread:

https://forum.solidworks.com/thread/41514

Only instead of using an axis, I would like to calculate the unit vector from a line drawn by the user, and put it into Excel from there.

Here’s what I’ve tried so far. It only gives a blank Excel file with the i, j, k variables. Advice would be appreciated.

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 oFeature1       As SldWorks.Feature

    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 dArrUnit As Variant

    Dim xlApp As Excel.Application

    Dim xlWorkbook As Excel.Workbook

    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 oFeature1 = swSelMgr.GetSelectedObject6(1, -1)

                If Not oFeature1 Is Nothing Then

                    Set oMyLine = oFeature1.GetSpecificFeature2()

                    If Not oMyLine Is Nothing Then

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

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

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

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")

Set oUnitVector = Nothing

End If

Set oMathVector = Nothing

End If

Set oMyLine = Nothing

Set swSelMgr = Nothing

                End If

                Set oFeature1 = 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