AnsweredAssumed Answered

Points in assembly files all export same or very similar XYZ coordinates when they shouldn't

Question asked by Thomas Bryant on Feb 17, 2016
Latest reply on Feb 25, 2016 by Thomas Bryant

I have been working on a macros to export the values from a point (or multiple points). The macro works fine in a part file/2D sketch, but when I run the macro in an assembly file, the numbers that appear are always the same set of numbers (the ones shown below) regardless of which point I select. I've used these two references, but something is obviously still wrong:

 

http://help.solidworks.com/2015/English/api/sldworksapi/Transform_Point_from_Component_Space_to_Assembly_Space_Example_VB.htm

 

http://help.solidworks.com/2015/English/api/sldworksapi/Transform_Coordinates_from_Sketch_to_Model_Space_Example_VB.htm

 

Even when trying a different assembly file, the numbers are still a slight variation of the ones shown (i.e. 3689 as the x-coordinate). Is there something else that needs changing? Here is my code so far, as well as example screenshots of the file I'm using and the output I get from it:

 

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 swAssemblyDoc As AssemblyDoc

  

    Dim swPartDoc As PartDoc

 

    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

  

    Dim swComp As SldWorks.Component2

 

    Dim swXform As SldWorks.MathTransform

  

    Dim swPt As SldWorks.MathPoint

 

    Dim nPt(2) As Double

  

    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

  

    Set swComp = swSelMgr.GetSelectedObjectsComponent(1)

  

    Set swXform = swComp.Transform2

  

    nPt(0) = 0#

 

    nPt(1) = 0#

 

    nPt(2) = 0#

 

    vPt1 = nPt

 

    If Not swApp Is Nothing Then

 

        Set swModel = swApp.ActiveDoc

      

        'Set swAssemblyDoc = 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)

             

                Set swPt = swMathUtil.CreatePoint(vPt1)

 

                Set swPt = swPt.MultiplyTransform(swXform)

 

               If Not swPoint Is Nothing And Not swPt Is Nothing Then

             

                   'Set swSketch = swSketchLine.GetSketch

 

                   Set swSketch = swPoint.GetSketch

                 

                   DEC = 6

 

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

 

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

 

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

 

                   vPt1 = dArr

  

                    vModelSelPt1 = GetModelCoordinates(swApp, swSketch, vPt1)

                  

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

 

                        Message = Message & "Coordinates for Centerpoint is " & vbCrLf & "X: " & (vModelSelPt1(0)) & " mm" & " Y: " & (vModelSelPt1(1)) & " mm" & " Z: " & (vModelSelPt1(2)) & " 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 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

Coordinate results capture.PNG

 

Assembly screenshot.PNG

Outcomes