10 Replies Latest reply on Jan 12, 2016 11:54 AM by Renato Reginato

    Calculate unit vector from a line?

    Thomas Bryant

      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

        • Re: Calculate unit vector from a line?
          Ivana Kolin
          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 dArrUnit As Variant
              Dim xlApp As Excel.Application
              Dim xlWorkbook As Excel.Workbook
              Dim swStartPt As SldWorks.SketchPoint
          
          
              Dim swEndPt As SldWorks.SketchPoint
          
          
          
          
              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
                          vPt2 = dArr
          
          
                          dArr(0) = swStartPt.X
                          dArr(1) = swStartPt.Y
                          dArr(2) = swStartPt.Z
                          vPt1 = dArr
          
          
                          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
          
          
                              Set oMathVector = Nothing
                          End If
                          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