6 Replies Latest reply on Feb 25, 2016 5:21 PM by Thomas Bryant

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

    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:






      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