8 Replies Latest reply on Feb 15, 2016 11:25 AM by Thomas Bryant

    Exporting coordinates from a point and transforming the coordinates from sketch to model

    Thomas Bryant

      I would like to create a macro that finds multiple points from multiple 3d sketches and exports the data into a message box and Excel in model coordinates. I've tried various macros online, but none of them seem to compile due to various runtime errors.

       

      I also tried the code in the below links but that did not work either:

       

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

       

      Macro to capture points in 3d sketch and export to excel

       

      I always get a "Runtime error 424: Object required" error (or similar ones), whether I try the code in the above link or my code below. Do I have to do something differently in SolidWorks 2016, or is it just overly complicated?

       

      Option Explicit

       

      Dim xlApp As Excel.Application

       

      Dim xlWorkbook As Excel.Workbook

       

      Public Function GetModelCoordinates _

      ( _

          swApp As SldWorks.SldWorks, _

          swPoint As SldWorks.MathPoint, _

          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 = SldWorks.MathTransform

          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 vPt1 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 swPoint As SldWorks.SketchPoint

       

          Dim NumberOfSelectedItems

       

          Dim swSelBody As SldWorks.Body2

        

          Dim vModelSelPt1 As Variant

            

          Dim DEC As Double

        

          Dim swSketch As SldWorks.Sketch

        

          Const UnitFactor As Double = 1000 'Get from m to mm

       

          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 swPoint = swSelMgr.GetSelectionPoint2(l, -1)

       

                     If Not swPoint Is Nothing Then

       

                         Set swPoint = swPoint.GetPoint2

                       

                         DEC = 6

       

                         dArr(0) = FormatNumber(swPoint.X, DEC)

       

                         dArr(1) = FormatNumber(swPoint.Y, DEC)

       

                         dArr(2) = FormatNumber(swPoint.Z, DEC)

       

                         vPt1 = dArr

        

                          vModelSelPt1 = GetModelCoordinates(swApp, swPoint, vPt1)

       

                              Message = Message & "Coordinates for Centerpoint is " & vbCrLf & "X: " & (vModelSelPt1(0) * UnitFactor) & " mm" & " Y: " & (vModelSelPt1(1) * UnitFactor) & " mm" & " Z: " & (vModelSelPt1(2) * UnitFactor) & " mm" & vbCrLf

       

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

                        

                          bRes = WriteToExcel(((l - 1) * 2) + 1, vModelSelPt1, "Coordinates from Centerpoint")

       

                      End If

       

                  Next l

       

      startRow = 1

               

          For m = 1 To NumberOfSelectedItems

               

          For n = 1 To 3 Step 2

       

          With xlWorkbook.ActiveSheet

          

          startRow = (4 * m) + n - 2

            

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

       

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

       

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

            

          End With

        

          Next n

        

          Next m

       

                  Set swSelMgr = Nothing

       

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

       

      Thanks for any assistance!

        • Re: Exporting coordinates from a point and transforming the coordinates from sketch to model
          Simon Turner

          This line is wrong:

          Set swMathTrans = SldWorks.MathTransform

          What you want to do is to get the transform associated to the sketch that the point comes from. The above line does nothing (except cause an error).

           

          Also, you have declared GetModelCoordinates as follows:

          Public Function GetModelCoordinates (swApp As SldWorks.SldWorks, swPoint As SldWorks.MathPoint, vPtArr As Variant ) As Variant

           

          But you pass in a SketchPoint for swPoint, not a MathPoint. Try declaring GetModelCoordinates like this:

           

          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

           

          Call it by passing in swApp, swSketch, vPt1

            • Re: Exporting coordinates from a point and transforming the coordinates from sketch to model
              Thomas Bryant

              Hi Simon,

               

              I tried that but still got the same error with this line highlighted:

               

              Set swPoint = swSelMgr.GetSelectionPoint2(l, -1)

               

              I also would like the user to select only the point, not the entire sketch. Here's the updated code:

               

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

               

                  Dim swApp As SldWorks.SldWorks

               

                  Dim swModel As SldWorks.ModelDoc2

               

                  Dim swMathUtil As SldWorks.MathUtility

               

                  Dim swSelMgr As SldWorks.SelectionMgr

               

                  Dim vPt1 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 swPoint As SldWorks.SketchPoint

               

                  Dim NumberOfSelectedItems

               

                  Dim swSelBody As SldWorks.Body2

                

                  Dim vModelSelPt1 As Variant

                    

                  Dim DEC As Double

                

                  Dim swSketch As SldWorks.Sketch

                

                  Const UnitFactor As Double = 1000 'Get from m to mm

               

                  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 swPoint = swSelMgr.GetSelectionPoint2(l, -1)

               

                             If Not swPoint Is Nothing Then

               

                                 Set swPoint = swPoint.GetPoint2

                               

                                 DEC = 6

               

                                 dArr(0) = FormatNumber(swPoint.X, DEC)

               

                                 dArr(1) = FormatNumber(swPoint.Y, DEC)

               

                                 dArr(2) = FormatNumber(swPoint.Z, DEC)

               

                                 vPt1 = dArr

                

                                  vModelSelPt1 = GetModelCoordinates(swApp, swSketch, vPt1)

               

                                      Message = Message & "Coordinates for Centerpoint is " & vbCrLf & "X: " & (vModelSelPt1(0) * UnitFactor) & " mm" & " Y: " & (vModelSelPt1(1) * UnitFactor) & " mm" & " Z: " & (vModelSelPt1(2) * UnitFactor) & " mm" & vbCrLf

                                

                                  bRes = WriteToExcel(((l - 1) * 2) + 1, vModelSelPt1, "Coordinates from Centerpoint")

               

                              End If

               

                          Next l

               

              startRow = 1

                       

                  For m = 1 To NumberOfSelectedItems

                       

                  For n = 1 To 3 Step 2

               

                  With xlWorkbook.ActiveSheet

                  

                  startRow = (4 * m) + n - 2

                    

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

               

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

               

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

                    

                  End With

                

                  Next n

                

                  Next m

               

                          Set swSelMgr = Nothing

               

                          Set swPoint = 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: Exporting coordinates from a point and transforming the coordinates from sketch to model
                  Simon Turner

                  GetSelectionPoint2 returns an array of 3 doubles (x,y,z), not a sketch point.

                  I can see that your code insists on there being an active sketch, so if the user selects a point, it is the point that will be returned by GetSelectedObject6, not a sketch.

                  But you can still use GetSelectedObjectType3 to check the type of thing that has been selected, and only process swSelSketchPoints

                  You should do that anyway, to avoid other things such as sketch lines being selected.

                    • Re: Exporting coordinates from a point and transforming the coordinates from sketch to model
                      Thomas Bryant

                      Hi Simon,

                       

                      I used GetSelectedObjectType3 by wrapping an if statement around the message box, but the message box just returns a blank box. Is there anything specific I need to do with swSelSketchPoints? Find code below:

                       

                      Thanks,

                       

                      Thomas

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

                       

                          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 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 swPoint As SldWorks.SketchPoint

                       

                          Dim NumberOfSelectedItems

                       

                          Dim swSelBody As SldWorks.Body2

                        

                          Dim vModelSelPt1 As Variant

                        

                          Dim vModelSelPt2 As Variant

                        

                          Dim vModelSelPt3 As Variant

                        

                          Dim vModelSelPt4 As Variant

                        

                          Dim DEC As Double

                        

                          Dim swSketch As SldWorks.Sketch

                        

                          Const UnitFactor As Double = 1000 'Get from m to mm

                       

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

                       

                                     If Not swPoint Is Nothing Then

                                   

                                         'Set swSketch = swSketchLine.GetSketch

                       

                                         Set swSketch = swPoint.GetSketch

                                       

                                         DEC = 6

                       

                                         'dArr(0) = FormatNumber(swEndPt.X, DEC)

                       

                                         'dArr(1) = FormatNumber(swEndPt.Y, DEC)

                       

                                         'dArr(2) = FormatNumber(swEndPt.Z, DEC)

                       

                                         'vPt2 = dArr

                       

                                         dArr(0) = FormatNumber(swPoint.X, DEC)

                       

                                         dArr(1) = FormatNumber(swPoint.Y, DEC)

                       

                                         dArr(2) = FormatNumber(swPoint.Z, DEC)

                       

                                         vPt1 = dArr

                       

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

                       

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

                       

                                         'dArr(2) = vPt2(2) - vPt1(2)

                        

                                          vModelSelPt1 = GetModelCoordinates(swApp, swSketch, vPt1)

                                        

                                          If swSelMgr.GetSelectedObjectType3(l, -1) = 1 Then

                       

                                              Message = Message & "Coordinates for Centerpoint is " & vbCrLf & "X: " & (vModelSelPt1(0) * UnitFactor) & " mm" & " Y: " & (vModelSelPt1(1) * UnitFactor) & " mm" & " Z: " & (vModelSelPt1(2) * UnitFactor) & " mm" & vbCrLf

                                        

                                          End If

                       

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

                                        

                                          bRes = WriteToExcel(((l - 1) * 2) + 1, vModelSelPt1, "Coordinates from Centerpoint")

                       

                                      End If

                       

                                  Next l

                               

                                  'Set oMyLine = Nothing

                       

                                  Set swSelMgr = Nothing

                       

                                  Set swPoint = 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: Exporting coordinates from a point and transforming the coordinates from sketch to model
                        Thomas Bryant

                        Hello Simon,

                         

                        Any help you (or anyone else) could provide? It gives me an "Object variable or With Block variable not set" runtime error at the Set swMathtrans = swSketch.ModelToSketchTransform line, even after changing it the way you suggested.

                         

                        Thanks,

                         

                        Thomas