---

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 subDim As Object
    Dim ch As Object
    Dim pm As Object
    Dim partDim 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 actualL As Double

    Dim cfgName As String
    Dim oldSubDoc As String
    Dim oldPartDoc As String
    Dim rep As String

    Dim ok 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/5: 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.01 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

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

    oldSubDoc = _
        swSub.ConfigurationManager.ActiveConfiguration.Name

    Status swTop, _
        "STEP 2/5: subassembly " & cfgName & "..."

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

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

    swSub.ShowConfiguration2 cfgName
    swSub.EditRebuild3

    Set subDim = Nothing
    Set subDim = FindLenDim(swSub)

    If subDim Is Nothing Then
        swSub.ShowConfiguration2 oldSubDoc
        MsgBox "SUB D1@LENGHT NOT FOUND"
        Exit Sub
    End If

    ok = SetLengthThisConfig( _
        swSub, subDim, L, cfgName)

    If Not ok Then
        swSub.ShowConfiguration2 oldSubDoc

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

    swSub.ShowConfiguration2 cfgName
    swSub.EditRebuild3

    actualL = subDim.SystemValue * 1000

    If Abs(actualL - L) >= 0.05 Then
        swSub.ShowConfiguration2 oldSubDoc

        MsgBox "SUB LENGTH VERIFY FAILED" & vbCrLf & _
               "EXPECTED: " & FormatMM(L) & vbCrLf & _
               "ACTUAL: " & FormatMM(actualL)
        Exit Sub
    End If

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

    comp.ReferencedConfiguration = cfgName

    Status swTop, _
        "STEP 3/5: rebuild top assembly..."

    swTop.EditRebuild3

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

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

    Status swTop, _
        "STEP 4/5: processing parts..."

    swSub.ShowConfiguration2 cfgName
    swSub.EditRebuild3

    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 4/5: " & _
                            ch.Name2 & "..."

                        oldPartDoc = _
                            pm.ConfigurationManager. _
                            ActiveConfiguration.Name

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

                        If cfgObj Is Nothing Then

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

                        Else

                            pm.ShowConfiguration2 cfgName
                            pm.EditRebuild3

                            Set partDim = Nothing
                            Set partDim = FindLenDim(pm)

                            If partDim Is Nothing Then

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

                            Else

                                ok = SetLengthThisConfig( _
                                    pm, _
                                    partDim, _
                                    L, _
                                    cfgName)

                                pm.ShowConfiguration2 cfgName
                                pm.EditRebuild3

                                actualL = _
                                    partDim.SystemValue * 1000

                                If ok Then

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

                                    ch.ReferencedConfiguration = _
                                        cfgName

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

                                Else

                                    rep = rep & _
                                          ch.Name2 & _
                                          " : SET FAILED" & _
                                          " EXPECTED " & _
                                          FormatMM(L) & _
                                          " ACTUAL " & _
                                          FormatMM(actualL) & _
                                          vbCrLf

                                End If

                            End If

                        End If

                        pm.ShowConfiguration2 oldPartDoc

                    End If

                End If

            End If

        Next i

    End If

    Status swTop, _
        "STEP 5/5: 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

    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 activeName As String
    Dim checkMM As Double

    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

    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