AnsweredAssumed Answered

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

Question asked by Thomas Bryant on Feb 5, 2016
Latest reply on Feb 12, 2016 by 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!

Outcomes