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

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

Извлечение значений атрибутов динамического блока и создание таблицы Autocad VBA

Ответ
Поиск в этой теме
Непрочитано 14.07.2017, 18:03 #1
Извлечение значений атрибутов динамического блока и создание таблицы Autocad VBA
Abai
 
Регистрация: 01.03.2010
Сообщений: 21

Доброго времени суток, уважаемые форумчане!
Помогите решить следующую задачу:

Дано динамический блок - линия с параметром растяжение и двумя атрибутами "Поз." (задается пользователем) и "Длина" (определяется автоматически).
Требуется Создать с помощью VBA таблицу из двух столбцов: в первом будут значения позиций, во втором - соответствующая им длина (причем если блоков с одинаковыми позициями несколько, то сумма длин).
Свое решение (точнее его попытку) прилагаю в виде кода, прошу помочь и посоветовать как добиться требуемого функционала.

Код:
[Выделить все]
Sub Ex_()

Dim varPick As Variant
Dim objEnt As AcadEntity
Dim objBRef As AcadBlockReference
Dim varAttribs As Variant
Dim strAttribs As String
Dim intI As Integer
Dim i As Long


On Error Resume Next


ThisDrawing.SelectionSets("SS").Delete
    Set ss = ThisDrawing.SelectionSets.Add("SS")
    ss.SelectOnScreen
    
For Each objEnt In ss
        Set objBRef = objEnt
     '' выйти если не блок
        If objBRef Is Nothing Then
        ThisDrawing.Utility.Prompt vbCr & "That wasn't a block."
        Exit Sub
        End If
        '' выйти если нет атрибутов
        If Not objBRef.HasAttributes Then
        ThisDrawing.Utility.Prompt vbCr & "That block doesn't have attributes."
        Exit Sub
        End If
        
        '' получаем атрибуты
        varAttribs = objBRef.GetAttributes

    i = 0
    For intI = LBound(varAttribs) To UBound(varAttribs)
    '' ищем атрибут позиции
        If varAttribs(intI).TagString = "ПОЗ" Then
            If i < CInt(varAttribs(intI).TextString) Then
                i = CInt(varAttribs(intI).TextString) + 1
            End If
        End If
    '' ищем атрибут длина
        If varAttribs(intI).TagString = "Длина" Then
            r = CStr(varAttribs(intI).TextString)
        End If
    Next
        
Next objEnt
        
        
'' создаем таблицу
Dim MyModelSpace As AcadModelSpace
Set MyModelSpace = ThisDrawing.ModelSpace
Dim pt(2) As Double
Dim MyTable As AcadTable
Set MyTable = MyModelSpace.AddTable(pt, i, 2, 10, 30)
            
            
            
'' заполняем таблицу
With MyTable
    For i = 1 To .Rows - 1
    .SetCellValue i, 0, i
    .SetCellValue i, 1, r
    Next
End With
    
ZoomExtents

End Sub

Последний раз редактировалось Кулик Алексей aka kpblc, 14.07.2017 в 22:58.
Просмотров: 6995
 
Непрочитано 14.07.2017, 23:02
1 | #2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 38,751


Ну во-первых, не помешает добавить фильтр для набора.
2. При проходе по набору сразу проверяй EffectiveName для примитива.
3. Для таблицы есть свойство, если не ошибаюсь, что-то-там-Recompute (посмотри в справке). Перед заполнением настоятельно рекомендую установить его в False, после выполнения кода в True, и не забудь про регенерацию.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 15.07.2017, 00:00
#3
Abai


 
Регистрация: 01.03.2010
Сообщений: 21


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Ну во-первых, не помешает добавить фильтр для набора.
2. При проходе по набору сразу проверяй EffectiveName для примитива.
3. Для таблицы есть свойство, если не ошибаюсь, что-то-там-Recompute (посмотри в справке). Перед заполнением настоятельно рекомендую установить его в False, после выполнения кода в True, и не забудь про регенерацию.
Спасибо за ответ.
Постараюсь со всем разобраться.
Abai вне форума  
 
Непрочитано 15.07.2017, 00:22
#4
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 9,808


1. Привязываться к установке количества строк таблицы по значению тега "ПОЗ" плохая идея - влияние человеческого фактора. А если понадобиться вставить позицию 10.1 или 10а (ну или просто сотрудник ошибется) - то сразу получите ошибку при вызове CInt.
2. Я бы использовал словарь Scripting.Dictionary с поздним связыванием (чтобы не подключать лишние референсы):
2.1. В качестве ключа использовать - значение атрибута "ПОЗ".
2.2. Длина в качестве значения элемента словаря. Извлекаете данные из блока, проверяете в словаре по ключу значения атрибута "ПОЗ" через Exists. Если найдено, то извлекаете длину из словаря, корректируете и записываете обратно. Не найдено - добавляете в словарь.
2.3. После проходу по всем блокам в свойстве Count словаря будет как раз искомое реальное количество строк таблицы.

Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
проверяй EffectiveName для примитива.
насколько понял, в таблице связка значений атрибута "ПОЗ" и динамического параметра длины, поэтому имя блока вообще можно игнорировать.
Сергей812 вне форума  
 
Автор темы   Непрочитано 15.07.2017, 00:33
#5
Abai


 
Регистрация: 01.03.2010
Сообщений: 21


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
1. Привязываться к установке количества строк таблицы по значению тега "ПОЗ" плохая идея - влияние человеческого фактора. А если понадобиться вставить позицию 10.1 или 10а (ну или просто сотрудник ошибется) - то сразу получите ошибку при вызове CInt.
Понял. Исходил из того, что "ПОЗ" всегда целое число (позиция арматуры в моем случае).
Со словарем никогда не работал, буду изучать чтобы понять что с ним делать.
Из Вашего ответа не совсем понял как будут суммироваться длины всех одинаковых позиций.
Спасибо за ответ!
Abai вне форума  
 
Непрочитано 15.07.2017, 00:42
#6
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 9,808


Цитата:
Сообщение от Abai Посмотреть сообщение
Из Вашего ответа не совсем понял как будут суммироваться длины всех одинаковых позиций.
Если значение из атрибута "Поз" есть в ключах словаря (функция Exists): по ключу получаете значение длины из словаря во временную переменную. Ко временной переменной добавляете значений новой длины и заносите обратно в словарь по ключу. А если в ключах нет данного значения - то это первое упоминание данной позиции и ее надо занести в словарь. И если позицию записывать в словарь в виде строки (т.е. не преобразовывать) - то там никаких ограничений не будет, что писать в данном атрибуте.

----- добавлено через ~6 мин. -----
Только не факт, что позиции будут идти по порядку. В каком порядке опросит блоки акад - в таком и получите (когда первый раз встретилась данная позиция, точнее).
Сергей812 вне форума  
 
Автор темы   Непрочитано 15.07.2017, 00:53
#7
Abai


 
Регистрация: 01.03.2010
Сообщений: 21


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
Только не факт, что позиции будут идти по порядку. В каком порядке опросит блоки акад - в таком и получите (когда первый раз встретилась данная позиция, точнее).
А если нужно именно по порядку? Нет ли какого-нибудь инструмента сортировки в таком случае?
И еще один вопрос: AcadDictionary это то, о чем Вы говорили? Просто в справке Scripting.Dictionary не могу найти, да и в книжке тоже нет.
Abai вне форума  
 
Непрочитано 15.07.2017, 01:22
#8
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 9,808


Цитата:
Сообщение от Abai Посмотреть сообщение
А если нужно именно по порядку? Нет ли какого-нибудь инструмента сортировки в таком случае?
Увы, с сортировкой в VBA не так хорошо дела обстоят. Придется тогда ограничиться только числовыми значениями позиции. В цикле по блокам во время сбора информации в словаре посчитать максимальное значение позиции и запомнить. Затем после создания таблицы в цикле от 1 до MaxNumberPosition проверять в словаре через тот же Exists наличие записи с ключом = переменной цикла. Если есть - значение переменной цикла будет и номером позиции, и ключом для извлечения длины из словаря.


Цитата:
Сообщение от Abai Посмотреть сообщение
Просто в справке Scripting.Dictionary не могу найти, да и в книжке тоже нет.
Словарь вообще не имеет непосредственного отношения к VBA, это часть библиотеки Microsoft Scripting Runtime где-то c 2000 версии. Наберите в поисковике: VBA Scripting.Dictionary. Просто в самом VBA есть похожие вещи - коллекции, но там нет метода Exists. Поэтому приходиться подключать внешний словарь. Ну или писать самому реализацию)
Сергей812 вне форума  
 
Автор темы   Непрочитано 15.07.2017, 01:32
#9
Abai


 
Регистрация: 01.03.2010
Сообщений: 21


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
Ну или писать самому реализацию)
А задача сперва казалась гораздо проще)
Думал, что все дело в том, что не совсем разбираюсь в циклах и их возможностях.
А тут вот как все получается...
Abai вне форума  
 
Непрочитано 15.07.2017, 01:44
#10
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 9,808


так в вашем коде как раз и нету этой части - сбора информации по длинам с привязкой к позициям. Отдельный цикл по блокам, отдельный цикл по таблице - а между ними ничего. С готовым словарем получиться код - ну раза в три больше, чем сейчас. Тем более, если выкинуть с начала процедуры сильно информативные сообщения об том, что примитив не является блоком, например.
Сергей812 вне форума  
 
Непрочитано 15.07.2017, 08:05
#11
Владимир_М


 
Регистрация: 05.11.2015
Сообщений: 585


После того как в цикле
Цитата:
For Each objEnt In ss
1. почитали количество нужных блоков (kol_otd)
2. создайте двумерный динамический массив
ReDim otd_ster(kol_otd, 2)
3. перенесите все аргументы блоков в этот массив
4. суммируйте, сокращайте и сортируйте элементы массива
5. сливайте окончательный массив в таблицу акада.
Владимир_М вне форума  
 
Непрочитано 15.07.2017, 09:18
#12
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 9,808


Цитата:
Сообщение от Владимир_М Посмотреть сообщение
1. почитали количество нужных блоков (kol_otd)
2. создайте двумерный динамический массив
ReDim otd_ster(kol_otd, 2)
3. перенесите все аргументы блоков в этот массив
4. суммируйте, сокращайте и сортируйте элементы массива
1. Два прохода по набору - один для подсчета блоков, другой для переноса данных атрибутов в массив. В каждом проходе вложенные циклы по атрибутам. При этом количество нужных блоков - там не блоки нужны, а позиции в них.
2. Все операции по обработке элементов массива придется писать самим. Удаление элемента массива является операцией сложности O(n), т.е. зависит от количества элементов в списке. Сортировка тоже зависит, причем классический метод быстрой сортировки через рекурсивный вызов вызовет очень быстро ошибку переполнения стека.
3. ReDim otd_ster(kol_otd, 2) - получите трехмерный массив с лишней строкой и столбцом (0..kol_otd, 0..2). Да и тогда более логичным было бы применение UTD - создать структуру из двух полей: Поз и Длина. И массив из UTD.
Сергей812 вне форума  
 
Непрочитано 15.07.2017, 10:13
#13
Владимир_М


 
Регистрация: 05.11.2015
Сообщений: 585


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
1. Два прохода по набору - один для подсчета блоков, другой для переноса данных атрибутов в массив. .
Ну два и что?

Цитата:
Сообщение от Сергей812 Посмотреть сообщение
В каждом проходе вложенные циклы по атрибутам
Можно и цикл по атрибутам, тоже непонятно в чем проблема? Но для данной задачи заведомо известно, что их там только 2. Ну и считали их на раз-два, без цикла.

Цитата:
Сообщение от Сергей812 Посмотреть сообщение
При этом количество нужных блоков - там не блоки нужны, а позиции в них..
Я разве против? Что там кому нужно то и возьмите.

Цитата:
Сообщение от Сергей812 Посмотреть сообщение
1. 2. Все операции по обработке элементов массива придется писать самим..
Ну, самому. А кому еще? В чем проблема проссумировать одинаковые числа? И кто еще за автора должен это написать в его приложении?!

Цитата:
Сообщение от Сергей812 Посмотреть сообщение
Сортировка тоже зависит, причем классический метод быстрой сортировки через рекурсивный вызов вызовет очень быстро ошибку переполнения стека.
Сортировку писать не нужно, масса вариантов в интернете. И как-то обходится без "ошибки переполнения стека".

Цитата:
Сообщение от Сергей812 Посмотреть сообщение
3. ReDim otd_ster(kol_otd, 2) - получите трехмерный массив с лишней строкой и столбцом (0..kol_otd, 0..2)..
Да нет тут никаких лишних строк и столбцов. Просто нужно написать три слова Option Base 1
и работать с массивом по-человечески. Тогда Первая позиция - она и первый элемент массива.
Откуда Вы тут получили трехмерный массив вообще непонятно. Трехмерный это как-то вот так будет
Код:
[Выделить все]
ReDim setki(kol_set, max_kol_poz_set, 6)
А вот так будет выглядеть сортировка (основа кода не моя) - уже аж трехмерного массива. Мне кажется взять скоприровать эту функцию (и адаптировать при необходимости) никаких трудностей не представляет.
Код:
[Выделить все]
Private Function Sortirovka(Unsort_arr As Variant) As Variant

Dim i As Long, j As Long, k As Long
Dim temp_arm As Variant
'Сортировка методом «Пузырька».
For i = 2 To UBound(Unsort_arr) Step 1
    For j = UBound(Unsort_arr) To i Step -1
        If Unsort_arr(j - 1, 4) > Unsort_arr(j, 4) Or _
            Unsort_arr(j - 1, 4) = Unsort_arr(j, 4) And Unsort_arr(j - 1, 3) > Unsort_arr(j, 3) Then
            For k = 1 To 6
                temp_arm = Unsort_arr(j - 1, k)
                Unsort_arr(j - 1, k) = Unsort_arr(j, k)
                Unsort_arr(j, k) = temp_arm
            Next k
        End If
    Next j
Next i
armat_izd = Unsort_arr
End Function
Владимир_М вне форума  
 
Непрочитано 15.07.2017, 10:48
#14
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 9,808


Владимир_М, поскольку я ленив, но написал бы так:

Код:
[Выделить все]
Dim lDict As Object
  Set lDict = CreateObject("Scripting.Dictionary")
  Dim lMaxNumberPos As Integer: lMaxNumberPos = 0
  Dim lNumPos As Integer
  Dim lLength As Double
  
  ' ... Цикл по выборке ...
    
    lNumPos = -1
    lLength = -1
    '... Получение значений из блока ...
    If ((lNumPos <> -1) And (lLength <> -1)) Then
      ' Группируем длины по позициям
      If (Not lDict.Exists(lNumPos)) Then
        lDict.Add lNumPos, lLength
      Else
        lLength = lLength + lDict.Item(lNumPos)
        lDict.Item(lNumPos) = lLength
      End If
      ' Ищем максимальную позицию
      If (lMaxNumberPos < lNumPos) Then lMaxNumberPos = lNumPos
    End If
    
 ' ... Завершение цикла по выборке ...
 
 ' ... Создание таблицы ...
 ' В lDict.Count будет нужное количество строк таблицы
 
 Dim I1 As Integer
 For I1 = 1 To lMaxNumberPos
  If (lDict.Exists(I1)) Then
    ' ... Заносим в соответствующии строки и столбцы таблицы
    ' I1 в качестве позиции и значение суммарной длины для
    ' этой позиции из lDict ...
  End If
 Next I1
        
 ' Словарь больше не нужен
 Set lDict = Nothing
Понятно, что Профессионалы не используют готовые решения, а всю реализацию пишут сами - только хардкор)

----- добавлено через ~42 мин. -----
p.s.
1. Насчет трехмерного массива оговорился, сорри - имел в виду массив из трех столбцов)
2. Option Base 1 -> можно написать проще Redim %Имя массива%(1 To N, 1 To 2). В одной функции индексация с единицы, в другой (написанной позже или скопированной готовой) с нуля - проще локально объявлять, имхо. Зачем создавать лишние источники ошибок?
3. Метод сортировки пузырьком один из самых медленных, есть и изящнее решения - где стек эмулируется дополнительным массивом и используется быстрая сортировка. Возможно, в ряде случаев проще будет выгрузить в эксель, там отсортировать, создать диапазон и связать с таблицей.
Сергей812 вне форума  
 
Автор темы   Непрочитано 15.07.2017, 13:08
#15
Abai


 
Регистрация: 01.03.2010
Сообщений: 21


Сергей812, большое Вам спасибо, все получилось!
Единственное, пришлось сделать lDict.Count + 1 (число строк) поскольку выпадала максимальная позиция.
А также выдавало ошибку в строке:
lLength = CDbl((varAttribs(intI).TextString), пришлось сделать так - lLength = CDbl(Replace(varAttribs(intI).TextString, ".", ",")), это правильное решение?
В самой таблице значения длины с пятью нулями после запятой), но сейчас погуглю как их обрезать.
Владимир_М и Кулик Алексей aka kpblc спасибо за советы и замечания.
Abai вне форума  
 
Непрочитано 15.07.2017, 13:28
#16
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 9,808


Цитата:
Сообщение от Abai Посмотреть сообщение
lLength = CDbl(Replace(varAttribs(intI).TextString, ".", ",")), это правильное решение?
это стандартное решение - чтобы не зависеть от кодировки разделителя в самом приложении)
Сергей812 вне форума  
 
Непрочитано 17.07.2017, 07:48
#17
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 38,751


Цитата:
Сообщение от Abai Посмотреть сообщение
это правильное решение?
... А в системе может быть установлен десятичный разделитель "." - и тогда решение не прокатит. ИМХО надо читать из реестра установленный разделитель (раздел HKEY_CURRENT_USER\Control Panel\International, ключ sDecimal). И выполнять двойную конвертацию - и точки, и запятой.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 17.07.2017, 09:00
#18
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 9,808


Либо написать обертку для стандартной функции:
Код:
[Выделить все]
Public Function CDblEx(ByVal aValue As String) As Double
  On Error Resume Next
  CDblEx = CDbl(aValue) 
  If (Err.Number <> 0) Then CDblEx = CDbl(Replace(aValue, ".", ","))
End Function
Либо использовать Val - она (функция) принимает исключительно точку:
Код:
[Выделить все]
Val(Replace(aValue, ",", "."))
Сергей812 вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Извлечение значений атрибутов динамического блока и создание таблицы Autocad VBA

Система Техэксперт дает уверенность в правильности и эффективности принимаемых инженерных решений!
Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP. Создание поля (field), ссылающегося на текстовое значение ячейки таблицы. skkkk Готовые программы 124 25.03.2022 09:53
Автоматическое обновление атрибутов динамического блока в автокад IllIDaN_wc Динамические блоки 3 31.05.2017 14:51
Ссылка атрибутов блока на ячейки таблицы СПДС Voha AutoCAD 9 14.12.2011 17:55
Извлечение атрибутов блока и вставка атрибутов в формулу andery AutoCAD 38 15.06.2009 02:39
Создание кнопки для динамического блока nik7 Динамические блоки 4 23.12.2008 15:33