9 Replies Latest reply on Jan 20, 2016 3:12 PM by Thomas Bryant

    Finding unit vector for each selected line

    Thomas Bryant

      Hello,

       

      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

                          oUnitVector.ArrayData(dArrUnit(0),dArrUnit(1),dArrUnit(2))

                          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.

        • Re: Finding unit vector for each selected line
          Michael Spens

          Hi Thomas,

               There were some order problems with your arrays and Writing to Excel needed to be in the For loop.  I've also concatenated your messagebox message into a string to report at the end.  This assumes the user has selected lines in a sketch.

           

          Option Explicit

          Dim xlApp As Excel.Application

          Dim xlWorkbook As Excel.Workbook

           

           

          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 bRes As Boolean

              Dim Message As String

           

           

             

              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

                      NumberOfSelectedItems = swSelMgr.GetSelectedObjectCount2(-1)

                      If NumberOfSelectedItems > 0 Then

                          'initialize Excel

                          Call GetExcel

                      End If

                      For j = 1 To NumberOfSelectedItems

                         Set swSketchLine = swSelMgr.GetSelectedObject6(j, -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()

                                  Message = Message & "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" & vbCrLf

                                  Set oUnitVector = Nothing

                                  Set oMathVector = Nothing

                              End If

                              'write two lines to Excel, so startrow is counted by 2

                              bRes = WriteToExcel(((j - 1) * 4) + 1, dArr, "Line")

                              bRes = WriteToExcel(((j - 1) * 4) + 3, dArrUnit, "Unit")

                          End If

                      Next j

                      Set oMyLine = Nothing

                      Set swSelMgr = Nothing

                      Set swSketchLine = Nothing

                  End If

                  Set swModel = Nothing

                  Set swMathUtil = Nothing

              End If

          'show the message

          MsgBox Message

          End Sub

           

           

          Private Sub GetExcel()

              Set xlApp = CreateObject("Excel.Application")

              xlApp.Visible = True

              Set xlWorkbook = xlApp.Workbooks.Add

          End Sub

           

           

          Private Function WriteToExcel(startRow As Integer, data As Variant, Optional label As String = "") As Boolean

              'get the results into excel

              With xlWorkbook.ActiveSheet

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

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

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

                  .Cells(startRow, 4).Value = label

                  .Cells(startRow + 1, 1).Value = data(0)

                  .Cells(startRow + 1, 2).Value = data(1)

                  .Cells(startRow + 1, 3).Value = data(2)

              End With

          End Function

            • Re: Finding unit vector for each selected line
              Thomas Bryant

              Hi Michael,

               

              Thanks, this appears to be what I was looking for! I would still like to test it more.

               

              I have one question though, what does bRes stand for? Boolean resolution?

                • Re: Finding unit vector for each selected line
                  Michael Spens

                  Boolean result.  But it's worthless in the code above.  Read on for the back-story...

                   

                  When I use VBA macros, I (try to) get in the habit of making every additional procedure into a Function.  It's not necessary, but it has the nice benefit of forcing the macro to always start in main().  Saved macros don't have any direction to help them know what procedure they should start from.  Other users get in the habit of moving the main procedure to the end of the code module, and that works too.  I realize I'm not 100% consistent in the above example since GetExcel is still just a procedure.

                   

                  In this example, WriteToExcel could return a Boolean (but if you look at the function, it doesn't).  So, yes, I'm collecting a return value when I call the WriteToExcel function that will always be False (default Boolean value). 

                   

                  Yes, we're all hacks here in the forum!

                    • Re: Finding unit vector for each selected line
                      Thomas Bryant

                      Ha, I love that explanation!

                       

                      This is hopefully the last question; every time I run the macro, regardless of which I plane I draw the lines in, the Z-coordinate points to zero, when I know that from the top plane, Y should be zero and from the right plane, X should be zero. Is something wrong with the vector equations, or is that how it's supposed to be?

                        • Re: Finding unit vector for each selected line
                          Michael Spens

                          This is by design.  Every sketch has its own coordinate system based on X and Y.  In a 2D sketch, the Z value will always be zero and coordinates will be local.  If you need the sketch vector data in model coordinates, you'll need to transform the results.  There is some good sample code in the API help here...

                          2015 SOLIDWORKS API Help - Transform Coordinates from Sketch to Model Space Example (VBA)

                            • Re: Finding unit vector for each selected line
                              Renato Reginato

                              Hello,

                              I'm finding too a way to export the Z value, or the cosine refer to Z (I notice that the Lines vector in the macro are connected with direction cosines of X-Y). Is there a way to integrate in the macro to measure the angle between the line in the sketch and Z axis?

                              I try to run the exemple posted in the link, but maybe I make a mistake because it doesn't give the results transformed.

                               

                              Thanks

                              • Re: Finding unit vector for each selected line
                                Thomas Bryant

                                Hello again Michael,

                                 

                                Thanks for the link, unfortunately when I try to put the results in Excel (I've just been trying to do the start point), it comes up blank, and only the Y point comes up in the message box when I change that variable to vModelSelPt1. Is there something small wrong here that I'm not seeing? Thanks.

                                 

                                Option Explicit

                                 

                                Dim xlApp As Excel.Application

                                 

                                Dim xlWorkbook As Excel.Workbook

                                 

                                Public Function GetModelCoordinates _

                                ( _

                                    swApp As SldWorks.SldWorks, _

                                    swSketch As SldWorks.Sketch, _

                                    vPtArr As Variant _

                                ) As Variant

                                    Dim swMathPt As SldWorks.MathPoint

                                    Dim swMathUtil As SldWorks.MathUtility

                                    Dim swMathTrans As SldWorks.MathTransform

                                    Set swMathUtil = swApp.GetMathUtility

                                    Set swMathPt = swMathUtil.CreatePoint(vPtArr)

                                    Set swMathTrans = swSketch.ModelToSketchTransform

                                    Set swMathTrans = swMathTrans.Inverse

                                    Set swMathPt = swMathPt.MultiplyTransform(swMathTrans)

                                    GetModelCoordinates = swMathPt.ArrayData

                                 

                                End Function

                                 

                                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 l As Long

                                  

                                    Dim m As Long

                                  

                                    Dim n As Long

                                 

                                    Dim dArrUnit As Variant

                                 

                                    Dim bRes As Boolean

                                 

                                    Dim Message As String

                                    Dim startRow As Double

                                 

                                    Dim swStartPt As SldWorks.SketchPoint

                                 

                                    Dim swEndPt As SldWorks.SketchPoint

                                 

                                    Dim NumberOfSelectedItems

                                 

                                    Dim swSelBody As SldWorks.Body2

                                  

                                    Dim vModelSelPt1 As Variant

                                  

                                    Dim vModelSelPt2 As Variant

                                  

                                    Dim swSketch As SldWorks.Sketch

                                 

                                    Set swApp = Application.SldWorks

                                  

                                    Set swModel = swApp.ActiveDoc

                                  

                                    Set swSelMgr = swModel.SelectionManager

                                  

                                    Set swSketch = swModel.GetActiveSketch2

                                  

                                    Set swStartPt = swSketchLine.GetStartPoint2

                                 

                                    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

                                 

                                            NumberOfSelectedItems = swSelMgr.GetSelectedObjectCount2(-1)

                                 

                                            If NumberOfSelectedItems > 0 Then

                                 

                                                'initialize Excel

                                 

                                                Call GetExcel

                                 

                                            End If

                                 

                                            For l = 1 To NumberOfSelectedItems

                                 

                                               Set swSketchLine = swSelMgr.GetSelectedObject6(l, -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) - vPt1(2)

                                 

                                           'look here for the lines I added

                                 

                                                   swStartPt = swSelMgr.GetSelectionPointInSketchSpace(1)

                                  

                                                    vModelSelPt1(0) = GetModelCoordinates(swApp, swSketch, swStartPt)

                                          'end lines I added

                                 

                                                    Set oMathVector = swMathUtil.CreateVector(dArr)

                                 

                                                    If Not oMathVector Is Nothing Then

                                 

                                                        Set oUnitVector = oMathVector.Normalise()

                                 

                                                        dArrUnit = oUnitVector.ArrayData()

                                 

                                                        Message = Message & "Magnitude for start point is " & vbCrLf & "X: " & (swStartPt.X * 1000) & " mm" & " Y: " & (swStartPt.Y * 1000) & " mm" & " Z: " & (swStartPt.Z * 1000) & " mm" & vbCrLf & "Magnitude for end point is " & vbCrLf & "X: " & (swEndPt.X * 1000) & " mm" & " Y: " & (swEndPt.Y * 1000) & " mm" & " Z: " & (swEndPt.Z * 1000) & " mm" & vbCrLf & "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" & vbCrLf

                                 

                                                        Set oUnitVector = Nothing

                                 

                                                        Set oMathVector = Nothing

                                 

                                                    End If

                                 

                                                    'write two lines to Excel, so startrow is counted by 2

                                                  

                                                    bRes = WriteToExcel(((l - 1) * 8) + 1, vModelSelPt1, "Magnitude for Start Point")

                                                  

                                                    bRes = WriteToExcel(((l - 1) * 8) + 3, vPt2, "Magnitude for End Point")

                                 

                                                    bRes = WriteToExcel(((l - 1) * 8) + 5, dArr, "Line Vector")

                                 

                                                    bRes = WriteToExcel(((l - 1) * 8) + 7, dArrUnit, "Unit Vector")

                                 

                                                End If

                                 

                                            Next l

                                          

                                           startRow = 1

                                         

                                    For m = 1 To NumberOfSelectedItems

                                         

                                    For n = 1 To 3 Step 2

                                 

                                    With xlWorkbook.ActiveSheet

                                    

                                    startRow = (8 * m) + n - 4

                                      

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

                                 

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

                                 

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

                                      

                                    End With

                                  

                                    Next n

                                  

                                    Next m

                                         

                                            Set oMyLine = Nothing

                                 

                                            Set swSelMgr = Nothing

                                 

                                            Set swSketchLine = Nothing

                                 

                                        End If

                                 

                                        Set swModel = Nothing

                                 

                                        Set swMathUtil = Nothing

                                 

                                    End If

                                 

                                'show the message

                                 

                                MsgBox Message

                                 

                                End Sub

                                 

                                 

                                Private Sub GetExcel()

                                 

                                    Set xlApp = CreateObject("Excel.Application")

                                 

                                    xlApp.Visible = True

                                 

                                    Set xlWorkbook = xlApp.Workbooks.Add

                                 

                                End Sub

                                 

                                 

                                Private Function WriteToExcel(startRow As Integer, data As Variant, Optional label As String = "") As Boolean

                                 

                                    'get the results into excel

                                 

                                    With xlWorkbook.ActiveSheet

                                  

                                        .Cells(startRow, 1).Value = "X"

                                 

                                        .Cells(startRow, 2).Value = "Y"

                                 

                                        .Cells(startRow, 3).Value = "Z"

                                 

                                        .Cells(startRow, 4).Value = label

                                      

                                        .Cells(startRow + 1, 1).Value = data(0)

                                 

                                        .Cells(startRow + 1, 2).Value = data(1)

                                 

                                        .Cells(startRow + 1, 3).Value = data(2)

                                      

                                    End With

                                 

                                End Function

                                  • Re: Finding unit vector for each selected line
                                    Michael Spens

                                    Hi Thomas,

                                    It looks like you were trying to push a 3 element array into a single array element.  Update your modifications like the following...

                                     

                                               'look here for the lines I added

                                                       swStartPt = swSelMgr.GetSelectionPointInSketchSpace(1)

                                                      vModelSelPt1 = GetModelCoordinates(swApp, swSketch, swStartPt)

                                              'end lines I added

                                     

                                    Mike

                                      • Re: Finding unit vector for each selected line
                                        Thomas Bryant

                                        Hi Michael,

                                         

                                        I've tried that already, as well as setting the values in the message box that correspond to that start point to vModelSelPt1(0), vModelSelPt1(1), and vModelSelPt1(2) like so:

                                         

                                        Message = Message & "Magnitude for start point is " & vbCrLf & "X: " & (vModelSelPt1(0) * 1000#) & " mm" & " Y: " & (vModelSelPt1(1) * 1000#) & " mm" & " Z: " & (vModelSelPt1(2) * 1000#) & " mm" & vbCrLf & "Magnitude for end point is " & vbCrLf & "X: " & (swEndPt.X * 1000) & " mm" & " Y: " & (swEndPt.Y * 1000) & " mm" & " Z: " & (swEndPt.Z * 1000) & " mm" & vbCrLf & "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" & vbCrLf

                                         

                                        but those don't return any values; in fact,it returns the message box empty. Any ideas?

                                         

                                        Thanks,

                                         

                                        Thomas