AnsweredAssumed Answered

Transform Coordinate System In Macro

Question asked by Darius Teichroew on May 17, 2018
Latest reply on May 18, 2018 by 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

Else

    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)) & "," & _

            Format(yValue(i))

           

   Next i

f.Close

       

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

Outcomes