2 Replies Latest reply on May 18, 2018 10:25 AM by Darius Teichroew

    Transform Coordinate System In Macro

    Darius Teichroew

      Hi, I have the following macro that exports the points of a sketch to a text file. That works fine. However, it's based on the default coordinate system, which is randomly different in each drawing. So I'd like instead to have it use the first exported point as the origin. I'm sure it's a pretty quick change, can someone show me what needs to change in my code? Thanks.


      Sub main()

          Dim swApp                           As SldWorks.SldWorks

          Dim swModel                         As SldWorks.ModelDoc2

          Dim swSelMgr                        As SldWorks.SelectionMgr

          Dim swFeat                          As SldWorks.feature

          Dim swSketch                        As SldWorks.sketch

          Dim i                               As Long

          Dim bRet                            As Boolean

          Dim vSketchSeg                      As Variant

          Dim swSketchSeg                     As SldWorks.SketchPoint

          Dim nLength                         As Double

          Dim xValue() As Double

          Dim yValue() As Double

          Dim zValue() As Double

          Dim point_count As Integer

      On Error GoTo error:

          Set swApp = CreateObject("SldWorks.Application")

          Set swModel = swApp.ActiveDoc


      If swModel Is Nothing Then Exit Sub

          Set swSelMgr = swModel.SelectionManager

          Set swFeat = swSelMgr.GetSelectedObject5(1)

      If swFeat Is Nothing Then

          Set swSketch = swModel.GetActiveSketch2

          If swSketch Is Nothing Then

              MsgBox ("you must select the sketch from feature manager tree or at least be in a sketch")

              Exit Sub

          End If


          Set swSketch = swFeat.GetSpecificFeature2

      End If

              vSketchSeg = swSketch.GetSketchPoints2

              point_count = UBound(vSketchSeg)

      ReDim xValue(point_count)

      ReDim yValue(point_count)

          For i = 0 To point_count

              Set swSketchSeg = vSketchSeg(i)


              xValue(i) = swSketchSeg.x * 1000 / 25.4

              yValue(i) = swSketchSeg.y * 1000 / 25.4


          Next i

      tFilename = swModel.GetPathName

      sFilename = Left(tFilename, Len(tFilename) - 7)

      Set fs = CreateObject("Scripting.FileSystemObject")

      Set f = fs.CreateTextFile(sFilename & ".txt", True)

         For i = 0 To point_count

                  f.writeline Format(xValue(i)) & "," & _



         Next i



      MsgBox Left(swModel.GetTitle, Len(swModel.GetTitle) - 7) & ".txt file created under working directory"

      Exit Sub

      error:    MsgBox " please make sure that:" & vbCrLf & _

                  "1. Only one SolidWorks session is opened" & vbCrLf & _

                  "2. An Assembly or a part is the active document" & vbCrLf & _

                  "3. A Sketch feature is selected or active with nothing selected" & vbCrLf & _

                  "4. you are allowed to write to working directory.", vbInformation

      Exit Sub


      End Sub

        • Re: Transform Coordinate System In Macro
          Dave Paul

          Hello Darius,

          This is something that you can use.  I wrote it to convert circular edge parameters using drawing view transform data.  You can change the function to transform your point data.  Pass in your point data and the drawing view.  It's works well for all the situations that I have thrown at it.



          Function TransformHolePoints(swEdge As SldWorks.Edge, swView As SldWorks.View) As String
            Dim swCurve             As SldWorks.Curve
            Dim CircArray(2)        As Double
            Dim vCircParams         As Variant
            Dim vCircCenter         As Variant
            Dim XformArray(15)      As Double
            Dim vTempXform          As Variant
            Dim swMathUtil          As SldWorks.MathUtility
            Dim swTransform         As SldWorks.MathTransform
            Dim swPoint             As SldWorks.MathPoint
            Set swCurve = swEdge.GetCurve
            vCircParams = swCurve.CircleParams
            CircArray(0) = vCircParams(0)
            CircArray(1) = vCircParams(1)
            CircArray(2) = vCircParams(2)
            vCircCenter = CircArray
            XformArray(0) = swView.GetViewXform(0)
            XformArray(1) = swView.GetViewXform(1)
            XformArray(2) = swView.GetViewXform(2)
            XformArray(3) = swView.GetViewXform(3)
            XformArray(4) = swView.GetViewXform(4)
            XformArray(5) = swView.GetViewXform(5)
            XformArray(6) = swView.GetViewXform(6)
            XformArray(7) = swView.GetViewXform(7)
            XformArray(8) = swView.GetViewXform(8)
            XformArray(9) = swView.GetViewXform(9)
            XformArray(10) = swView.GetViewXform(10)
            XformArray(11) = swView.GetViewXform(11)
            XformArray(12) = swView.GetViewXform(12)
            XformArray(13) = 0#
            XformArray(14) = 0#
            XformArray(15) = 0#
            vTempXform = XformArray
            Set swMathUtil = swApp.GetMathUtility
            Set swPoint = swMathUtil.CreatePoint(vCircCenter)
            Set swTransform = swMathUtil.CreateTransform(vTempXform)
            Set swPoint = swPoint.MultiplyTransform(swTransform)
            vCircParams = swPoint.arrayData
            vCircParams(0) = vCircParams(0) - swView.GetXform(0)
            vCircParams(1) = vCircParams(1) - swView.GetXform(1)
            'vCircParams(2) = vCircParams(2) - 0#
            vCircParams(0) = vCircParams(0) / swView.GetXform(2)
            vCircParams(1) = vCircParams(1) / swView.GetXform(2)
            'vCircParams(2) = vCircParams(2) / swView.GetXform(2)
            TransformHolePoints = Round(vCircParams(0), 6) & "," & Round(vCircParams(1), 6)
          End Function