Skip to main content

Link SOLIDWORKS custom properties from text file

This VBA macro allows to link external comma separated file into the configuration specific or file specific custom properties of SOLIDWORKS file.

CSV file consists of 2 columns (property name and property value) without a header.

If value of the cell contains special symbol " then the cell must have "" at the start and ant the end of the cell value.

Company,Xarial Pty Limited
Material,"""SW-Material"""
Mass,"""SW-Mass"""

You can use Excel to modify these values and export to CSV file with comma delimiter, special symbol will be formatted correctly automatically.

Commas and new line symbols in the property names or values are not supported

Set the value of the CLEAR_PROPERTIES constant to True or False to configure if existing properties need to be deleted before updating.

Set ALL_COMPONENTS to True to process all components of the assembly

Const CLEAR_PROPERTIES As Boolean = False
Const ALL_COMPONENTS As Boolean = True
Type RefCompModel
RefModel As SldWorks.ModelDoc2
RefConf As String
End Type

#Const ARGS = True 'True to use arguments from Toolbar+ or Batch+ instead of the constant

Const CLEAR_PROPERTIES As Boolean = False
Const ALL_COMPONENTS As Boolean = False

Sub main()

Dim swApp As SldWorks.SldWorks
Set swApp = Application.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim csvFilePath As String
Dim confSpecific As Boolean

If GetParameters(swApp, swModel, csvFilePath, confSpecific) Then

If Not swModel Is Nothing Then

Dim vTable As Variant
vTable = GetArrayFromCsv(csvFilePath)

Dim swRefConf As SldWorks.Configuration
Set swRefConf = swModel.ConfigurationManager.ActiveConfiguration

WritePropertiesFromTable swModel, vTable, IIf(CBool(confSpecific), swRefConf.Name, ""), CLEAR_PROPERTIES

If ALL_COMPONENTS Then

Dim refCompModels() As RefCompModel
refCompModels = CollectUniqueComponents(swRefConf, confSpecific)

If (Not refCompModels) <> -1 Then

Dim i As Integer

For i = 0 To UBound(refCompModels)
WritePropertiesFromTable refCompModels(i).RefModel, vTable, refCompModels(i).RefConf, CBool(clearPrps)
Next

End If

End If

'WritePropertiesFromFile swModel, csvFilePath, IIf(CBool(confSpecific), swModel.ConfigurationManager.ActiveConfiguration, Nothing)
Else
Err.Raise vbError, "", "Please open model"
End If

End If

End Sub

Function GetParameters(app As SldWorks.SldWorks, ByRef model As SldWorks.ModelDoc2, ByRef csvFilePath As String, ByRef confSpecific As Boolean) As Boolean

Dim confSpecArgsParsed As Boolean

#If ARGS Then

try_:
On Error GoTo catch_

Dim macroRunner As Object
Set macroRunner = CreateObject("CadPlus.MacroRunner.Sw")

Dim param As Object
Set param = macroRunner.PopParameter(app)

Dim vArgs As Variant
vArgs = param.Get("Args")

Set model = param.Get("Model")

If Not IsEmpty(vArgs) Then
csvFilePath = CStr(vArgs(0))
End If

If UBound(vArgs) > 0 Then
confSpecific = CBool(vArgs(1))
confSpecArgsParsed = True
End If

GoTo finally_

catch_:
finally_:

#End If

If Trim(csvFilePath) = "" Then
csvFilePath = app.GetOpenFileName("Custom Properties Template File", "", "CSV Files (*.csv)|*.csv|Text Files (*.txt)|*.txt|All Files (*.*)|*.*|", 0, "", "")
End If

If model Is Nothing Then
Set model = app.ActiveDoc
End If

If csvFilePath <> "" Then
If Not confSpecArgsParsed Then
confSpecific = app.SendMsgToUser2("Link to configuration specific properties (Yes) or File Specific (No)?", swMessageBoxIcon_e.swMbQuestion, swMessageBoxBtn_e.swMbYesNo) = swMessageBoxResult_e.swMbHitYes
End If
GetParameters = True
Else
GetParameters = 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 - 1, columnCount - 1)

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)

If Left(cellVal, 2) = """""" And Right(cellVal, 2) = """""" Then
cellVal = Mid(cellVal, 3, Len(cellVal) - 4)
End If

tableData(rowIndex - 1, columnIndex - 1) = cellVal
Next
Next

GetArrayFromCsv = tableData

End Function

Sub WritePropertiesFromTable(model As SldWorks.ModelDoc2, table As Variant, confName As String, clearPrps As Boolean)

Dim i As Integer

Dim swCustPrpMgr As SldWorks.CustomPropertyManager

Set swCustPrpMgr = model.Extension.CustomPropertyManager(confName)

If clearPrps Then
ClearProperties swCustPrpMgr
End If

For i = 0 To UBound(table, 1)

Dim prpName As String
prpName = CStr(table(i, 0))

Dim prpVal As String
prpVal = CStr(table(i, 1))

If swCustPrpMgr.Add3(prpName, swCustomInfoType_e.swCustomInfoText, prpVal, swCustomPropertyAddOption_e.swCustomPropertyReplaceValue) <> swCustomInfoAddResult_e.swCustomInfoAddResult_AddedOrChanged Then
Err.Raise vbError, "", "Failed to add property '" & prpName & "'"
End If

Next

End Sub

Sub ClearProperties(custPrpMgr As SldWorks.CustomPropertyManager)

Dim vPrpNames As Variant
vPrpNames = custPrpMgr.GetNames

If Not IsEmpty(vPrpNames) Then

Dim i As Integer

For i = 0 To UBound(vPrpNames)
custPrpMgr.Delete2 CStr(vPrpNames(i))
Next

End If

End Sub

Function CollectUniqueComponents(assmConf As SldWorks.Configuration, confSpecific As Boolean) As RefCompModel()

Dim swRootComp As SldWorks.Component2
Set swRootComp = assmConf.GetRootComponent3(False)

Dim refCompModels() As RefCompModel

ProcessComponents swRootComp.GetChildren(), confSpecific, refCompModels

CollectUniqueComponents = refCompModels

End Function

Sub ProcessComponents(vComps As Variant, confSpecific As Boolean, refCompModels() As RefCompModel)

If Not IsEmpty(vComps) Then

Dim i As Integer

For i = 0 To UBound(vComps)

Dim swComp As SldWorks.Component2
Set swComp = vComps(i)

Dim swRefModel As SldWorks.ModelDoc2
Set swRefModel = swComp.GetModelDoc2

If Not swRefModel Is Nothing Then

Dim refConfName As String

refConfName = IIf(confSpecific, swComp.ReferencedConfiguration, "")

If Not Contains(refCompModels, swRefModel, refConfName) Then

If (Not refCompModels) = -1 Then
ReDim refCompModels(0)
Else
ReDim Preserve refCompModels(UBound(refCompModels) + 1)
End If

Set refCompModels(UBound(refCompModels)).RefModel = swRefModel
refCompModels(UBound(refCompModels)).RefConf = refConfName

End If

ProcessComponents swComp.GetChildren(), confSpecific, refCompModels

End If

Next

End If

End Sub

Function Contains(refCompModels() As RefCompModel, model As SldWorks.ModelDoc2, conf As String) As Boolean

Contains = False

If (Not refCompModels) <> -1 Then

Dim i As Integer

For i = 0 To UBound(refCompModels)

If refCompModels(i).RefModel Is model And LCase(refCompModels(i).RefConf) = LCase(conf) Then
Contains = True
Exit Function
End If

Next

End If

End Function

In order to dynamically link external text file and update properties on every rebuild, use the following macro.

Set the value of the UPDATE_ON_CSV_FILE_CHANGE_ONLY constant to True or False to configure if properties need to reload only if properties text file is changed or always when macro.

Const UPDATE_ON_CSV_FILE_CHANGE_ONLY As Boolean = False

Macro will ask for the following input parameters upon insertion of the macro feature:

  • Should the properties be configuration specific or file specific
  • Should the properties be cleared upon update
  • Should the reference components of the assembly be included into the scope of the properties

Properties will be automatically updated upon rebuild of the macro feature.

Type RefCompModel
RefModel As SldWorks.ModelDoc2
RefConf As String
End Type

Const BASE_NAME As String = "LinkedCustomProperties"
Const EMBED As Boolean = False

Const UPDATE_ON_CSV_FILE_CHANGE_ONLY As Boolean = True

Const PARAM_CLEAR_PROPERTIES As String = "ClearProperties"
Const PARAM_PROCESS_COMPONENTS As String = "ProcessComponents"
Const PARAM_CSV_PATH As String = "CsvPath"
Const PARAM_CONF_SPEC_NAME As String = "ConfigurationSpecific"
Const PARAM_CSV_TIME_STAMP As String = "CsvFileTimeStamp"

Function GetParameters(app As SldWorks.SldWorks, model As SldWorks.ModelDoc2, ByRef csvFilePath As String, ByRef confSpecific As Boolean, ByRef clearPrps As Boolean, ByRef processComps As Boolean) As Boolean

csvFilePath = app.GetOpenFileName("Custom Properties Template File", "", "CSV Files (*.csv)|*.csv|Text Files (*.txt)|*.txt|All Files (*.*)|*.*|", 0, "", "")

If csvFilePath <> "" Then

csvFilePath = GetRelativeFilePath(model, csvFilePath)

confSpecific = app.SendMsgToUser2("Link to configuration specific properties (Yes) or File Specific (No)?", swMessageBoxIcon_e.swMbQuestion, swMessageBoxBtn_e.swMbYesNo) = swMessageBoxResult_e.swMbHitYes

clearPrps = app.SendMsgToUser2("Clear existing properties?", swMessageBoxIcon_e.swMbQuestion, swMessageBoxBtn_e.swMbYesNo) = swMessageBoxResult_e.swMbHitYes

If TypeOf model Is SldWorks.AssemblyDoc Then
processComps = app.SendMsgToUser2("Process children components of the assembly?", swMessageBoxIcon_e.swMbQuestion, swMessageBoxBtn_e.swMbYesNo) = swMessageBoxResult_e.swMbHitYes
Else
processComps = False
End If

GetParameters = True
Else
GetParameters = False
End If

End Function

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 csvFilePath As String
Dim confSpecific As Boolean
Dim clearPrps As Boolean
Dim processComps As Boolean

If GetParameters(swApp, swModel, csvFilePath, confSpecific, clearPrps, processComps) Then

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(4) As String
vParamNames(0) = PARAM_CSV_PATH
vParamNames(1) = PARAM_CONF_SPEC_NAME
vParamNames(2) = PARAM_CLEAR_PROPERTIES
vParamNames(3) = PARAM_PROCESS_COMPONENTS
vParamNames(4) = PARAM_CSV_TIME_STAMP

Dim vParamTypes(4) As Long
vParamTypes(0) = swMacroFeatureParamType_e.swMacroFeatureParamTypeString
vParamTypes(1) = swMacroFeatureParamType_e.swMacroFeatureParamTypeInteger
vParamTypes(2) = swMacroFeatureParamType_e.swMacroFeatureParamTypeInteger
vParamTypes(3) = swMacroFeatureParamType_e.swMacroFeatureParamTypeInteger
vParamTypes(4) = swMacroFeatureParamType_e.swMacroFeatureParamTypeString

Dim vParamValues(4) As String

vParamValues(0) = csvFilePath
vParamValues(1) = CLng(confSpecific)
vParamValues(2) = CLng(clearPrps)
vParamValues(3) = CLng(processComps)
vParamValues(4) = ""

Dim opts As swMacroFeatureOptions_e
opts = swMacroFeatureOptions_e.swMacroFeatureAlwaysAtEnd

If EMBED Then
opts = opts + swMacroFeatureOptions_e.swMacroFeatureEmbedMacroFile
End If

Dim swFeat As SldWorks.Feature
Set swFeat = swModel.FeatureManager.InsertMacroFeature3(BASE_NAME, "", vMethods, _
vParamNames, vParamTypes, vParamValues, Empty, Empty, Empty, _
Empty, opts)

If swFeat Is Nothing Then
MsgBox "Failed to create linked properties feature"
End If

End If

Else
MsgBox "Please open model"
End If

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 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 - 1, columnCount - 1)

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)

If Left(cellVal, 2) = """""" And Right(cellVal, 2) = """""" Then
cellVal = Mid(cellVal, 3, Len(cellVal) - 4)
End If

tableData(rowIndex - 1, columnIndex - 1) = cellVal
Next
Next

GetArrayFromCsv = tableData

End Function

Function GetRelativeFilePath(model As SldWorks.ModelDoc2, filePath As String) As String

GetRelativeFilePath = filePath

Dim modelDir As String
modelDir = model.GetPathName

If modelDir <> "" Then

modelDir = Left(modelDir, InStrRev(modelDir, "\"))

If Len(filePath) > Len(modelDir) Then
If LCase(modelDir) = LCase(Left(filePath, Len(modelDir))) Then
GetRelativeFilePath = Right(filePath, Len(filePath) - Len(modelDir) + 1)
End If
End If

End If

End Function

Function swmRebuild(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant

try_:
Dim swModel As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature

Set swModel = varDoc
Set swFeat = varFeat

UpdateProperties swModel, swFeat

catch_:
swmRebuild = Err.Description
finally_:

End Function

Sub UpdateProperties(model As SldWorks.ModelDoc2, feat As SldWorks.Feature)

Dim swMacroFeat As SldWorks.MacroFeatureData
Set swMacroFeat = feat.GetDefinition()

Dim csvFilePath As String
Dim confSpecific As Long
Dim clearPrps As Long
Dim processComps As Long
Dim csvFileTimeStamp As String
Dim curCsvFileTimeStamp As String

swMacroFeat.GetIntegerByName PARAM_CONF_SPEC_NAME, confSpecific

swMacroFeat.GetIntegerByName PARAM_CLEAR_PROPERTIES, clearPrps

swMacroFeat.GetIntegerByName PARAM_PROCESS_COMPONENTS, processComps

swMacroFeat.GetStringByName PARAM_CSV_TIME_STAMP, csvFileTimeStamp

csvFilePath = GetCsvFileFullPath(swMacroFeat, model)

curCsvFileTimeStamp = FileDateTime(csvFilePath)

If Not UPDATE_ON_CSV_FILE_CHANGE_ONLY Or curCsvFileTimeStamp <> csvFileTimeStamp Then

If Dir(csvFilePath) = "" Then
Err.Raise "Linked CSV file is missing: " & csvFilePath
End If

Dim vTable As Variant
vTable = GetArrayFromCsv(csvFilePath)

If UBound(vTable, 2) <> 1 Then
Err.Raise vbError, "", "There must be only 2 columns in the CSV file"
End If

Dim swRefConf As SldWorks.Configuration
Set swRefConf = swMacroFeat.CurrentConfiguration

WritePropertiesFromTable model, vTable, IIf(CBool(confSpecific), swRefConf.Name, ""), CBool(clearPrps)

If CBool(processComps) Then

Dim refCompModels() As RefCompModel
refCompModels = CollectUniqueComponents(swRefConf, CBool(confSpecific))

If (Not refCompModels) <> -1 Then

Dim i As Integer

For i = 0 To UBound(refCompModels)
WritePropertiesFromTable refCompModels(i).RefModel, vTable, refCompModels(i).RefConf, CBool(clearPrps)
Next

End If

End If

swMacroFeat.SetStringByName PARAM_CSV_TIME_STAMP, curCsvFileTimeStamp

End If

End Sub

Function CollectUniqueComponents(assmConf As SldWorks.Configuration, confSpecific As Boolean) As RefCompModel()

Dim swRootComp As SldWorks.Component2
Set swRootComp = assmConf.GetRootComponent3(False)

Dim refCompModels() As RefCompModel

ProcessComponents swRootComp.GetChildren(), confSpecific, refCompModels

CollectUniqueComponents = refCompModels

End Function

Sub ProcessComponents(vComps As Variant, confSpecific As Boolean, refCompModels() As RefCompModel)

If Not IsEmpty(vComps) Then

Dim i As Integer

For i = 0 To UBound(vComps)

Dim swComp As SldWorks.Component2
Set swComp = vComps(i)

Dim swRefModel As SldWorks.ModelDoc2
Set swRefModel = swComp.GetModelDoc2

If Not swRefModel Is Nothing Then

Dim refConfName As String

refConfName = IIf(confSpecific, swComp.ReferencedConfiguration, "")

If Not Contains(refCompModels, swRefModel, refConfName) Then

If (Not refCompModels) = -1 Then
ReDim refCompModels(0)
Else
ReDim Preserve refCompModels(UBound(refCompModels) + 1)
End If

Set refCompModels(UBound(refCompModels)).RefModel = swRefModel
refCompModels(UBound(refCompModels)).RefConf = refConfName

End If

ProcessComponents swComp.GetChildren(), confSpecific, refCompModels

End If

Next

End If

End Sub

Function Contains(refCompModels() As RefCompModel, model As SldWorks.ModelDoc2, conf As String) As Boolean

Contains = False

If (Not refCompModels) <> -1 Then

Dim i As Integer

For i = 0 To UBound(refCompModels)

If refCompModels(i).RefModel Is model And LCase(refCompModels(i).RefConf) = LCase(conf) Then
Contains = True
Exit Function
End If

Next

End If

End Function

Function GetCsvFileFullPath(macroFeatDef As SldWorks.MacroFeatureData, model As SldWorks.ModelDoc2) As String

Dim csvFilePath As String

macroFeatDef.GetStringByName PARAM_CSV_PATH, csvFilePath

If Left(csvFilePath, 1) = "\" And Mid(csvFilePath, 2, 1) <> "\" Then 'if relative but not UNC

modelDir = model.GetPathName

If modelDir <> "" Then
modelDir = Left(modelDir, InStrRev(modelDir, "\") - 1)
csvFilePath = modelDir & csvFilePath
End If

End If

GetCsvFileFullPath = csvFilePath

End Function

Sub WritePropertiesFromTable(model As SldWorks.ModelDoc2, table As Variant, confName As String, clearPrps As Boolean)

Dim i As Integer

Dim swCustPrpMgr As SldWorks.CustomPropertyManager

Set swCustPrpMgr = model.Extension.CustomPropertyManager(confName)

If clearPrps Then
ClearProperties swCustPrpMgr
End If

For i = 0 To UBound(table, 1)

Dim prpName As String
prpName = CStr(table(i, 0))

Dim prpVal As String
prpVal = CStr(table(i, 1))

If swCustPrpMgr.Add3(prpName, swCustomInfoType_e.swCustomInfoText, prpVal, swCustomPropertyAddOption_e.swCustomPropertyReplaceValue) <> swCustomInfoAddResult_e.swCustomInfoAddResult_AddedOrChanged Then
Err.Raise vbError, "", "Failed to add property '" & prpName & "'"
End If

Next

End Sub

Sub ClearProperties(custPrpMgr As SldWorks.CustomPropertyManager)

Dim vPrpNames As Variant
vPrpNames = custPrpMgr.GetNames

If Not IsEmpty(vPrpNames) Then

Dim i As Integer

For i = 0 To UBound(vPrpNames)
custPrpMgr.Delete2 CStr(vPrpNames(i))
Next

End If

End Sub

Function swmEditDefinition(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant

Dim swApp As SldWorks.SldWorks
Set swApp = varApp

Dim swModel As SldWorks.ModelDoc2
Set swModel = varDoc

Dim csvFilePath As String
Dim confSpecific As Boolean
Dim clearPrps As Boolean
Dim processComps As Boolean

If GetParameters(swApp, swModel, csvFilePath, confSpecific, clearPrps, processComps) Then

Dim swFeat As SldWorks.Feature

Set swFeat = varFeat

Dim swMacroFeat As SldWorks.MacroFeatureData
Set swMacroFeat = swFeat.GetDefinition()

swMacroFeat.AccessSelections swModel, Nothing

swMacroFeat.SetStringByName PARAM_CSV_PATH, csvFilePath
swMacroFeat.SetIntegerByName PARAM_CONF_SPEC_NAME, CLng(confSpecific)
swMacroFeat.SetIntegerByName PARAM_CLEAR_PROPERTIES, CLng(clearPrps)
swMacroFeat.SetIntegerByName PARAM_PROCESS_COMPONENTS, CLng(processComps)

swFeat.ModifyDefinition swMacroFeat, swModel, Nothing

End If

swmEditDefinition = True

End Function

Function swmSecurity(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant
swmSecurity = SwConst.swMacroFeatureSecurityOptions_e.swMacroFeatureSecurityByDefault
End Function