dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

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

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

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

Abai вне форума Вставить имя

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

Дано динамический блок - линия с параметром растяжение и двумя атрибутами "Поз." (задается пользователем) и "Длина" (определяется автоматически).
Требуется Создать с помощью 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.
Просмотров: 800
 
Непрочитано 14.07.2017, 23:02
1 | #2
Кулик Алексей aka kpblc
Moderator

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


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

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


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


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


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


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
Сообщений: 10


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


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


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

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


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


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


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


Цитата:
Сообщение от 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
Сообщений: 10


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


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


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


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


После того как в цикле
Цитата:
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
Сообщений: 3,525


Цитата:
Сообщение от Владимир_М Посмотреть сообщение
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
Сообщений: 578


Цитата:
Сообщение от Сергей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
Сообщений: 3,525


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

Код:
[Выделить все]
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
Сообщений: 10


Сергей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
Сообщений: 3,525


Цитата:
Сообщение от 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
С.-Петербург
Сообщений: 34,507


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

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


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


Либо написать обертку для стандартной функции:
Код:
[Выделить все]
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

Конкурс для проектировщиков
Опции темы Поиск в этой теме
Поиск в этой теме:

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

Быстрый переход

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

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||


Размещение рекламы