AnsweredAssumed Answered

Problem with transforming sketch coordinates to model coordinates

Question asked by Thomas Bryant on Jan 24, 2016
Latest reply on Jan 29, 2016 by 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

Outcomes