Lesson 7.1 code

Files

Lesson 7.1 code

Code

Option Explicit
    
Dim strPoints() As String
Dim strFileName As String
    
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    'Browse for file
    Dim strFilter As String
    strFilter = _
        "Excel or CSV|*.xls; *.xlsx; *.xlsm; *.csv|"
    strFileName = swApp.GetOpenFileName _
        ("Open file", Empty, strFilter, Empty, Empty, Empty)
        
    'Get data from excel
    Call GetPointsFromExcel
    
    'Open sketch
    Dim swSketchMgr As SldWorks.SketchManager
    Set swSketchMgr = swModel.SketchManager
    swSketchMgr.Insert3DSketch True
    swSketchMgr.AddToDB = True
    
    'create points from array
    Dim vPointsSplit As Variant
    Dim i As Integer
    On Error GoTo ErrorHandling:
    For i = 0 To UBound(strPoints)
        vPointsSplit = Split(strPoints(i), ",")
        swSketchMgr.CreatePoint vPointsSplit(0) / 1000, _
            vPointsSplit(1) / 1000, vPointsSplit(2) / 1000
    Next i
    
    'Close sketch
    swSketchMgr.AddToDB = False
    swSketchMgr.Insert3DSketch True
    swModel.ViewZoomtofit2
    Exit Sub
    
ErrorHandling:
MsgBox "Error reading data."
End Sub
    
Sub GetPointsFromExcel()
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
    Set xlWB = xlApp.Workbooks.Open(strFileName)
    
    'find number of rows with data
    Dim row As Integer
    row = 1
    With xlWB.Worksheets(1)
        While Cells(row, 1).Value <> ""
            row = row + 1
        Wend
    End With
    
    'resize array and get data
    ReDim strPoints(row - 2)
    row = 1
    With xlWB.Worksheets(1)
        While Cells(row, 1).Value <> ""
            strPoints(row - 1) = Cells(row, 1).Value
            row = row + 1
        Wend
    End With
    
    xlWB.Close False
    xlApp.Quit
    xlApp.Visible = True
    Set xlApp = Nothing
    Set xlWB = Nothing
End Sub