---

Sub main()
    On Error GoTo EH

    Dim swApp As Object
    Dim swTop As Object
    Dim swSel As Object
    Dim comp As Object
    Dim swSub As Object
    Dim o As Object
    Dim dd As Object
    Dim d As Object
    Dim ch As Object
    Dim pm As Object
    Dim pd As Object
    Dim cfgObj As Object

    Dim v As Variant

    Dim i As Long
    Dim cnt As Long
    Dim t As Long
    Dim e As Long
    Dim w As Long

    Dim L As Double
    Dim curL As Double
    Dim oldL As Double
    Dim checkL As Double

    Dim cfgName As String
    Dim oldSubDoc As String
    Dim oldSubRef As String
    Dim oldPartDoc As String
    Dim oldPartRef As String
    Dim pcfg As String
    Dim rep As String

    Dim okSet As Boolean

    Set swApp = Application.SldWorks
    Set swTop = swApp.ActiveDoc

    If swTop Is Nothing Then
        MsgBox "NO DOC"
        Exit Sub
    End If

    If swTop.GetType <> 2 Then
        MsgBox "OPEN TOP ASSEMBLY"
        Exit Sub
    End If

    Status swTop, "STEP 1/4: reading selection..."

    Set swSel = swTop.SelectionManager
    cnt = swSel.GetSelectedObjectCount2(-1)

    If cnt < 2 Then
        MsgBox "SELECT DIMENSION + SUBASSEMBLY WITH CTRL"
        Exit Sub
    End If

    Set comp = Nothing
    L = 0

    For i = 1 To cnt

        t = swSel.GetSelectedObjectType3(i, -1)
        Set o = swSel.GetSelectedObject6(i, -1)

        If t = 20 Then

            If comp Is Nothing Then
                Set comp = o
            End If

        ElseIf t = 14 Then

            Set dd = Nothing
            Set dd = o.GetDimension

            If Not dd Is Nothing Then
                L = dd.SystemValue * 1000
            End If

        End If

    Next i

    If comp Is Nothing Then
        MsgBox "NO SUBASSEMBLY SELECTED"
        Exit Sub
    End If

    If L <= 0 Then
        MsgBox "NO DIMENSION FOUND"
        Exit Sub
    End If

    Set swSub = comp.GetModelDoc2

    If swSub Is Nothing Then
        MsgBox "SUB NOT LOADED - SET LIGHTWEIGHT TO RESOLVED"
        Exit Sub
    End If

    If swSub.GetType <> 2 Then
        MsgBox "SELECT SUBASSEMBLY"
        Exit Sub
    End If

    oldSubDoc = swSub.ConfigurationManager.ActiveConfiguration.Name
    oldSubRef = comp.ReferencedConfiguration

    If Len(oldSubRef) = 0 Then
        oldSubRef = oldSubDoc
    End If

    Status swTop, "STEP 2/4: creating sub config..."

    swSub.ShowConfiguration2 oldSubRef
    swSub.EditRebuild3

    Set d = FindLenDim(swSub)

    If d Is Nothing Then
        MsgBox "SUB D1@LENGHT NOT FOUND"
        Exit Sub
    End If

    oldL = d.SystemValue * 1000

    cfgName = "L_" & CStr(CLng(L))

    Set cfgObj = Nothing
    Set cfgObj = EnsureConfig(swSub, cfgName)

    If cfgObj Is Nothing Then
        MsgBox "CANNOT CREATE SUB CONFIG " & cfgName
        Exit Sub
    End If

    okSet = SetLengthThisConfig(swSub, d, L, cfgName)

    If Not okSet Then
        swSub.ShowConfiguration2 oldSubDoc

        MsgBox "CANNOT SET SUB LENGTH" & vbCrLf & _
               "CONFIG: " & cfgName
        Exit Sub
    End If

    swSub.ShowConfiguration2 oldSubRef
    swSub.EditRebuild3

    checkL = d.SystemValue * 1000

    If oldSubRef <> cfgName Then

        If Abs(checkL - oldL) > 0.05 Then

            MsgBox "STOP: OLD SUB CONFIG CHANGED" & vbCrLf & _
                   oldSubRef & " : " & _
                   FormatMM(oldL) & " -> " & _
                   FormatMM(checkL) & " mm"

            Exit Sub

        End If

    End If

    swSub.ShowConfiguration2 cfgName
    swSub.EditRebuild3

    e = 0
    w = 0
    swSub.Save3 1, e, w

    comp.ReferencedConfiguration = cfgName

    swTop.EditRebuild3

    e = 0
    w = 0
    swTop.Save3 1, e, w

    swSub.ShowConfiguration2 cfgName
    swSub.EditRebuild3

    rep = "SUB : " & _
          FormatMM(L) & " mm -> " & _
          cfgName & vbCrLf & vbCrLf

    Status swTop, "STEP 3/4: processing parts..."

    v = swSub.GetComponents(False)

    If IsArray(v) Then

        For i = 0 To UBound(v)

            Set ch = Nothing
            Set ch = v(i)

            If Not ch Is Nothing Then

                If ch.IsSuppressed Then

                    rep = rep & ch.Name2 & _
                          " : SUPPRESSED - SKIPPED" & _
                          vbCrLf

                Else

                    Set pm = Nothing
                    Set pm = ch.GetModelDoc2

                    If pm Is Nothing Then

                        rep = rep & ch.Name2 & _
                              " : NOT LOADED - SKIPPED" & _
                              vbCrLf

                    ElseIf pm.GetType = 2 Then

                        rep = rep & ch.Name2 & _
                              " : NESTED SUBASSEMBLY - SKIPPED" & _
                              vbCrLf

                    ElseIf pm.GetType = 1 Then

                        Status swTop, _
                               "STEP 3/4: " & ch.Name2 & "..."

                        oldPartDoc = _
                            pm.ConfigurationManager. _
                            ActiveConfiguration.Name

                        oldPartRef = ch.ReferencedConfiguration

                        If Len(oldPartRef) = 0 Then
                            oldPartRef = oldPartDoc
                        End If

                        swSub.ShowConfiguration2 cfgName
                        swSub.EditRebuild3

                        pm.ShowConfiguration2 oldPartRef
                        pm.EditRebuild3

                        Set pd = Nothing
                        Set pd = FindLenDim(pm)

                        If pd Is Nothing Then

                            rep = rep & ch.Name2 & _
                                  " : NO D1@LENGHT" & _
                                  vbCrLf

                            pm.ShowConfiguration2 oldPartDoc

                        Else

                            curL = pd.SystemValue * 1000

                            If curL <= 0.01 Then

                                rep = rep & ch.Name2 & _
                                      " : ZERO LENGTH" & _
                                      vbCrLf

                                pm.ShowConfiguration2 oldPartDoc

                            Else

                                pcfg = _
                                    "L_" & CStr(CLng(curL))

                                Set cfgObj = Nothing
                                Set cfgObj = _
                                    EnsureConfig(pm, pcfg)

                                If cfgObj Is Nothing Then

                                    rep = rep & ch.Name2 & _
                                          " : CANNOT CREATE " & _
                                          pcfg & vbCrLf

                                    pm.ShowConfiguration2 _
                                        oldPartDoc

                                Else

                                    okSet = _
                                        SetLengthThisConfig( _
                                            pm, _
                                            pd, _
                                            curL, _
                                            pcfg)

                                    If okSet Then

                                        pm.ShowConfiguration2 pcfg
                                        pm.EditRebuild3

                                        e = 0
                                        w = 0
                                        pm.Save3 1, e, w

                                        ch.ReferencedConfiguration = _
                                            pcfg

                                        rep = rep & _
                                              ch.Name2 & _
                                              " : " & _
                                              FormatMM(curL) & _
                                              " mm -> " & _
                                              pcfg & _
                                              vbCrLf

                                    Else

                                        rep = rep & _
                                              ch.Name2 & _
                                              " : " & _
                                              FormatMM(curL) & _
                                              " mm -> " & _
                                              pcfg & _
                                              " [SET FAILED]" & _
                                              vbCrLf

                                    End If

                                    pm.ShowConfiguration2 _
                                        oldPartDoc

                                End If

                            End If

                        End If

                    End If

                End If

            End If

        Next i

    End If

    Status swTop, "STEP 4/4: final rebuild + save..."

    swSub.ShowConfiguration2 cfgName
    swSub.EditRebuild3

    e = 0
    w = 0
    swSub.Save3 1, e, w

    comp.ReferencedConfiguration = cfgName

    swTop.EditRebuild3

    e = 0
    w = 0
    swTop.Save3 1, e, w

    swSub.ShowConfiguration2 oldSubDoc

    Status swTop, "READY"

    MsgBox "DONE " & cfgName & _
           vbCrLf & vbCrLf & rep

    Exit Sub

EH:
    MsgBox "ERROR: " & Err.Description
End Sub

Private Function FindLenDim(m As Object) As Object

    Dim d As Object

    Set FindLenDim = Nothing
    Set d = Nothing

    On Error Resume Next

    Set d = m.Parameter("D1@LENGHT")

    If d Is Nothing Then
        Set d = m.Parameter("D1@LENGTH")
    End If

    If d Is Nothing Then
        Set d = m.Parameter("D2@LENGHT")
    End If

    If d Is Nothing Then
        Set d = m.Parameter("D2@LENGTH")
    End If

    Err.Clear
    On Error GoTo 0

    If Not d Is Nothing Then
        Set FindLenDim = d
    End If

End Function

Private Function EnsureConfig( _
    m As Object, _
    cfg As String) As Object

    Dim c As Object

    Set EnsureConfig = Nothing
    Set c = Nothing

    On Error Resume Next

    Set c = m.GetConfigurationByName(cfg)

    If c Is Nothing Then

        Err.Clear

        Set c = m.AddConfiguration3( _
            cfg, "", "", 0)

        If c Is Nothing Then

            Err.Clear

            Set c = _
                m.ConfigurationManager.AddConfiguration2( _
                    cfg, "", "", 0, "", "")

        End If

    End If

    Err.Clear
    On Error GoTo 0

    Set EnsureConfig = c

End Function

Private Function SetLengthThisConfig( _
    m As Object, _
    d As Object, _
    valMM As Double, _
    cfg As String) As Boolean

    Dim r As Long
    Dim checkMM As Double
    Dim activeName As String

    SetLengthThisConfig = False

    m.ShowConfiguration2 cfg
    m.EditRebuild3

    activeName = _
        m.ConfigurationManager.ActiveConfiguration.Name

    If StrComp(activeName, cfg, vbTextCompare) <> 0 Then
        Exit Function
    End If

    On Error Resume Next

    Err.Clear

    r = d.SetSystemValue3( _
        valMM / 1000, 0, Empty)

    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo 0
        Exit Function
    End If

    On Error GoTo 0

    m.EditRebuild3
    m.ShowConfiguration2 cfg
    m.EditRebuild3

    activeName = _
        m.ConfigurationManager.ActiveConfiguration.Name

    If StrComp(activeName, cfg, vbTextCompare) <> 0 Then
        Exit Function
    End If

    checkMM = d.SystemValue * 1000

    If Abs(checkMM - valMM) < 0.05 Then
        SetLengthThisConfig = True
    End If

End Function

Private Function FormatMM(v As Double) As String

    If Abs(v - CDbl(CLng(v))) < 0.01 Then
        FormatMM = CStr(CLng(v))
    Else
        FormatMM = Format(v, "0.00")
    End If

End Function

Private Sub Status(m As Object, txt As String)

    On Error Resume Next

    m.SetStatusBarText txt

    Err.Clear
    On Error GoTo 0

End Sub