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

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

VBA autocad 2016. Вставка динблоков на листы с установкой параметров

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 04.08.2017, 16:04 #1
VBA autocad 2016. Вставка динблоков на листы с установкой параметров
AlexV
 
Инженер
 
С-Пб
Регистрация: 02.10.2008
Сообщений: 3,492

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

Программно вставляю блоки по листам с помощью функции ниже. В принципе, все получается, но - строка, устанавливающая параметр динблока (он в блоке один - состояние видимости), вызывает зависание примерно на 3-3.5 секунды. Что при вставки даже десятка блоков несколько напрягает пользователя.. Нет ли какого другого более быстрого способа? Или, может, в этом какая ошибка?

Код:
[Выделить все]
 Private Sub ins_bl(name_Blck, InsertPnt, txtVid)
    Dim insertedBlock As AcadBlockReference, AttrDin, tmpattrDin As AcadDynamicBlockReferenceProperty
    On Error Resume Next
    Set insertedBlock = oLayout.Block.InsertBlock(InsertPnt, name_Blck, 1#, 1#, 1#, 0#)
    AttrDin = insertedBlock.GetDynamicBlockProperties
    tt = Timer
    AttrDin(0).Value =  txtVid
    MsgBox Timer - tt
End Sub
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!
Просмотров: 925
 
Непрочитано 04.08.2017, 18:10
1 | #2
maratovich


 
Регистрация: 12.07.2009
г. Самара
Сообщений: 2,140
Отправить сообщение для maratovich с помощью Skype™


А попробуйте так:
Код:
[Выделить все]
Sub fff()
Dim oBlk 'As IAcadBlockReference2
Dim oProps As Variant
Dim oDblkProp 'As AcadDynamicBlockReferenceProperty
Dim vPick As Variant
Dim I As Integer
vPick = ThisDrawing.Utility.GetPoint(, vbCr & "Insertion point: ")
Set oBlk = ThisDrawing.ModelSpace.InsertBlock(vPick, "x123", 1#, 1#, 1#, 0#)
If oBlk.IsDynamicBlock Then
    oProps = oBlk.GetDynamicBlockProperties
    For I = 0 To UBound(oProps)
        Set oDblkProp = oProps(I)
        If oDblkProp.PropertyName = "Angle" Then
            oDblkProp.Value = Atn(1) '45 degree angle
            Exit For
        End If
    Next
End If
End Sub
__________________
Вопрос : Где находится Тургай ? Ответ : Между Парагваем и Уругваем.....
maratovich вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 04.08.2017, 18:27
#3
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,492


Цитата:
Сообщение от maratovich Посмотреть сообщение
А попробуйте так:
Код:
[Выделить все]
Sub fff()
Dim oBlk 'As IAcadBlockReference2
Dim oProps As Variant
Dim oDblkProp 'As AcadDynamicBlockReferenceProperty
Dim vPick As Variant
Dim I As Integer
vPick = ThisDrawing.Utility.GetPoint(, vbCr & "Insertion point: ")
Set oBlk = ThisDrawing.ModelSpace.InsertBlock(vPick, "x123", 1#, 1#, 1#, 0#)
If oBlk.IsDynamicBlock Then
    oProps = oBlk.GetDynamicBlockProperties
    For I = 0 To UBound(oProps)
        Set oDblkProp = oProps(I)
        If oDblkProp.PropertyName = "Angle" Then
            oDblkProp.Value = Atn(1) '45 degree angle
            Exit For
        End If
    Next
End If
End Sub
То есть проверять "oDblkProp.PropertyName"? Но динпараметр вроде один всего в блоке..
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!
AlexV вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 04.08.2017, 18:29
1 | #4
maratovich


 
Регистрация: 12.07.2009
г. Самара
Сообщений: 2,140
Отправить сообщение для maratovich с помощью Skype™


Цитата:
Сообщение от AlexV Посмотреть сообщение
То есть проверять "oDblkProp.PropertyName"? Но динпараметр вроде один всего в блоке..
не туда смотрите.....
Set oDblkProp = oProps(I)
__________________
Вопрос : Где находится Тургай ? Ответ : Между Парагваем и Уругваем.....
maratovich вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 08.08.2017, 15:09
#5
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,492


Отчего-то сия процедурка съедает аж 5 секунд на изменение значения параметра. Может, оттого, что вставляется блок на неактивных лайотах? Но время убивается именно на
"Set tmpattrDin = AttrDin(0): tmpattrDin.Value = txtVid", без этих строк процедура в 10 раз быстрее. Как дать ей пинка, что б полетело?

Код:
[Выделить все]
Private Sub ins_bl(name_Blck, InsertPnt, txtVid)
    Dim insertedBlock As AcadBlockReference, AttrDin, tmpattrDin As AcadDynamicBlockReferenceProperty, tt
    On Error Resume Next
    tt = Timer
    Set insertedBlock = oLayout.Block.InsertBlock(InsertPnt, name_Blck, 1#, 1#, 1#, 0#)
    AttrDin = insertedBlock.GetDynamicBlockProperties
    Set tmpattrDin = AttrDin(0)
    tmpattrDin.Value = txtVid
    MsgBox Timer - tt
End Sub
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!
AlexV вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 08.08.2017, 15:45
#6
baksconstructor


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


Файл вашего блока приложите.
baksconstructor вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 08.08.2017, 16:02
#7
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,492


Цитата:
Сообщение от baksconstructor Посмотреть сообщение
Файл вашего блока приложите.
блок включает в себя - параметр видимости (около 50 значений) и порядка 130 примитивов - полилинии, текст, штриховки, блоки, сплайны, отрезки, области. Ничего особенно хитрого..
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!
AlexV вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 08.08.2017, 16:10
#8
Кулик Алексей aka kpblc
Moderator

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


Может, поможет отключение REGENMOODE?
__________________

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

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,492


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Может, поможет отключение REGENMOODE?
Попробовал, как работает с REGENMOODE=0 - разницы существенной нет. А вот, спасибо baksconstructor, - надоумил прокси поискать.. и, оказалось, их там есть! После чистки быстрее гораздо стало шевелиться, но все равно.. Вставка 20 блоков на 5 листах - порядка 20 секунд.
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!
AlexV вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 08.08.2017, 16:24
#10
Кулик Алексей aka kpblc
Moderator

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


А ты вставляешь, обращаясь к oLayout как к объекту листа? Или как к блоку листа?
__________________

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

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,492


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
А ты вставляешь, обращаясь к oLayout как к объекту листа? Или как к блоку листа?
Объявляю public переменную oLayout As AcadLayout, потом.. Как-то так:

Код:
[Выделить все]
Public oLayout As AcadLayout

sub Main()
***
    Set tmplLayouts = ThisDrawing.Layouts
***
    For i = 0 To tmplLayouts.Count - 1
      If tmplLayouts.Item(i).Name <> "Model" Then
        Set oLayout = tmplLayouts.Item(i)
     *****
                  Call ins_bl(name_Blck, minExt, tmptXt)
    End if
    ***
  Next i
End sub

Private Sub ins_bl(name_Blck, InsertPnt, txtVid)
    Dim insertedBlock As AcadBlockReference, AttrDin, tmpattrDin As AcadDynamicBlockReferenceProperty, tt
    On Error Resume Next
    tt = Timer
    Set insertedBlock = oLayout.Block.InsertBlock(InsertPnt, name_Blck, 1#, 1#, 1#, 0#)
    AttrDin = insertedBlock.GetDynamicBlockProperties
    Set tmpattrDin = AttrDin(0)
    tmpattrDin.Value = txtVid
    MsgBox Timer - tt
End Sub
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!

Последний раз редактировалось AlexV, 08.08.2017 в 16:54.
AlexV вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 08.08.2017, 17:27
#12
Кулик Алексей aka kpblc
Moderator

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


Попробуй обращаться именно к блоку листа по типу
oLBlock = oLayout.Block
Может быть, заработает
__________________

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

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,492


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Попробуй обращаться именно к блоку листа по типу
oLBlock = oLayout.Block
Может быть, заработает
Дык, вроде и так: "Set insertedBlock = oLayout.Block.InsertBlock"
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!
AlexV вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 08.08.2017, 23:22
#14
Кулик Алексей aka kpblc
Moderator

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


Упс, сорри...
__________________

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

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 1,441


Думаю, что без блока и без файла в который все это надо вставить протестировать и найти узкое место не получится.
Возможно дело не в коде, а в блоке.
Boxa на форуме вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 09.08.2017, 10:00
#16
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,492


Цитата:
Сообщение от Boxa Посмотреть сообщение
Думаю, что без блока и без файла в который все это надо вставить протестировать и найти узкое место не получится.
Возможно дело не в коде, а в блоке.
Да, сам блок влияет на скорость. Удалил всю графику, оставил только пару отрезков и параметр видимости - и время на вставку одного блока с установкой в одно из состояний снизилось с около 1 секунды до 0,35 секунд. Если исключить установку параметра tmpattrDin.Value = txtVid, тогда - 0,16 секунды..
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!
AlexV вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > VBA autocad 2016. Вставка динблоков на листы с установкой параметров

Инженерные консультации
Опции темы Поиск в этой теме
Поиск в этой теме:

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

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

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как изменить названия листов документа pdf при публикации из AutoCAD 2016 Михаил Секерин AutoCAD 4 23.06.2017 17:59
Отчего тормозит курсор в Autocad 2016? Korochun AutoCAD 0 02.03.2017 23:38
Как настроить копирование свойств (_matchprop) объектов между разными чертежами AutoCAD 2016 Kostinok AutoCAD 7 15.02.2017 12:35
Проблема создания связи таблиц в AutoCAD 2016 с MS Excel 2016 alterfiesta AutoCAD 13 04.09.2016 12:11
Как добавить префикс к однострочному тексту в AutoCAD 2016 andrey_artphoto AutoCAD 5 27.05.2015 17:11

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


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