[doctorraz]

В коде ниже я выбираю в коллекцию все линии документа. (линии для примера, пытаюсь ковырять прокси, с энаблером)
и потом идет перебор свойств.

Код:

[Выделить все]

Sub main()
 Dim intType(0) As Integer
  Dim varDat(0) As Variant
    intType(0) = 0
    varDat(0) = "LINE"
    Set objSelSet = vbdPowerSet("sortblocks")
    objSelSet.Select acSelectionSetAll, filtertype:=intType, filterdata:=varDat

    For Each objBlkRef In objSelSet
			Цвет = objBlkRef.Color
			Угол = objBlkRef.Angle
    Next objBlkRef

End Sub

Public Function vbdPowerSet(strName As String) As AcadSelectionSet
  Dim objSelSet As AcadSelectionSet
  Dim objSelCol As AcadSelectionSets
  Set objSelCol = ThisDrawing.SelectionSets
    For Each objSelSet In objSelCol
      If objSelSet.Name = strName Then
        objSelSet.Delete
        Exit For
      End If
    Next
  Set objSelSet = ThisDrawing.SelectionSets.Add(strName)
  Set vbdPowerSet = objSelSet
End Function

в принципе почти все свойства objBlkRef видны в локалс (за исключением габаритов)
используя код Lisp:

Код:

[Выделить все]

(entget(car(entsel)))

получаю еще свойства объекта недоступные из VBA, в частности интересует Model
((-1 . <Имя объекта: 7ffffb08c30>) (0 . "LINE") (5 . "5DB")
(102 . "{ACAD_XDICTIONARY") (360 . <Имя объекта: 7ffffb08e00>) (102 . "}") (330
. <Имя объекта: 7ffffb039f0>) (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8
. "0") (100 . "AcDbLine") (10 640.946 -489.527 0.0) (11 1381.33 -489.527 0.0)
(210 0.0 0.0 1.0))
Собственно вопрос, как можно из VBA достучаться до этих свойств?

[ssn]

я делал проверку принадлежности к тому или иному пространству через Block.ObjectID32
узнавал номер пространства (Модель, лист1, лист2. и так далее) и потом сравнивал с OwnerID32 объекта

понимаю, я тот ещё програмист, но вдруг поможет )

Код:

[Выделить все]

 Set oLayout = Acdoc.Layouts("Model")
oID = oLayout.Block.ObjectID32

Объект1.OwnerID32 <> oID

[doctorraz]

спасибо, но в объекте могут быть другие свойства (сторонние типа прокси с энаблером), как до них достучаться?

[Кулик Алексей aka kpblc]

Наверняка через СОМ, по-другому вряд ли получится (и то только при наличии ObejctEnabler)

[doctorraz]

через СОМ получается, легко..
может задачу ставлю неправильно.
Мне нужно получить все объекты из документа (лист и модель) по фильтру
Последовательным обходом вкладок получается собрать коллекцию, но листы моргают, регениерируют, тормозят, а в СОМ метода получить всю коллекцию сразу я не нашел.
Потому попробовал через SelectionSets, но через него недоступны свойства объектов, которые нужны , но есть в СОМ.
Круг замкнулся ((

[Кулик Алексей aka kpblc]

Проходишь по всем описаниям блоков в текущем документе, заходишь внутрь каждого описания и получаешь что хочется.

----- добавлено через ~4 мин. -----
Без проверки, только для иллюстрации идеи:

Код:

[Выделить все]

Option Explicit

Public Sub test()
Dim BlkDef As AcadBlock
Dim ent As AcadEntity

  For Each BlkDef In ThisDrawing.Blocks
    If InStr(UCase(BlkDef.Name), "SPACE*") Then
      For Each ent In BlkDef
        ' ...
      Next
    End If
  Next
End Sub

[doctorraz]

если перебирать AcadEntity, то получается та же проблема, что и SelectionSets, нет доступа к свойствам "прокси"
поэтому так по кривому (((

Код:

[Выделить все]

Function МСсборСоВсехЛистов() 'МаркерСпец
    Dim Layouts As AcadLayouts, Layout As AcadLayout
    Dim МаркерСпец  As McCOM2.ObjectsCollection
    Dim МаркерСпецTemp As McCOM2.ObjectsCollection
    Dim АдресМодели As String
'----------------------------------
    ThisDrawing.SetVariable "regenmode", 0
    Set Layouts = ThisDrawing.Layouts
    АдресМодели = ThisDrawing.ActiveLayout.Name '  запоминаем лист где находимся
    Set МаркерСпец = SPDS.Query(ОбъектПоиска, УсловияПоиска)  'собираем с текущего
    For Each Layout In Layouts
'    добавить
        If Layout.Name <> АдресМодели Then 'проверочка что с него начали, что б с него не собирать
            ThisDrawing.ActiveLayout = ThisDrawing.Layouts.Item(Layout.Name)
            Set МаркерСпецTemp = SPDS.Query(ОбъектПоиска, УсловияПоиска)
            If МаркерСпецTemp.Count > 0 Then Set МаркерСпец = МаркерСпец.Or(МаркерСпецTemp)
        End If
    Next Layout
    ThisDrawing.ActiveLayout = ThisDrawing.Layouts.Item(АдресМодели) '    вернемся откуда пришли
   Set МСсборСоВсехЛистов = МаркерСпец
   ThisDrawing.SetVariable "regenmode", 1
End Function