# Calculate unit vector from a line?

Question asked by Thomas Bryant on Dec 15, 2015
Latest reply on Jan 12, 2016 by Renato Reginato

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

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

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