---

Option Explicit

Public Sub ДиагностикаТел2()

    Dim App5 As Object
    Dim Doc3D As Object
    Dim Part5 As Object
    Dim Bodies As Object
    Dim Body As Object

    Dim i As Long
    Dim Cnt As Long

    Dim S As String
    Dim V As Variant

    On Error GoTo ErrHandler

    S = "ДИАГНОСТИКА ТЕЛ КОМПАС-3D" & vbCrLf & _
        "============================" & vbCrLf & vbCrLf


    ' =========================================================
    ' API5
    ' =========================================================

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

    If App5 Is Nothing Then
        MsgBox "API5 не получен.", vbCritical
        Exit Sub
    End If

    S = S & "API5: OK" & vbCrLf


    ' =========================================================
    ' DOCUMENT
    ' =========================================================

    Set Doc3D = App5.ActiveDocument3D

    If Doc3D Is Nothing Then
        MsgBox S & vbCrLf & _
               "ActiveDocument3D не получен.", _
               vbCritical
        Exit Sub
    End If

    S = S & "ActiveDocument3D: OK" & vbCrLf


    ' =========================================================
    ' ROOT PART
    ' =========================================================

    Set Part5 = Doc3D.GetPart(-1)

    If Part5 Is Nothing Then
        MsgBox S & vbCrLf & _
               "GetPart(-1) не получен.", _
               vbCritical
        Exit Sub
    End If

    S = S & "Root Part: OK" & vbCrLf


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

    Set Bodies = Part5.BodyCollection

    If Bodies Is Nothing Then

        MsgBox S & vbCrLf & _
               "BodyCollection не получен.", _
               vbCritical

        Exit Sub

    End If

    S = S & "BodyCollection: OK" & vbCrLf


    ' =========================================================
    ' COUNT
    ' =========================================================

    Cnt = Bodies.GetCount

    S = S & _
        "Количество тел: " & Cnt & _
        vbCrLf & vbCrLf


    ' =========================================================
    ' ПЕРЕБОР
    ' =========================================================

    For i = 0 To Cnt - 1

        Set Body = Nothing

        On Error Resume Next

        Set Body = Bodies.GetByIndex(i)

        On Error GoTo ErrHandler


        S = S & _
            "------------------------------" & vbCrLf

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


        If Body Is Nothing Then

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

        Else

            S = S & _
                "ksBody: OK" & vbCrLf


            ' =================================================
            ' ПРОБУЕМ РАЗНЫЕ СВОЙСТВА ksBody
            ' =================================================

            V = Empty

            On Error Resume Next
            Err.Clear

            V = Body.Name

            If Err.Number = 0 Then

                S = S & _
                    "Name: " & Безопасно(V) & _
                    vbCrLf

            Else

                Err.Clear

                S = S & _
                    "Name: НЕТ" & vbCrLf

            End If


            ' -------------------------------------------------
            ' ID
            ' -------------------------------------------------

            V = Empty

            Err.Clear

            V = Body.Id

            If Err.Number = 0 Then

                S = S & _
                    "Id: " & Безопасно(V) & _
                    vbCrLf

            Else

                Err.Clear

                S = S & _
                    "Id: НЕТ" & vbCrLf

            End If


            ' -------------------------------------------------
            ' NUMBER
            ' -------------------------------------------------

            V = Empty

            Err.Clear

            V = Body.Number

            If Err.Number = 0 Then

                S = S & _
                    "Number: " & Безопасно(V) & _
                    vbCrLf

            Else

                Err.Clear

                S = S & _
                    "Number: НЕТ" & vbCrLf

            End If


            ' -------------------------------------------------
            ' TYPE
            ' -------------------------------------------------

            V = Empty

            Err.Clear

            V = Body.Type

            If Err.Number = 0 Then

                S = S & _
                    "Type: " & Безопасно(V) & _
                    vbCrLf

            Else

                Err.Clear

                S = S & _
                    "Type: НЕТ" & vbCrLf

            End If


            ' -------------------------------------------------
            ' OWNER
            ' -------------------------------------------------

            V = Empty

            Err.Clear

            Set V = Nothing

            Set V = Body.Owner

            If Err.Number = 0 Then

                If Not V Is Nothing Then

                    S = S & _
                        "Owner: OK" & vbCrLf

                Else

                    S = S & _
                        "Owner: Nothing" & vbCrLf

                End If

            Else

                Err.Clear

                S = S & _
                    "Owner: НЕТ" & vbCrLf

            End If


            ' -------------------------------------------------
            ' SOURCE
            ' -------------------------------------------------

            V = Empty

            Err.Clear

            V = Body.Source

            If Err.Number = 0 Then

                S = S & _
                    "Source: " & Безопасно(V) & _
                    vbCrLf

            Else

                Err.Clear

                S = S & _
                    "Source: НЕТ" & vbCrLf

            End If


            ' -------------------------------------------------
            ' DOCUMENT
            ' -------------------------------------------------

            V = Empty

            Err.Clear

            Set V = Nothing

            Set V = Body.Document

            If Err.Number = 0 Then

                If Not V Is Nothing Then

                    S = S & _
                        "Document: OK" & vbCrLf

                Else

                    S = S & _
                        "Document: Nothing" & vbCrLf

                End If

            Else

                Err.Clear

                S = S & _
                    "Document: НЕТ" & vbCrLf

            End If

        End If


        ' Чтобы окно не стало гигантским,
        ' первые 31 тела всё равно покажем,
        ' но без лишнего текста.

    Next i


    S = S & vbCrLf & _
        "============================" & vbCrLf & _
        "ДИАГНОСТИКА ЗАВЕРШЕНА"


    MsgBox S, _
           vbInformation, _
           "Диагностика тел"


    Exit Sub


ErrHandler:

    MsgBox _
        S & vbCrLf & vbCrLf & _
        "ОШИБКА:" & vbCrLf & _
        Err.Number & vbCrLf & _
        Err.Description, _
        vbCritical, _
        "Диагностика"

End Sub


Private Function Безопасно(ByVal V As Variant) As String

    On Error GoTo ErrHandler

    If IsObject(V) Then

        Безопасно = "[OBJECT]"

    ElseIf IsNull(V) Then

        Безопасно = ""

    ElseIf IsEmpty(V) Then

        Безопасно = ""

    Else

        Безопасно = CStr(V)

    End If

    Exit Function

ErrHandler:

    Безопасно = "[ошибка]"

End Function