Считывание таблицы исполнений. API7.

[lavgirb]

Как у ТС хоть что-то может работать, если у него "тип переменной" закоментирован?

При определенных условиях может, если тип не задан, переменной присваивается  универсальный тип Variant.

[dedyukhinnp]

Не обязательно. По ГОСТ, если у исполнений масса одинаковая, она указывается в осн. надписи. Как постоянная часть в групповом чертеже.

С этим согласен, да.
Могут быть такие случаи.

А как можно ещё определить есть ли в поле "Масса" ссылка "См. табл"?

[dedyukhinnp]

А как просто перебрать ВСЕ объекты на чертеже? Например, так допустим попробовать  ...

[lavgirb]

Я, получается, добавил вывод в сообщение тип объекта iSymbols2DContainer (я предполагал, что он должен был быть ISymbols2DContainer) - там вывелось, что у меня тип IAssociationView, то есть не то что-то попало в объект

Так и должно показывать.

Возможно, Вы рановато взялись за решение поставленных задач.

[dedyukhinnp]

Так и должно показывать.

Возможно, Вы рановато взялись за решение поставленных задач.

хорошо, пусть показывает IAssociationView

дальше я провел тест, какие свойства доступны у объекта

Код Выделить Развернуть

' Ключевое свойство ISymbols2DContainer
Set testObj = iSymbols2DContainer.AngleDimensions
If Err.Number = 0 Then
  msg = msg & "v ISymbols2DContainer свойства доступны" & vbCrLf
  msg = msg & "  AngleDimensions: " & TypeName(testObj) & vbCrLf
Else
  Err.Clear
  msg = msg & "v AngleDimensions недоступно" & vbCrLf
End If

' Ключевое свойство IAssociationView
testStr = iSymbols2DContainer.SourceFileName
If Err.Number = 0 Then
  msg = msg & "v IAssociationView свойства доступны" & vbCrLf
  msg = msg & "  SourceFileName: " & testStr & vbCrLf
Else
  Err.Clear
  msg = msg & "? SourceFileName недоступно" & vbCrLf
End If
программа определила, что свойство AngleDimensions недоступно (свойство характерное для ISymbols2DContainer), но при этом свойство SourceFileName доступно (свойство, характерное для IAssociationView)

[lavgirb]

хорошо, пусть показывает IAssociationView

дальше я провел тест, какие свойства доступны у объекта

Код Выделить Развернуть

' Ключевое свойство ISymbols2DContainer
Set testObj = iSymbols2DContainer.AngleDimensions
If Err.Number = 0 Then
  msg = msg & "v ISymbols2DContainer свойства доступны" & vbCrLf
  msg = msg & "  AngleDimensions: " & TypeName(testObj) & vbCrLf
Else
  Err.Clear
  msg = msg & "v AngleDimensions недоступно" & vbCrLf
End If

' Ключевое свойство IAssociationView
testStr = iSymbols2DContainer.SourceFileName
If Err.Number = 0 Then
  msg = msg & "v IAssociationView свойства доступны" & vbCrLf
  msg = msg & "  SourceFileName: " & testStr & vbCrLf
Else
  Err.Clear
  msg = msg & "? SourceFileName недоступно" & vbCrLf
End If
программа определила, что свойство AngleDimensions недоступно (свойство характерное для ISymbols2DContainer), но при этом свойство SourceFileName доступно (свойство, характерное для IAssociationView)

Эксперименты оно наше все!

[Student2025]

dedyukhinnp,

Среда VB6 или VBS ?

[p3452]

Эксперименты оно наше все!

+ 100500

[dedyukhinnp]

dedyukhinnp,

Среда VB6 или VBS ?

VBScript

[Vi2]

Как у ТС хоть что-то может работать, если у него "тип переменной" закоментирован?

Да вот так работает VBasic. Если тип не указан, то пишется As Object (As Variant), т.е. по-высоколингвистическому это интерфейс iDispatch. И вычисления идут немного сложнее: запрашивается имя метода, узнаётся его номер и вызывается метод уже по номеру. А не путём виртуальной таблицы. Никакой магии.

[Vi2]

Если объект поддерживает два и более дуальных интерфейса, то в скриптах невозможно получить неглавные. А какой главный, определяет разработчик объекта. На vb6 или Оффисных продуктах это можно сделать, добавив tlb описания типов и интерфейсов. Тогда vb6 или Оффисе будет запрашивать конкретный интерфейс и не работать с ним через IDispatch. Скрипт лишен такой возможности.

[p3452]

Да вот так работает VBasic. Если тип не указан, то пишется As Object (As Variant), т.е. по-высоколингвистическому это интерфейс iDispatch.

- А в исходном коде ТС мы ЭТО где-нибудь видим?

[Student2025]

VBScript

Он не поддерживает определение типа объекта

Вижу вам уже несколько раз об этом написали.

Помощь слепого - глухонемому:

дальше я провел тест, какие свойства доступны у объекта

А если так  проверить какие объекты это свойство содержит?

Код Выделить Развернуть

Sub ListObjectMembers(obj)
    On Error Resume Next
    Dim tliApp, tliTypeInfo, member
    Set tliApp = CreateObject("TLI.TLIApplication")
   
    Set tliTypeInfo = tliApp.TypeLibInfoFromObject(obj)
   
    If Err.Number = 0 Then
        For Each member In tliTypeInfo.Members
            WScript.Echo member.Name & " (" & member.InvokeKind & ")"
        Next
    Else
        WScript.Echo "Не удалось получить информацию о типе"
    End If
End Sub

' Использование:
ListObjectMembers iSymbols2DContainer


[Student2025]

'получим интерфейс "2D размеры и обозначения"
Set iSymbols2DContainer = iView 'Здесь выполнится QueryInterface

А если так ?

Код Выделить Развернуть

Set iSymbols2DContainer = kompasApp7.iSymbols2DContainer(iView)

[lavgirb]

- А в исходном коде ТС мы ЭТО где-нибудь видим?

Вот из справочника по VB6

[dedyukhinnp]

Он не поддерживает определение типа объекта

Вижу вам уже несколько раз об этом написали.

Помощь слепого - глухонемому:

А если так  проверить какие объекты это свойство содержит?

Код Выделить Развернуть

Sub ListObjectMembers(obj)
    On Error Resume Next
    Dim tliApp, tliTypeInfo, member
    Set tliApp = CreateObject("TLI.TLIApplication")
   
    Set tliTypeInfo = tliApp.TypeLibInfoFromObject(obj)
   
    If Err.Number = 0 Then
        For Each member In tliTypeInfo.Members
            WScript.Echo member.Name & " (" & member.InvokeKind & ")"
        Next
    Else
        WScript.Echo "Не удалось получить информацию о типе"
    End If
End Sub

' Использование:
ListObjectMembers iSymbols2DContainer


Сделал так как Вы порекомендовали:

Код Выделить Развернуть

'получим интерфейс активного вида графического документа
Set iView = iViews.ActiveView

'получим интерфейс "2D размеры и обозначения"
Set iSymbols2DContainer = iView 'Здесь выполнится QueryInterface

On Error Resume Next

Dim tliApp, tliTypeInfo, member
Set tliApp = CreateObject("TLI.TLIApplication")
Set tliTypeInfo = tliApp.TypeLibInfoFromObject(iSymbols2DContainer)

If Err.Number = 0 Then
  For Each member In tliTypeInfo.Members
    msgbox(member.Name & " (" & member.InvokeKind & ")")
    Next
Else
  call theapp.ShowMessageBox("ИНФО", "Не удалось получить информацию о типе" )
End If
Вышло сообщение: "Не удалось получить информацию о типе"

Может есть какой-то ещё способ просто перебрать вообще все объекты? Я видел, что есть ksIterator, знаю что он как бы умеет позиционироваться на одном объекте, потом на следующем

Вот он, например, спозиционировался на объекте, а как вывести-то название типа объекта, на котором он спозиционировался?

Я бы вывел по очереди все названия всех объектов
И так бы убедился, есть у меня там среди объектов Таблица исполнений, или нет её..

[dedyukhinnp]

Вот такой код:

Код Выделить Развернуть

'-------------------------------------------------------------------------------
Sub start()
  'отключаем окошко "Прервать выполнение скрипта?"
  LogObject.ScriptTimeOut = 0

  ' Создание объектов
  Set KompasObject = CreateObject("Kompas.Application.5")
  ' Установка видимости приложения КОМПАС-3D
  KompasObject.Visible = True

  ' Путь к файлу чертежа
  Dim filePath
  filePath = "C:\Users\Nikita\AppData\Roaming\Techno\TEMP\тест210825-1621_тестовый чертеж.cdw"

  ' Открываем чертеж
  Dim ksDocument2D
  Set ksDocument2D = KompasObject.Document2D
  Call ksDocument2D.ksOpenDocument(filePath, 0) 'режим работы с документом: 0 - видимый

  ' Создаем итератор
  Dim iter
  Set iter = KompasObject.GetIterator()

  'по всем типам объектов
  Call iter.ksCreateIterator(ALL_OBJ, 0)

  ' Позиционируемся на первом объекте
  Dim obj
  obj = iter.ksMoveIterator("F")

  ' Выводим информацию о типе объекта
  call theapp.ShowMessageBox("ИНФО",  "тип = " & TypeName(obj) & chr(13) & _
                                      "obj = " & obj)

  ' Позиционируемся на следующем объекте
  obj = iter.ksMoveIterator("N")

  ' Выводим информацию о типе объекта
  call theapp.ShowMessageBox("ИНФО",  "тип = " & TypeName(obj) & chr(13) & _
                                      "obj = " & obj)

  'освобождаем объекты
  Set obj = Nothing
  Set iter = Nothing
  Set ksDocument2D = Nothing
  Set KompasObject = Nothing
End Sub
'-------------------------------------------------------------------------------
Когда его запускаю, то выводится два сообщения:




А узнать что это за объект - пока не понимаю...

Вроде как ksGetObjParam надо использовать

Получается он принимает 3 аргумента

В первом аргументе, как я понял надо передать вот это число

Во втором аргументе надо передать объект, куда сохранять буду параметры

И в третьем аргументе там например ALLPARAM - чтобы все параметры считать

а потом уже из этого объекта видимо надо как то вывести все что в нем содержится...

Пока что экспериментирую.

[lavgirb]

Что написали в коде, то и получили.
Не забывайте читать SDK по используемым свойствам и методам.
Там много интересного и полезного.

[dedyukhinnp]

В общем, кому-нибудь если пригодится - методом перебора всех объектов на чертеже (API5), код, который выписывает в лог всё что есть на чертеже, в том числе Таблицы исполнений!

Код Выделить Развернуть

'-------------------------------------------------------------------------------
Sub start()
  Dim fso
  Dim wshShell
  Dim logPath
  Dim logFile

  'создаём файл лога на рабочем столе
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set wshShell = CreateObject("WScript.Shell")
  logPath = wshShell.SpecialFolders("Desktop") & "\Перебор элементов чертежа КОМПАС_лог.txt"
  Set logFile = fso.CreateTextFile(logPath, True) ' True = перезаписать, если существует
  logFile.WriteLine "Начало работы макроса: " & Now()
  logFile.WriteLine "========================================="
  logFile.Close
  Set logFile = Nothing

  ' Создание объектов
  Set KompasObject = CreateObject("Kompas.Application.5")
  ' Установка видимости приложения КОМПАС-3D
  KompasObject.Visible = True

  ' Путь к файлу чертежа
  Dim filePath
  filePath = "C:\Users\Nikita\AppData\Roaming\Techno\TEMP\тест210825-1621_тестовый чертеж.cdw"

  ' Открываем чертеж
  Dim ksDocument2D
  Set ksDocument2D = KompasObject.Document2D
  Call ksDocument2D.ksOpenDocument(filePath, 0) 'режим работы с документом: 0 - видимый

  ' Создаем итератор
  Dim iter
  Set iter = KompasObject.GetIterator()

  'по всем типам объектов
  Call iter.ksCreateIterator(ALL_OBJ, 0)

  ' Позиционируемся на первом объекте
  Dim obj
  obj = iter.ksMoveIterator("F")

  While Not (obj = 0)
    ' Пытаемся определить тип объекта
    Dim type_
    Dim nullValue
    Set nullValue = Nothing
    type_ = ksDocument2D.ksGetObjParam(obj, nullValue, 0)

    ' Пытаемся определить название объекта
    Dim text
    text = ksDocument2D.ksGetObjectNameByType(type_)

    ' запись в лог
    Set logFile = fso.OpenTextFile(logPath, 8, True) ' 8 = ForAppending
    Call logFile.WriteLine("тип = " & TypeName(obj) & "; obj = " & obj & "; type = " & type_ & "; text = " & text)
    logFile.Close
    Set logFile = Nothing

    ' Позиционируемся на следующем объекте
    obj = iter.ksMoveIterator("N")
  Wend

  'запись в лог завершения работы
  Set logFile = fso.OpenTextFile(logPath, 8, True) ' 8 = ForAppending
  logFile.WriteLine "========================================="
  logFile.WriteLine "Конец работы макроса: " & Now()
  logFile.Close
  Set logFile = Nothing

  'освобождаем объекты
  Set obj = Nothing
  Set iter = Nothing
  Set ksDocument2D = Nothing
  Set KompasObject = Nothing
  Set wshShell = Nothing
  Set fso = Nothing
End Sub
'-------------------------------------------------------------------------------


Помогла книга Сергея Норсеева "Разработка приложений под КОМПАС с использованием API интефейсов версии 5". Спасибо Сергею!