[Theodor]

Коллеги, доброго здоровичка!
Выручайте, не могу побороть проблемку в VBA.

Средствами метода .explode взрываю блок, но в блоке есть "маскировка". Важно, что бы все примитивы блока после расчленения были выше этой "маскировки" (так сказать на переднем плане чертежа). Кроме того, саму "маскировку" нельзя отправлять на задний план.

Алгоритм вижу такой:
- получить массив объектов после расчленения блоков
- удалить из массива "маскировку", или создать новый массив без этой маскировки.
- переместить оставшиеся объекты (примитивы) на передний план

Массив после расчленения получаю так:
Dim SetExpBlock as variant
SetExpBlock=OBlock.Explode 'OBlock - это статический блок на чертеже

а тут начинаются проблемы:
- как из набора (массива) убрать элемент "маскировка"? Найти их при переборке получается, но как убрать? Не удалив при этом сам объект с чертежа.
If TypeName(SetExpBlock(Index)) = "IAcadRasterImage" Then ...

И как этот массив (набор) подсунуть в метод переноса на передний план (попытка ниже)? У меня от VBA одна ругань на неопределенные переменные. Я просто запутался в их типах.

Перемещение объектов на передний план пытаюсь сделать методом
Dim DrawDic As Object
Dim MObj As Object
Set DrawDic = ThisDrawing.ModelSpace.GetExtensionDictionary
Set MObj = DrawDic.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
MObj.MoveToTop SetObjs ' SetObjs - объект или набор - тут не понятно


В общем: как получить все объекты расчленения блока, и те из них, которые не являются "маскировкой" (растровым изображением), переместить на передний план?

Спасибо за понимание.
Прошу прощения, что не оформил код

[doctorraz]

ну и перемещай обьекты на передний план в цикле, начиная с маскировки
обьекты блока будут поверх нее, а маскировка поверх обьектов чертежа

[Theodor]

Прошу прощения с давность темы

Сообщение от doctorraz ну и перемещай обьекты на передний план в цикле, начиная с маскировки обьекты блока будут поверх нее, а маскировка поверх обьектов чертежа

Дело том, что в цикле перемещать каждый объект - процесс долгий. Учитывая то, что функционал VBA позволяет перемещать сразу набор. Вот и хочется получив набор разбитого блока переместить сразу, но при этом убрать из набора маскировку

[maratovich]

Создать новый массив с размером -1 от набора.
засунуть в этот массив всё из набора за исключением маскировки
это перебором, но будут быстрее чем каждый на верх.
массив переместить на верх целиком.
это теоретически, но думаю должно работать

[Theodor]

Сообщение от maratovich это теоретически, но думаю должно работать

Это работает, проверено. Но переборка массива - долгий процесс. Вот как бы от него уйти.

[maratovich]

Сообщение от Theodor Но переборка массива - долгий процесс. Вот как бы от него уйти.

никак

Сообщение от Theodor Кроме того, саму "маскировку" нельзя отправлять на задний план.

в смысле программно или по условию задачи ?

----- добавлено через ~4 мин. -----
Как вариант
получаете габарит блока, взрываете, создаёте набор 1 с фильтром который берёт только маскировку, вырезаете маскировку, создаёте набор 2 со всеми элементами без маскировки, вставляете маскировку, перемещаете набор 2 на верх.
С вас пиво.

[Theodor]

Сообщение от maratovich вырезаете маскировку,

вот тут таиться проблема! как без перебора получить набор без маскировки, пригодный для .MoveToTop

[maratovich]

ну блин.... на сухую сложно писать...
кидаешь свой набор в коодинаты 100000 на 100000
обрабатываешь как я описал выше
перемещаешь набор в свои координаты.

[doctorraz]

как вам это удается.. без строчки кода и прииера чертежа.. профи !!!
послежу, почитаю

[maratovich]

Делаем эксплоде, получаем массив всего содержимого блока, так ?
Этот массив делаем муве в космос, получилось?
По координатам массива делаем селект сет с фильтром на маскировку, получаем ее и делаем муве в исходное координаты, получилось?
Потом опять селект сет на оставшееся в космосе, и муве в исходные.
По логике маскировка должна получиться снизу.
Пишу смобилы проверить не могу.

[Boxa]

Сообщение от Theodor Важно, что бы все примитивы блока после расчленения были выше этой "маскировки" (так сказать на переднем плане чертежа). Кроме того, саму "маскировку" нельзя отправлять на задний план.

Код:

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

Sub dhjs()

    Dim OBlock As AcadObject
    Dim basePnt() As Variant
    
    ThisDrawing.Utility.GetEntity OBlock, basePnt, "Select an object"
    
    Dim SetExpBlock As Variant
    SetExpBlock = OBlock.Explode
    
    Dim count As Integer
    count = 0
    For Each SetObj In SetExpBlock
        If TypeName(SetObj) <> "IAcadWipeout" Then
            count = count + 1
        End If
    Next

    ReDim nObj(count - 1) As Object
    Dim i As Integer
    For Each SetObj In SetExpBlock
        If TypeName(SetObj) <> "IAcadWipeout" Then
            Set nObj(i) = (SetObj)
            i = i + 1
        End If
    Next
    

    Dim DrawDic As Object
    Dim MObj As Object
    Set DrawDic = ThisDrawing.ModelSpace.GetExtensionDictionary
    Set MObj = DrawDic.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
       
    MObj.MoveToTop nObj

End Sub

[Theodor]

Коллеги, я понял в чем основной затык, который не дает обойтись без перебора. Нет возможности в .MoveToTop подсунуть набор, там требуется массив объектов.
На данный момент у меня уже есть реализация схожая с решением от Boxa, но она замедлена циклом, и я думал, что должно быть более оптимальное решение. Хотя, кое что попробую еще упростить.
Кстати, Boxa, отсечение маскировок делал сравнивая с "IAcadRasterImage" вместо "IAcadWipeout". Вроде то же работает. Ну и пока обхожусь одним циклом. Два перебора, мне совсем печально будет.
maratovich, к сожалению применение "космоса" меня пока не избавляет от создания массива циклом.

[maratovich]

Theodor приложи пример, а то "много времени на обработку" каждый по разному понимает.

[Boxa]

Theodor, если Вам хочется скорости и гибкости, то это явно не про VBA.

[maratovich]

Файл примера dwg и сколько времени у тебя уходит на обработку.

[Theodor]

Сообщение от Boxa если Вам хочется скорости и гибкости, то это явно не про VBA

Тут не поспоришь. Но как говориться, на безрыбье и рак рыба. Альтернативные языки для данной задачи изучать нет желания. Вот и ищу оптимизацию на том уровне, которым владею.

Сообщение от maratovich приложи пример, а то "много времени на обработку" каждый по разному понимает.

Сообщение от maratovich Файл примера dwg и сколько времени у тебя уходит на обработку.

Боюсь что объективности все равно не получить, тут и от машины зависит. Да и помимо переноса объектов программа загружена еще другими параллельными действиями, которые просто усложнят понимание моего кода.
В целом я уже благодаря этой дискуссии понял, что минимум один цикл нужен (из-за разницы в типах данных). Видимо придется смириться.

Кстати, о словарях сортировки. Может кто имеет в них более глубокое познание:
- если я создаю один словарь и начну его использовать для разных сортировок, то это не приведет к откату первых? То есть: создал в словаре сортировку, при помощи нее сгруппировал объекты (одни расположил над другими). Потом взял под другие объекты и при помощи того же словаря сгруппировал (вторые разместит над третьими).. И не получится так, что из-за этого сортировка первых со вторыми вернется на свои места?
Этот вопрос исключительно, если владеете информацией. Целенаправленно проверять не надо.

Спасибо.

[maratovich]

Сообщение от Theodor Видимо придется смириться.

А зря...
Нужен блок для тестов

[Theodor]

Сообщение от maratovich А зря... Нужен блок для тестов

Обнадеживаете.... Ладно, будет время, накидаю тестовую версию.

[Theodor]

Вот вариант процедуры. В файл не размещаю, думаю, что каждому удобнее вставить в свои пакеты, что бы не заморачиваться с библиотеками.

И прилагаю файл, где есть две пачки блоков (по 100 штук). В них отличается число примитивов и при обработке этих пачек наблюдается снижение скорости почти в два раза.

Код:

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

Public Sub temporary()
 Dim SelSet As AcadSelectionSet
 Dim objBlock As AcadBlockReference
 Dim intType(0) As Integer
 Dim varDat(0) As Variant
 Dim arr() As AcadObject
 Dim Cnt As Long
 Dim eDictionary As Object
 Dim SentityObj As Object
 Dim SetObj As Variant
 Dim Ind As Long
 
 intType(0) = 0
 varDat(0) = "INSERT"
 
 For Each SelSet In ThisDrawing.SelectionSets
  If SelSet.Name = "MYSELSET" Then
   SelSet.Delete
   Exit For
  End If
 Next SelSet
 
 Set SelSet = ThisDrawing.SelectionSets.Add("MYSELSET")
 SelSet.SelectOnScreen FilterType:=intType, FilterData:=varDat
 If SelSet.count < 1 Then Exit Sub
 
 Set eDictionary = ThisDrawing.ModelSpace.GetExtensionDictionary
On Error Resume Next
 Set SentityObj = eDictionary.GetObject("MYSORTDICT")
On Error GoTo 0
 If SentityObj Is Nothing Then
  Set SentityObj = eDictionary.AddObject("MYSORTDICT", "AcDbSortentsTable")
 End If
 
 For Each objBlock In SelSet
  Cnt = 0
  SetObj = objBlock.Explode
  ReDim arr(UBound(SetObj))
  For Ind = LBound(SetObj) To UBound(SetObj)
   If TypeName(SetObj(Ind)) <> "IAcadRasterImage" And TypeName(SetObj(Ind)) <> "IAcadWipeout" And TypeName(SetObj(Ind)) <> "IAcadWipeout2" Then
    Set arr(Cnt) = SetObj(Ind)
    Cnt = Cnt + 1
   End If
  Next Ind
  If Cnt > 0 Then
   ReDim Preserve arr(Cnt - 1)
   SentityObj.MoveToTop arr
  End If
 Next objBlock
End Sub

Рекомендую включить контуры маскировок

[maratovich]

Сообщение от Theodor Кроме того, саму "маскировку" нельзя отправлять на задний план.

Собственно кто это сказал ?
Вот код переноса назад:

Код:

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

Sub dhjs()
    Dim OBlock As AcadObject
    Dim basePnt() As Variant
    
    ThisDrawing.Utility.GetEntity OBlock, basePnt, "Select an object"
    
    Dim SetExpBlock As Variant
    SetExpBlock = OBlock.Explode
    OBlock.Erase

    Dim arrObj(0) As AcadObject

    For Each SetObj In SetExpBlock
        If TypeName(SetObj) = "IAcadWipeout" Then
            Set arrObj(0) = SetObj
        End If
    Next

    Dim eDictionary As Object
    Set eDictionary = ThisDrawing.ModelSpace.GetExtensionDictionary
    On Error Resume Next
    Dim sentityObj As Object
    Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")
    On Error GoTo 0
    If sentityObj Is Nothing Then
         Set sentityObj = eDictionary.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
    End If
    sentityObj.MoveToBottom arrObj
    Application.Update
End Sub

Сегодня копать некогда, но спрошу:
А не лучше селект сет с фильтром выбрать и взорвать все блоки , а потом так же выбрать только маскировку и переместить назад ?
Или есть каки то особенности что надо каждый блок по очереди ?

----- добавлено через 26 сек. -----
Я ж говорю - на сухую плохо идёт

[Theodor]

Маскировку нельзя на задний план по условию использования. В противном случае на кой она вообще нужна на заднем плане, если ничего закрывать не будет.

[maratovich]

новая вводная:
использовать команду
_XPLODE
с параметром
_По объекту
она не перекидывает маскировку на верх.

[Theodor]

Сообщение от maratovich использовать команду _XPLODE

Вся затея реализовать свою функцию на VBA вылезла из необходимости сохранить значение атрибутов. При штатном расчленении они превращаются в названия полей.
А функция в expresstools маскировку размещает когда как.

[maratovich]

Сообщение от Theodor А функция в expresstools маскировку размещает когда как.

Это вы про _burst ?

----- добавлено через ~1 мин. -----
так у вас ещё и атрибуты ???? условие усложняется...

[Theodor]

Сообщение от maratovich Это вы про _burst ?

Не знаю, как она точно называется. Сейчас е-тулса нет под рукой, посмотреть не смогу в ближайшие три недели.

Да и использование сторонних решений мне не всегда актуально, так как в своем коде я добавлю дополнительный функционал - например отфильтровываю блоки по некоторым критериям.

[maratovich]

Кстати Theodor, а вы в своём коде что, каждый блок делаете .Explode и обрабатываете ?

[Theodor]

Сообщение от maratovich условие усложняется...

ну с этими условиями у меня нет сложностей.

[maratovich]

имелось ввиду - каждое вхождение в чертеже обрабатываете ?

[Theodor]

Сообщение от maratovich Кстати Theodor, а вы в своём коде что, каждый блок делаете .Explode и обрабатываете ?

Сообщение от maratovich имелось ввиду - каждое вхождение в чертеже обрабатываете ?

Увы, да. А есть пакетное расчленение с получением массива объектов?

Иногда приходят мысли, с учетом того, что задача с расчленением блока постоянно расширяется (с момента постановки вопроса), то в комплексе придется рассматривать метод с лишним циклом и создания временного массива или может в итоге и xplode подойдет (останется разобраться как к ней прикрутить набор, заданный программно).

[maratovich]

Сообщение от Theodor Увы, да.

А вот теперь... ахалай махалай, сяски.... зачем ???!!!
Блок то один, просто его вхождений много (одинаковых, без учета значения атрибутов), из этого следует что расчленить и обработать можно только один блок. Потом этим расчленением просто заменять существующий блок. Это будет в разы быстрее. Вставляете по точке вставки блока, а порядок расположения по порядку как есть в каде.
По поводу атрибутов - надо смотреть цель, чего с ними делаете. Поэтому и просили реальный пример.

[Theodor]

Сообщение от maratovich Блок то один, просто его вхождений много (одинаковых, без учета значения атрибутов), из этого следует что расчленить и обработать можно только один блок. Потом этим расчленением просто заменять существующий блок. Это будет в разы быстрее. Вставляете по точке вставки блока, а порядок расположения по порядку как есть в каде.

Ну это не всегда так. Да и блоки есть динамические. Плюс надо учитывать поворот блока - в общем не пойдет такой вариант.

Сообщение от maratovich По поводу атрибутов - надо смотреть цель, чего с ними делаете. Поэтому и просили реальный пример.

Я уже понял в диалоге, что есть альтернативные методы, плюс учет, что у самого стали появляться дополнительные потребности. Постараюсь задачу обрисовать целиком, и возможно собрать то, что пока использую (код).

[maratovich]

Сообщение от Theodor Да и блоки есть динамические

Без нормального ТЗ результат ХЗ

[Theodor]

Сообщение от maratovich Без нормального ТЗ результат ХЗ

Это точно!!! Полезная рифма, учту в работе по проектированию.

Просто вопрос то был: можно ли преобразовать массив примитивов, полученного расчленением, в массив, пригодный для .MoveToTop без перебора в цикле.
И уж если никак этого не избежать, то и придется смотреть на задачу комплексе и искать возможности по ускорению обработки.

Ну пока вкратце (сейчас нет под рукой решений) некое ТЗ:
есть куча блоков на плане (в том числе и динамические, и с атрибутами, и с маскировкой) - вариации разные.
надо провести пакетное расчленение (как правило запрашивается пространство, но отфильтровываются блоки по именам) с преобразованием атрибутов в текстовые поля, и размещением вытащенных примитивов и полученных текстов поверх маскировок.

Все необходимое мне понято как реализовать, но скорость из-за промежуточных циклов падает - пример я выкладывал. Хотя кое какие мысли имеются, но до реализации пока руки не дошли.