index

Dim modelPath As String modelPath = model.GetPathName()

If modelPath <> "" Then
    Dim modelFolder As String
    modelFolder = Left(modelPath, InStrRev(modelPath, "\"))
    
    If Left(filePath, Len(modelFolder)) = modelFolder Then
        GetRelativeFilePath = Right(filePath, Len(filePath) - Len(modelFolder))
    End If
End If

End Function

Sub swmRebuild(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swFeat As SldWorks.Feature)

Dim csvFilePath As String
csvFilePath = swFeat.GetParameter(PARAM_CSV_PATH)

Dim confSpecific As Boolean
confSpecific = CBool(swFeat.GetParameter(PARAM_CONF_SPEC_NAME))

Dim clearPrps As Boolean
clearPrps = CBool(swFeat.GetParameter(PARAM_CLEAR_PROPERTIES))

Dim processComps As Boolean
processComps = CBool(swFeat.GetParameter(PARAM_PROCESS_COMPONENTS))

Dim csvTimeStamp As String
csvTimeStamp = swFeat.GetParameter(PARAM_CSV_TIME_STAMP)

Dim csvFileTimeStamp As String
csvFileTimeStamp = GetFileTimeStamp(csvFilePath)

If csvTimeStamp <> csvFileTimeStamp Or Not UPDATE_ON_CSV_FILE_CHANGE_ONLY 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, ""), clearPrps

    If processComps 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
    
    swFeat.SetParameter PARAM_CSV_TIME_STAMP, csvFileTimeStamp
    
End If

End Sub

Sub swmEditDefinition(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swFeat As SldWorks.Feature)

Dim csvFilePath As String
csvFilePath = swFeat.GetParameter(PARAM_CSV_PATH)

Dim confSpecific As Boolean
confSpecific = CBool(swFeat.GetParameter(PARAM_CONF_SPEC_NAME))

Dim clearPrps As Boolean
clearPrps = CBool(swFeat.GetParameter(PARAM_CLEAR_PROPERTIES))

Dim processComps As Boolean
processComps = CBool(swFeat.GetParameter(PARAM_PROCESS_COMPONENTS))

Dim csvTimeStamp As String
csvTimeStamp = swFeat.GetParameter(PARAM_CSV_TIME_STAMP)

Dim csvFileTimeStamp As String
csvFileTimeStamp = GetFileTimeStamp(csvFilePath)

If csvTimeStamp <> csvFileTimeStamp Or Not UPDATE_ON_CSV_FILE_CHANGE_ONLY 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, ""), clearPrps

    If processComps 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
    
    swFeat.SetParameter PARAM_CSV_TIME_STAMP, csvFileTimeStamp
    
End If

End Sub

Sub swmSecurity(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swFeat As SldWorks.Feature)

Dim csvFilePath As String
csvFilePath = swFeat.GetParameter(PARAM_CSV_PATH)

Dim confSpecific As Boolean
confSpecific = CBool(swFeat.GetParameter(PARAM_CONF_SPEC_NAME))

Dim clearPrps As Boolean
clearPrps = CBool(swFeat.GetParameter(PARAM_CLEAR_PROPERTIES))

Dim processComps As Boolean
processComps = CBool(swFeat.GetParameter(PARAM_PROCESS_COMPONENTS))

Dim csvTimeStamp As String
csvTimeStamp = swFeat.GetParameter(PARAM_CSV_TIME_STAMP)

Dim csvFileTimeStamp As String
csvFileTimeStamp = GetFileTimeStamp(csvFilePath)

If csvTimeStamp <> csvFileTimeStamp Or Not UPDATE_ON_CSV_FILE_CHANGE_ONLY 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, ""), clearPrps

    If processComps 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
    
    swFeat.SetParameter PARAM_CSV_TIME_STAMP, csvFileTimeStamp
    
End If

End Sub

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

Function GetFileTimeStamp(filePath As String) As String

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

Dim file As Object
Set file = fso.GetFile(filePath)

GetFileTimeStamp = CStr(file.DateLastModified)

End Function

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



```vba
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