---

Public Sub ДиагностикаТелМеталлоконструкций()

    Dim App5 As Object
    Dim Doc3D As Object
    Dim Part5 As Object
    Dim Bodies As Object
    Dim Body5 As Object

    Dim App7 As Object
    Dim Doc7 As Object
    Dim TopPart7 As Object
    Dim Body7 As Object

    Dim CountBodies As Long
    Dim i As Long

    Dim BodyId As Long

    Dim NameText As String
    Dim MarkingText As String

    Dim Report As String

    Dim FilePath As String
    Dim F As Integer


    On Error GoTo FatalError


    ' ========================================================
    ' API 5
    ' ========================================================

    Set App5 = GetObject(, "Kompas.Application.5")

    If App5 Is Nothing Then

        Report = "API5: НЕ ПОЛУЧЕН"

        GoTo SaveReport

    End If


    Report = _
        "API5: ОК" & vbCrLf


    ' ========================================================
    ' ACTIVE DOCUMENT 3D
    ' ========================================================

    Set Doc3D = App5.ActiveDocument3D

    If Doc3D Is Nothing Then

        Report = Report & _
            "ActiveDocument3D: НЕ ПОЛУЧЕН"

        GoTo SaveReport

    End If


    Report = Report & _
        "ActiveDocument3D: ОК" & vbCrLf


    ' ========================================================
    ' PART
    ' ========================================================

    Set Part5 = Doc3D.GetPart(-1)

    If Part5 Is Nothing Then

        Report = Report & _
            "GetPart(-1): НЕ ПОЛУЧЕН"

        GoTo SaveReport

    End If


    Report = Report & _
        "GetPart(-1): ОК" & vbCrLf


    ' ========================================================
    ' BODY COLLECTION
    ' ========================================================

    Set Bodies = Part5.BodyCollection

    If Bodies Is Nothing Then

        Report = Report & _
            "BodyCollection: НЕ ПОЛУЧЕН"

        GoTo SaveReport

    End If


    Report = Report & _
        "BodyCollection: ОК" & vbCrLf


    ' ========================================================
    ' КОЛИЧЕСТВО
    ' ========================================================

    CountBodies = Bodies.GetCount

    Report = Report & _
        "Количество тел: " & _
        CountBodies & _
        vbCrLf & vbCrLf


    ' ========================================================
    ' API7
    ' ========================================================

    Set App7 = Nothing
    Set Doc7 = Nothing
    Set TopPart7 = Nothing


    On Error Resume Next

    Set App7 = GetObject(, "KOMPAS.Application.7")

    If Not App7 Is Nothing Then

        Set Doc7 = App7.ActiveDocument

        If Not Doc7 Is Nothing Then

            Set TopPart7 = Doc7.TopPart

        End If

    End If

    On Error GoTo FatalError


    If TopPart7 Is Nothing Then

        Report = Report & _
            "API7 TopPart: НЕ ПОЛУЧЕН" & vbCrLf

    Else

        Report = Report & _
            "API7 TopPart: ОК" & vbCrLf

    End If


    Report = Report & vbCrLf


    ' ========================================================
    ' ПЕРЕБОР 31 ТЕЛ
    ' ========================================================

    For i = 0 To CountBodies - 1


        Set Body5 = Nothing
        Set Body7 = Nothing


        Report = Report & _
            "----------------------------------------------" & _
            vbCrLf

        Report = Report & _
            "ТЕЛО № " & (i + 1) & _
            vbCrLf


        ' ====================================================
        ' Получаем ksBody
        ' ====================================================

        On Error Resume Next

        Set Body5 = Bodies.GetByIndex(i)

        On Error GoTo FatalError


        If Body5 Is Nothing Then

            Report = Report & _
                "ksBody: НЕ ПОЛУЧЕН" & _
                vbCrLf & vbCrLf

            GoTo NextBody

        End If


        Report = Report & _
            "ksBody: ОК" & vbCrLf


        ' ====================================================
        ' BODY ID
        '
        ' У ksBody пытаемся получить идентификатор.
        ' ====================================================

        BodyId = 0


        On Error Resume Next

        Err.Clear

        BodyId = CLng(Body5.BodyId)

        If Err.Number <> 0 Then

            Err.Clear

            BodyId = CLng(Body5.GetBodyId)

        End If

        On Error GoTo FatalError


        If BodyId = 0 Then

            Report = Report & _
                "BodyId: НЕ ПОЛУЧЕН" & _
                vbCrLf

            GoTo NextBody

        End If


        Report = Report & _
            "BodyId: " & BodyId & _
            vbCrLf


        ' ====================================================
        ' GET BODY7
        ' ====================================================

        If Not TopPart7 Is Nothing Then


            On Error Resume Next

            Err.Clear

            Set Body7 = _
                TopPart7.GetBodyById(BodyId)

            If Err.Number <> 0 Then

                Err.Clear

                Set Body7 = _
                    TopPart7.FindBody(CStr(BodyId))

            End If

            On Error GoTo FatalError


        End If


        If Body7 Is Nothing Then

            Report = Report & _
                "IBody7: НЕ ПОЛУЧЕН" & _
                vbCrLf & vbCrLf

            GoTo NextBody

        End If


        Report = Report & _
            "IBody7: ОК" & _
            vbCrLf


        ' ====================================================
        ' NAME
        ' ====================================================

        NameText = ""


        On Error Resume Next

        Err.Clear

        NameText = CStr(Body7.Name)

        If Err.Number <> 0 Then

            Err.Clear
            NameText = "НЕ ПОЛУЧЕНО"

        End If

        On Error GoTo FatalError


        Report = Report & _
            "Name: " & NameText & _
            vbCrLf


        ' ====================================================
        ' MARKING
        ' ====================================================

        MarkingText = ""


        On Error Resume Next

        Err.Clear

        MarkingText = CStr(Body7.Marking)

        If Err.Number <> 0 Then

            Err.Clear
            MarkingText = "НЕ ПОЛУЧЕНО"

        End If

        On Error GoTo FatalError


        Report = Report & _
            "Marking: " & MarkingText & _
            vbCrLf


NextBody:

        DoEvents

    Next i


    Report = Report & _
        vbCrLf & _
        "==============================================" & _
        vbCrLf & _
        "КОНЕЦ ДИАГНОСТИКИ"


SaveReport:

    ' ========================================================
    ' Сохраняем в TXT
    ' ========================================================

    FilePath = _
        Environ$("TEMP") & _
        "\Kompas_Body_Diagnostic.txt"


    F = FreeFile

    Open FilePath For Output As #F

    Print #F, Report

    Close #F


    ' ========================================================
    ' Открываем Блокнот
    ' ========================================================

    Shell _
        "notepad.exe " & _
        Chr$(34) & _
        FilePath & _
        Chr$(34), _
        vbNormalFocus


    Exit Sub


FatalError:

    Report = Report & _
        vbCrLf & vbCrLf & _
        "КРИТИЧЕСКАЯ ОШИБКА" & _
        vbCrLf & _
        "№ " & Err.Number & _
        vbCrLf & _
        Err.Description


    On Error Resume Next

    FilePath = _
        Environ$("TEMP") & _
        "\Kompas_Body_Diagnostic.txt"

    F = FreeFile

    Open FilePath For Output As #F

    Print #F, Report

    Close #F

    Shell _
        "notepad.exe " & _
        Chr$(34) & _
        FilePath & _
        Chr$(34), _
        vbNormalFocus

End Sub