6 Replies Latest reply on Jan 29, 2016 11:00 AM by Thomas Bryant

    Problem with transforming sketch coordinates to model coordinates

    Thomas Bryant

      Hello all,

       

      I am in the ongoing process of writing a macro to extract the line and unit vectors from multiple lines, and am close to getting there except for some trouble with transforming the sketch coordinates to model coordinates. I’m only trying to transform the start point now, but will want to transform the end point, line vector, and unit vector as well in both the message box and Excel. Currently, when I try to run it, the message box comes up blank. I have a feeling something simple is wrong, but I’m just not sure what it is. Here’s the code I have so far:

       

      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 swSketch As SldWorks.Sketch

       

          Set swApp = Application.SldWorks

         

          Set swModel = swApp.ActiveDoc

         

          Set swSelMgr = swModel.SelectionManager

         

          Set swSketch = swModel.GetActiveSketch2

       

          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)

       

      Set oMathVector = swMathUtil.CreateVector(dArr)

                         

      swStartPt = swSelMgr.GetSelectionPointInSketchSpace(1)

         

      vModelSelPt1 = GetModelCoordinates(swApp, swSketch, swStartPt)

             

      If Not oMathVector Is Nothing Then

       

      Set oUnitVector = oMathVector.Normalise()

       

      dArrUnit = oUnitVector.ArrayData()

       

      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

       

      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, vPt1, "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

       

      I also tried Matt Martens’ suggestion of setting vPtModelSel1 to model arrays but that did not work either; they show up as 0:

       

      Dim vModelSelPt1(2) As Double

      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

       

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

        • Re: Problem with transforming sketch coordinates to model coordinates
          Artem Taturevych

          Hi Thomas,

           

          Should be

           

          vModelSelPt1 = GetModelCoordinates(swApp, swSketch, vPt1)

           

          instead of

           

           

          vModelSelPt1 = GetModelCoordinates(swApp, swSketch, swStartPt)

           

           

          Thanks,

          Artem

            • Re: Problem with transforming sketch coordinates to model coordinates
              Thomas Bryant

              Hi Artem,

               

              I tried that (I have over the past week as well), but the message box still shows up as blank for me. Anything in the message box that might need to be changed?

               

              Set oMathVector = swMathUtil.CreateVector(dArr)
              swStartPt = swSelMgr.GetSelectionPointInSketchSpace(1)

                

              vModelSelPt1 = GetModelCoordinates(swApp, swSketch, vPt1)
              If Not oMathVector Is Nothing Then

               

              Set oUnitVector = oMathVector.Normalise()

               

              dArrUnit = oUnitVector.ArrayData()

               

              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

               

              Set oUnitVector = Nothing

               

              Set oMathVector = Nothing

               

              End If

               

              Thanks,

               

              Thomas

                • Re: Problem with transforming sketch coordinates to model coordinates
                  Artem Taturevych

                  Hi Thomas,

                   

                  So you point is calculated correctly but the message box is blank, is this right? There seems to be no MsgBox function in the code you posted. There is only Message which looks like a variable to me. Have you tried something like MsgBox Message?

                   

                  Thanks,

                  Artem

                    • Re: Problem with transforming sketch coordinates to model coordinates
                      Thomas Bryant

                      Hi Artem,

                       

                      The message function prints the relevant information when swStartPt.X, swStartPt.Y, and swStartPt.Z (the sketch coordinates) are stored there. It was only after I switched them out with vModelSelPt(0), vModelSelPt(1), and vModelSelPt(2) (the model coordinates) that it started showing up as blank.

                       

                      And yes, MsgBox Message is at the end of the Main Sub function, and I've tried variations of MsgBox Message where the message prints out and that did not work either.

                       

                      The relevant Excel line also goes blank when I change the first first bRes = WriteToExcel line from vPt1 to vModelSelPt1, so I think the coordinates are not being read correctly.

                       

                      Here's the entire code so there's no confusion:

                       

                      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

                       

                          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)

                       

                                          Set oMathVector = swMathUtil.CreateVector(dArr)

                                        

                                          Set swStartPt = swSelMgr.GetSelectionPointInSketchSpace(1)

                        

                                          vModelSelPt1 = GetModelCoordinates(swApp, swSketch, vPt1)

                            

                                          If Not oMathVector Is Nothing Then

                       

                                              Set oUnitVector = oMathVector.Normalise()

                       

                                              dArrUnit = oUnitVector.ArrayData()

                       

                                              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

                       

                                              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, vPt1, "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

                       

                      'end code

                       

                      Thanks,

                       

                      Thomas

                        • Re: Problem with transforming sketch coordinates to model coordinates
                          Artem Taturevych

                          Hi Thomas,

                           

                          Thank you for the complete macro. I understand the problem.

                           

                          The macro will work OK if you are selecting the line in the active sketch. You have the following line which gets the pointer to the active sketch:

                           

                          Set swSketch = swModel.GetActiveSketch2

                           

                          otherwise your sketch is NULL.

                           

                          Fortunately you can get the pointer to sketch directly from your line so both cases (sketch is open or not) may be handled equally. Just add the following line in red to your macro.

                           

                          For l = 1 To NumberOfSelectedItems

                           

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

                           

                                         If Not swSketchLine Is Nothing Then

                                             

                                             Set swSketch = swSketchLine.GetSketch

                                             Set swEndPt = swSketchLine.GetEndPoint2

                           

                          The reason why you have an empty message is the line at the very beginning of your macro

                           

                          On Error Resume Next

                           

                          Which means if there is any error or exception - just continue execution silently. And you have an exception in GetModelCoordinates method because swSketch is null.

                           

                          I would recommend to not use 'On Error Resume Next' while debugging. Either comment it or use 'On Error Go To ...' statement and process the error.

                           

                          Thanks,

                          Artem