SOLIDWORKS macro feature to link and auto update general table to Excel
{ width=350 }
This macro allows to create General Table in part, assembly and drawing and link it to external Excel or text/csv file using SOLIDWORKS API. This macro implemented as embedded macro feature which means that table will be automatically updated once the model is rebuilt.
- Run the macro
- Specify the full path to excel (.xls or .xlsx) or comma separated text file (.csv or .txt) in the first prompt dialog
- Optionally specify the name of the spreadsheet to read data from. If empty string is specified first spreadsheet will be used
Macro inserts the table and macro feature in the feature tree with the data from external file. Modify the file or general table and rebuild the model - table is updated.
Notes and limitations
- Only simple CSV files are supported (i.e. simple comma separated values, new line symbols or commas in the values are not supported)
- Excel is not required when CSV file is used
- Using CSV files has significant performance benefits as it is not required to start Excel and load document to get the data. Use this option where applicable
- Excel is displayed invisible and session may be cached for better performance benefits
- If CSV or Excel files are saved relative to the model - relative path will be maintained. It means that the SOLIDWORKS file can be moved together with Excel/CSV and link won't be broken
- If General Table is selected when inserting new feature - this table will be used instead of creating new one
- Currently it is not possible to change the path to external Excel file. Delete the macro feature instead and reinsert it by selecting the general table (see previous point)
- Macro feature is embedded into the model which means that the table will be updated on any other workstations even if this macro is not available.
Const BASE_NAME As String = "LinkedTable"
Const PARAM_EXCEL_PATH As String = "ExcelPath"
Const PARAM_SHEET_NAME As String = "SheetName"
Sub main()
Dim swApp As SldWorks.SldWorks
Set swApp = Application.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
Dim excelFilePath As String
Dim excelSheetName As String
excelFilePath = InputBox("Specify the full path to the excel or text/csv file")
excelSheetName = InputBox("Specify the sheet name for excel file (specify empty string for first sheet)")
If excelFilePath = "" Then
Exit Sub
End If
excelFilePath = UpdateRelativePath(swModel, excelFilePath)
Dim curMacroPath As String
curMacroPath = swApp.GetCurrentMacroPathName
Dim vMethods(8) As String
Dim moduleName As String
GetMacroEntryPoint swApp, curMacroPath, moduleName, ""
vMethods(0) = curMacroPath: vMethods(1) = moduleName: vMethods(2) = "swmRebuild"
vMethods(3) = curMacroPath: vMethods(4) = moduleName: vMethods(5) = "swmEditDefinition"
vMethods(6) = curMacroPath: vMethods(7) = moduleName: vMethods(8) = "swmSecurity"
Dim vParamNames(1) As String
vParamNames(0) = PARAM_EXCEL_PATH
vParamNames(1) = PARAM_SHEET_NAME
Dim vParamTypes(1) As Long
vParamTypes(0) = swMacroFeatureParamType_e.swMacroFeatureParamTypeString
vParamTypes(1) = swMacroFeatureParamType_e.swMacroFeatureParamTypeString
Dim vParamValues(1) As String
vParamValues(0) = excelFilePath
vParamValues(1) = excelSheetName
Dim swTable As SldWorks.TableAnnotation
Set swTable = TryGetSelectedTable(swModel)
If swTable Is Nothing Then
Dim emptyTable(2, 2) As String
Set swTable = CreateTableFromArray(swModel, emptyTable)
End If
swTable.GetAnnotation().Select3 False, Nothing
Dim swFeat As SldWorks.Feature
Set swFeat = swModel.FeatureManager.InsertMacroFeature3(BASE_NAME, "", vMethods, _
vParamNames, vParamTypes, vParamValues, Empty, Empty, Empty, _
Empty, swMacroFeatureOptions_e.swMacroFeatureEmbedMacroFile + swMacroFeatureOptions_e.swMacroFeatureAlwaysAtEnd)
If swFeat Is Nothing Then
MsgBox "Failed to create macro runner"
End If
Else
MsgBox "Please open model"
End If
End Sub
Function UpdateRelativePath(model As SldWorks.ModelDoc2, path As String) As String
Dim modelPath As String
modelPath = model.GetPathName
UpdateRelativePath = path
If modelPath <> "" Then
Dim modelDir As String
modelDir = Left(modelPath, InStrRev(modelPath, "\"))
If LCase(path) Like LCase(modelDir) & "*" Then
UpdateRelativePath = Right(path, Len(path) - Len(modelDir) + 1)
End If
End If
End Function
Function GetFullPath(model As SldWorks.ModelDoc2, path As String)
GetFullPath = path
Dim isRelative As Boolean
isRelative = Left(path, 1) = "\"
If isRelative Then
Dim modelPath As String
Dim modelDir As String
modelPath = model.GetPathName
modelDir = Left(modelPath, InStrRev(modelPath, "\") - 1)
GetFullPath = modelDir & path
End If
End Function
Function TryGetSelectedTable(model As SldWorks.ModelDoc2) As SldWorks.TableAnnotation
On Error Resume Next
Dim swTable As SldWorks.TableAnnotation
Set swTable = model.SelectionManager.GetSelectedObject6(1, -1)
If swTable Is Nothing Then
Dim swTableFeat As SldWorks.GeneralTableFeature
Set swTableFeat = swModel.SelectionManager.GetSelectedObject6(1, -1)
If Not swTableFeat Is Nothing Then
Set swTable = swTableFeat.GetTableAnnotations()(0)
End If
End If
Set TryGetSelectedTable = swTable
End Function
Function CreateTableFromArray(model As SldWorks.ModelDoc2, vTableData As Variant) As SldWorks.TableAnnotation
Dim swTable As SldWorks.TableAnnotation
Set swTable = model.Extension.InsertGeneralTableAnnotation(True, 0, 0, swBOMConfigurationAnchorType_e.swBOMConfigurationAnchor_BottomLeft, "", UBound(vTableData, 1), UBound(vTableData, 2))
FillTable swTable, vTableData
Set CreateTableFromArray = swTable
End Function
Sub FillTable(table As SldWorks.TableAnnotation, vTableData As Variant)
Dim rowIndex As Integer
Dim columnIndex As Integer
Dim rowsCount As Integer
Dim colsCount As Integer
Dim i As Integer
rowsCount = UBound(vTableData, 1)
colsCount = UBound(vTableData, 2)
If table.columnCount > colsCount Then
For i = colsCount To table.columnCount - 1
table.DeleteColumn2 table.columnCount - 1, True
Next
ElseIf table.columnCount < colsCount Then
For i = table.columnCount To colsCount - 1
table.InsertColumn2 swTableItemInsertPosition_e.swTableItemInsertPosition_Last, -1, "", swInsertTableColumnWidthStyle_e.swInsertColumn_DefaultWidth
Next
End If
If table.rowCount > rowsCount Then
For i = rowsCount To table.rowCount - 1
table.DeleteRow2 table.rowCount - 1, True
Next
ElseIf table.rowCount < rowsCount Then
For i = table.rowCount To rowsCount - 1
table.InsertRow swTableItemInsertPosition_e.swTableItemInsertPosition_Last, -1
Next
End If
For rowIndex = 0 To UBound(vTableData, 1)
For columnIndex = 0 To UBound(vTableData, 2)
table.Text(rowIndex, columnIndex) = vTableData(rowIndex, columnIndex)
Next
Next
End Sub
Sub GetMacroEntryPoint(app As SldWorks.SldWorks, macroPath As String, ByRef moduleName As String, ByRef procName As String)
Dim vMethods As Variant
vMethods = app.GetMacroMethods(macroPath, swMacroMethods_e.swMethodsWithoutArguments)
Dim i As Integer
If Not IsEmpty(vMethods) Then
For i = 0 To UBound(vMethods)
Dim vData As Variant
vData = Split(vMethods(i), ".")
If i = 0 Or LCase(vData(1)) = "main" Then
moduleName = vData(0)
procName = vData(1)
End If
Next
End If
End Sub
Function GetArrayFromExcel(filePath As String, sheetName As String) As Variant
Dim xlApp As Object
Dim tableData() As String
Set xlApp = GetObject("", "Excel.Application")
Dim xlWorkbook As Object
Dim xlWorksheet As Object
Dim closeWorkbook As Boolean
closeWorkbook = Not IsWorkbookOpen(xlApp, filePath)
Set xlWorkbook = xlApp.Workbooks.Open(filePath)
If sheetName <> "" Then
Set xlWorksheet = xlWorkbook.Sheets(sheetName)
Else
Set xlWorksheet = xlWorkbook.Sheets(1)
End If
Dim rowIndex As Integer
Dim columnIndex As Integer
ReDim tableData(xlWorksheet.UsedRange.rows.Count, xlWorksheet.UsedRange.Columns.Count)
For rowIndex = 1 To xlWorksheet.UsedRange.rows.Count
For columnIndex = 1 To xlWorksheet.UsedRange.Columns.Count
Dim cellVal As String
cellVal = xlWorksheet.Cells(rowIndex, columnIndex).Value
tableData(rowIndex - 1, columnIndex - 1) = cellVal
Next
Next
GetArrayFromExcel = tableData
If closeWorkbook Then
xlWorkbook.Close SaveChanges:=False
End If
End Function
Function GetArrayFromCsv(filePath As String) As Variant
Dim fileNo As Integer
fileNo = FreeFile
Dim rows As Collection
Set rows = New Collection
Open filePath For Input As #fileNo
Do While Not EOF(fileNo)
Dim tableRow As String
Line Input #fileNo, tableRow
Dim vCells As Variant
vCells = Split(tableRow, ",")
rows.Add vCells
Loop
Close #fileNo
Dim tableData() As String
Dim rowCount As Integer
Dim columnCount As Integer
rowCount = rows.Count
columnCount = UBound(rows(1)) + 1
Dim rowIndex As Integer
Dim columnIndex As Integer
ReDim tableData(rowCount, columnCount)
For rowIndex = 1 To rowCount
Dim vRow As Variant
vRow = rows.Item(rowIndex)
For columnIndex = 1 To columnCount
Dim cellVal As String
cellVal = vRow(columnIndex - 1)
tableData(rowIndex - 1, columnIndex - 1) = cellVal
Next
Next
GetArrayFromCsv = tableData
End Function
Function IsWorkbookOpen(xlApp As Object, filePath As String) As Boolean
Dim i As Integer
For i = 1 To xlApp.Workbooks.Count
If LCase(xlApp.Workbooks(i).FullName) = LCase(filePath) Then
IsWorkbookOpen = True
Exit Function
End If
Next
IsWorkbookOpen = False
End Function
Function swmRebuild(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature
Set swApp = varApp
Set swModel = varDoc
Set swFeat = varFeat
Dim swMacroFeat As SldWorks.MacroFeatureData
Set swMacroFeat = swFeat.GetDefinition()
Dim excelFileName As String
Dim excelSheetName As String
swMacroFeat.GetStringByName PARAM_EXCEL_PATH, excelFileName
swMacroFeat.GetStringByName PARAM_SHEET_NAME, excelSheetName
Dim vObjects As Variant
swMacroFeat.GetSelections3 vObjects, Empty, Empty, Empty, Empty
Dim swTable As SldWorks.TableAnnotation
Set swTable = vObjects(0)
If swTable Is Nothing Then
swmRebuild = "Linked general table is missing"
Exit Function
End If
excelFileName = GetFullPath(swModel, excelFileName)
If Dir(excelFileName) = "" Then
swmRebuild = "Linked Excel file is missing: " & excelFileName
Exit Function
End If
Dim vTable As Variant
Dim fileExt As String
fileExt = Right(excelFileName, Len(excelFileName) - InStrRev(excelFileName, "."))
Dim isExcel As Boolean
isExcel = LCase(fileExt) = "xls" Or LCase(fileExt) = "xlsx"
If isExcel Then
vTable = GetArrayFromExcel(excelFileName, excelSheetName)
Else
vTable = GetArrayFromCsv(excelFileName)
End If
FillTable swTable, vTable
End Function
Function swmEditDefinition(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant
swmEditDefinition = True
End Function
Function swmSecurity(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant
swmSecurity = SwConst.swMacroFeatureSecurityOptions_e.swMacroFeatureSecurityByDefault
End Function