Feed

How to export solidworks spline points to a .txt file.

Tutorial by Sourbh
Missing small

Here am posting the Program code:-

Macro to read 3d Sketch points and export to Excel or text file..!!

caution this program reads the points in order of creation so you may need to rearrange your data in excel if they are out of order!

  1. Step 1:

    instructions:
    select the sketch that you wish to "read" and run the macro.
    the macro will bring up excel and start filling the sheet with xyz point data.
    Source Code:
    -----------------------------------------------------------

    Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim doc As SldWorks.ModelDoc2
    Dim part As SldWorks.PartDoc
    Dim sm As SldWorks.SelectionMgr
    Dim feat As SldWorks.feature
    Dim sketch As SldWorks.sketch
    Dim v As Variant
    Dim i As Long
    Dim sseg As SldWorks.SketchSegment
    Dim sline As SldWorks.SketchLine
    Dim sp As SldWorks.SketchPoint
    Dim ep As SldWorks.SketchPoint
    Dim s As String

    Dim exApp As Excel.Application
    Dim sheet As Excel.Worksheet

    Set exApp = New Excel.Application
    If Not exApp Is Nothing Then
    exApp.Visible = True
    If Not exApp Is Nothing Then
    exApp.Workbooks.Add
    Set sheet = exApp.ActiveSheet
    If Not sheet Is Nothing Then
    sheet.Cells(1, 2).Value = "X"
    sheet.Cells(1, 3).Value = "Y"
    sheet.Cells(1, 4).Value = "Z"
    End If
    End If
    End If

    Set swApp = GetObject(, "sldworks.application")
    If Not swApp Is Nothing Then
    Set doc = swApp.ActiveDoc
    If Not doc Is Nothing Then
    If doc.GetType = swDocPART Then
    Set part = doc
    Set sm = doc.SelectionManager
    If Not part Is Nothing And Not sm Is Nothing Then
    If sm.GetSelectedObjectType2(1) = swSelSKETCHES Then
    Set feat = sm.GetSelectedObject4(1)
    Set sketch = feat.GetSpecificFeature
    If Not sketch Is Nothing Then
    v = sketch.GetSketchPoints
    For i = LBound(v) To UBound(v)
    Set sp = v(i)
    If Not sp Is Nothing And Not sheet Is Nothing And Not exApp Is Nothing Then
    'sheet.Cells(2 + i, 1).Value = "Normal Vector " & i + 1
    sheet.Cells(2 + i, 2).Value = Round(sp.x * 1000 / 25.4, DEC)
    sheet.Cells(2 + i, 3).Value = Round(sp.y * 1000 / 25.4, DEC)
    sheet.Cells(2 + i, 4).Value = Round(sp.z * 1000 / 25.4, DEC)
    exApp.Columns.AutoFit
    End If
    Next i
    End If
    End If
    End If
    End If
    End If
    End If
    End Sub

Comments

Please log in to add comments