Реклама i
Стань нашим партнером - зарабатывай с нами!
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > VBA Преобразование динамического блока в статический/анонимный.

VBA Преобразование динамического блока в статический/анонимный.

Ответ
Поиск в этой теме
Непрочитано 19.11.2016, 00:41 #1
VBA Преобразование динамического блока в статический/анонимный.
Theodor
 
Петрозаводск
Регистрация: 16.04.2009
Сообщений: 323

Помогите разобраться, как средствами именно VBA преобразовать все динамические блоки чертежа в статические и/или анонимные. На форуме есть предложения по использованию готовых Lisp-решений с командами BGBLDYN2S. BGBLDYN2A. Но вот мне бы это как-то на VBA осуществить. Изучить код lisp - для меня как-то сложно.
В общем, как найти динамические блоки на чертеже - это мне понятно. А за какую ниточку в них потянуть, что бы вся "динамика" исчезла и остались лишь видимые на данный момент примитивы.
Спасибо.
Просмотров: 4768
 
Непрочитано 19.11.2016, 10:52
1 | #2
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Theodor Посмотреть сообщение
Но вот мне бы это как-то на VBA осуществить
Почти так же, как и на лиспе. Методы одинаковые ConvertToStaticBlock и ConvertToAnonymousBlock
Почитай так же Четыре правила для работы с ActiveX в Visual Lisp (пункт 7 отсюда)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 19.11.2016, 14:22
#3
Theodor


 
Регистрация: 16.04.2009
Петрозаводск
Сообщений: 323


Цитата:
Сообщение от VVA Посмотреть сообщение
Методы одинаковые ConvertToStaticBlock и ConvertToAnonymousBlock
Супер! То что надо! Спасибо огромное!
Но вот есть пара сопутствующих вопросов:
1. после перевода блока в статику, при открытии его в редакторе блоков, внутри остались все! элементы, что были в динамическом. По сути исчезли только ручки динамики. Но при этом лисповская BGBLDYN2S убирала всё лишнее.
2. перед превращением блока в статику, я удалял в нем все атрибуты и выносил их в текст. На чертеже их в блоке нет, а при входе в редактор - все поля атрибутов сохранились. Это реально победить (в смысле, что бы в статическом блоке в итоге остались только используемые примитивы?

----- добавлено через ~23 мин. -----
VVA, еще есть вопрос не по теме, но ваши знания Lisp и структуры автокада думаю мне помогут. Речь о связях с данными.
Посмотрите в конце ветки, пожалуйста.
А тут вы обращались к связям через lisp, возможно подскажете где в структуре файла это искать через VBA
Еще раз спасибо.
Theodor вне форума  
 
Непрочитано 19.11.2016, 23:40
1 | #4
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Theodor Посмотреть сообщение
Но при этом лисповская BGBLDYN2S убирала всё лишнее.
Суть в этом
Цитата:
(if(eq(vla-get-Visible x) :vlax-false)(vla-delete x)
После конвертации блока проходишь по описанию блока, и если свойство Visible установлено в false, то удаляешь его.

Цитата:
Сообщение от Theodor Посмотреть сообщение
ще есть вопрос не по теме
ответил в теме
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 20.11.2016, 02:02
#5
Theodor


 
Регистрация: 16.04.2009
Петрозаводск
Сообщений: 323


Цитата:
Сообщение от VVA Посмотреть сообщение
После конвертации блока проходишь по описанию блока
Тут я совсем сник... какими методами VBA достучатся до примитивов блока? И до какого блока теперь вообще стучаться. Все до того же динамического, или заново найти на чертеже статический с новым именем?
Я правильно понимаю, что там же можно грохнуть атрибуты? Но я пытался после перевода в статику их еще раз удаить - остаются проклятые.

----- добавлено через ~1 ч. -----
VVA, Нее.. не сник! Разобрался! По присвоенному имени нашел блок (уже не динамический), грохнул атрибуты и невидимые объекты (по вашему совету). Все стало просто супер!!!!
Спасибо за науку!

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

Ну и огромное спасибо VVA за интеллектуальную и моральную поддержку.

Код:
[Выделить все]
Private Sub BlockDynToStatWhithExtractAttributes()
' нужные и ненужные переменные
 Dim ind, Counter As Long
 Dim SelSet As AcadSelectionSet
 Dim ObjBlock As AcadBlockReference
 Dim ObjSBlock As AcadBlock
 Dim objEnt As AcadEntity
 Dim ObjText As AcadText
 Dim DBProperties As Variant 'свойства блока
 Dim AtrArray As Variant ' атрибуты блока
 Dim intType(0) As Integer
 Dim varDat(0) As Variant
 Dim TMPName As String
 Dim PosAtr As Variant
 
 'получаем набор блоков из модели
 intType(0) = 0
 varDat(0) = "INSERT"
 Set SelSet = vbdPowerSet("sortblocks")
 SelSet.SelectOnScreen filterType:=intType, filterdata:=varDat
 ' или выбрать все из пространства
 ' SelSet.Select acSelectionSetAll, filterType:=intType, filterdata:=varDat
 
 ' проходим по всем блокам набора
 Counter = 0
 For Each ObjBlock In SelSet
  Counter = Counter + 1
  DBProperties = ObjBlock.GetDynamicBlockProperties ' сохраняем массив свойств блока
  ' стоит иметь у своих блоков в названии некий префикс, что бы не заморачиваться на чужие. Или например префиксы блоков определенного назначения
  If Mid(ObjBlock.EffectiveName, 1, 5) = "MyBl_" Then ' проверка на пренадлежность к категории блоков
   If ObjBlock.HasAttributes Then ' проверка налиячия в блоке атрибутов
    AtrArray = ObjBlock.GetAttributes ' сохраняем массив атрибутов (если есть)
    For ind = LBound(AtrArray) To UBound(AtrArray)
     PosAtr = AtrArray(ind).InsertionPoint ' получение абсолютного положения атрибута в чертеже! Не в блоке, а именно в чертеже!
     If Not AtrArray(ind).Invisible Then 'если атрибут видимый, то создаем текст в чертеже, переносим свойства
      'создание текста в модели с данными атрибута. Кстати, можно проверить, есть ли в атрибуте информация, и не создавать текст, если пусто.
      Set ObjText = ThisDrawing.ModelSpace.AddText(AtrArray(ind).TextString, PosAtr, AtrArray(ind).Height)
      'перенос всех необходимых для оформления свойств атрибута для текста
      'возможно существует более действенный метод в одну строку, я не знаю пока
      ObjText.Alignment = AtrArray(ind).Alignment 'выравнивание текста
      ObjText.Layer = AtrArray(ind).Layer 'слой текста
      ObjText.Linetype = AtrArray(ind).Linetype 'тип линий (может пригодится для некоторых шрифтов)
      ObjText.LinetypeScale = AtrArray(ind).LinetypeScale 'масштаб типа линий (может пригодится для некоторых шрифтов)
      ObjText.Lineweight = AtrArray(ind).Lineweight 'вес линий (может пригодится для некоторых шрифтов)
      ObjText.ObliqueAngle = AtrArray(ind).ObliqueAngle ' наклон текста
      ObjText.Rotation = AtrArray(ind).Rotation ' поворот текста
      ObjText.ScaleFactor = AtrArray(ind).ScaleFactor ' масштаб текста
      ObjText.StyleName = AtrArray(ind).StyleName ' стиль текста
      ObjText.TrueColor = AtrArray(ind).TrueColor ' цвет текста
      'тут есть определенный момент, корректировка координат вставки текста в модель
      'координаты зависят от состояния выравнивания текста и хранятся из-за этого в разных свойствах
      'кстати, это может быть причиной, по которой может не получится пакетный перенос свойств
      If ObjText.Alignment = acAlignmentLeft Or ObjText.Alignment = acAlignmentAligned Or ObjText.Alignment = acAlignmentFit Then
       ObjText.InsertionPoint = AtrArray(ind).InsertionPoint ' установка положения из свойства .InsertionPoint
      End If
      If ObjText.Alignment <> acAlignmentLeft Then
       ObjText.TextAlignmentPoint = AtrArray(ind).TextAlignmentPoint   ' установка положения из свойства .TextAlignmentPoint
      End If
     End If
     AtrArray(ind).Delete 'тут я пытаюсь удалить все атрибуты, но к сожалению в определении блока они сохранятся. Удалим позже
    Next ind
   End If
   
   'преобразование блока в анонимный делается просто
   'ObjBlock.ConvertToAnonymousBlock
   
   'преобразование блока в статический с некоторыми особенностями
   ' во-первых, нужно придумать каждому блоку свое эксклюзивное имя
   ' во-вторых, неплохо бы почистить определитель блока от всех ненужных элементов и атрибутов (а то их видно в редакторе блоков)
   
   'вариант выдумывания эксклюзивного имени я реализовал такой:
   'взыл некий префикс, добавил номер по своему счетчику, и прицепил данные таймера
   TMPName = "Block_" & Counter & Round(Timer())
   'далее превращаем блок в статический
   ObjBlock.ConvertToStaticBlock TMPName
   
   'и теперь надо вычистить ненужный хлам из блока
   'так как блок теперь стал статическим, то обрабатывать его надо своими методами.
   'возможно, что есть свойства и методы в типе AcadBlockReference, но я не нашел (хотя особо и не искал)
   'в общем, нахожу блок в пространстве можели по ранее придуманному имени, и по типу AcadBlock
    Set ObjSBlock = ThisDrawing.Blocks.Item(TMPName)
   'легкая пробежка по всем объектам этого блока
   'с выявлением неиспользуемых объектов и атрибутов. Атрибуты вообще все удаляем
    For Each objEnt In ObjSBlock
     If Not objEnt.Visible Then
      objEnt.Delete 'удаляем очередной неиспользуемый (невидимы) примитив в блоке
     Else
      If TypeName(objEnt) = "IAcadAttribute2" Then objEnt.Delete 'удаляем атрибут в блоке (если он был видимым)
     End If
    Next objEnt
  End If ' тот, что проверяет пренадлежность к "MyBl_"
 Next ObjBlock
End Sub
'!!!!!!!!! ВНИМАНИЕ !!!!!!!!! Многострочные атрибуты этой процедуре неподвластны. На поямление глюков с ними не проверено.

Последний раз редактировалось Theodor, 20.11.2016 в 16:54.
Theodor вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > VBA Преобразование динамического блока в статический/анонимный.

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как получить все состояние видимостей динамического блока? prajdziswet LISP 6 18.11.2021 21:30
Функция чтения свойств и их значений динамического блока Supermax Библиотека функций 11 16.03.2020 09:11
Установка параметров динамического блока в VBA тормозит bars4 Программирование 4 01.10.2012 10:27
C# .net переопределение динамического блока из внешнего файла bargool .NET 35 18.10.2011 16:03
Странное поведение динамического блока высотной отметки hwd Динамические блоки 12 08.09.2011 11:15