Обсуждение видеоуроков AutoCAD VBA

Автор Тема: Обсуждение видеоуроков AutoCAD VBA  (Прочитано 155769 раз)

0 Пользователей и 1 Гость просматривают эту тему.

Оффлайн ediczr2012Автор темы

  • ADN OPEN
  • Сообщений: 31
  • Карма: 0
Добрый день.
При выполнении скрипта VBA  Вставка блока
Возникает ошибка:

Run-time error ‘-2147418113 (8000ffff)’
Automation error
Catastrophic failure


В чем причина ошибки ?
« Последнее редактирование: 24-08-2016, 10:19:37 от ediczr2012 »

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #1 : 24-08-2016, 09:25:45 »
Для начала - текстом указать версию и разрядность AutoCAD. Далее - код в студию (и, возможно, проект). Также текстом описать место ошибки. Просматривать непонятные ролики на ресурсе, к которому у меня на работе заблокирован доступ, я не стану.
У меня в ACAD2009x64 (другой сейчас использовать не могу - это последняя версия, на которую у меня установлен VBA) прекрасно сработал код
Код - Visual Basic [Выбрать]
  1. Option Explicit
  2.  
  3. Public Sub InsBlock()
  4. Dim blkRef as AcaBlockReference
  5. Dim pt as Variant
  6. Dim sName as String
  7.  
  8.   sName = "testblock"
  9.   pt = ThisDrawing.Utility.GetPoint(, "Insertion point : ")
  10.   Set blkRef = ThisDrawing.ModelSpace.InsertBlock(pt, sName, 1, 1, 1, 0)
  11. End Sub
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #2 : 24-08-2016, 10:02:32 »
Алексей Кулик, я не на работе, посмотрел с ютубчика.
В общем, AutoCAD 2012 (разрядность не смог определить по видео :) ).
Код взят из поста #4 данной темы.

Текст ошибки:
Run-time error ‘-2147418113 (8000ffff)’
Automation error
Catastrophic failure

Ошибка в строке:
Код - Visual Basic [Выбрать]
  1. pp = ThisDrawing.Utility.GetPoint(, "Укажите точку вставки блока:")

Я не совсем понимаю, с чем она связана.

ediczr2012, напиши разрядность AutoCAD и прикрепи проект .dvb.

Оффлайн ediczr2012Автор темы

  • ADN OPEN
  • Сообщений: 31
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #3 : 24-08-2016, 10:06:10 »
autoCAD 2012 разрядность 32 версия продукта F107.0.0 SP1

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #4 : 24-08-2016, 10:22:59 »
ediczr2012, задавай вопросы текстом, а не видеороликами.
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #5 : 24-08-2016, 10:24:42 »
Я не совсем понимаю, с чем она связана.
Возможно, проблема с совместимостью проектов. Скажем, сначала dvb разрабатывался в 2015х64 / 2016х64, а потом его тупо, не проверяя никакие References, открыли в 2012.
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #6 : 24-08-2016, 10:33:39 »
Возможно, проблема с совместимостью проектов. Скажем, сначала dvb разрабатывался в 2015х64 / 2016х64, а потом его тупо, не проверяя никакие References, открыли в 2012.
Дело в том, что сам dvb не распространяется. То есть ediczr2012 взял код с поста #4 и скопировал в свой проект, ну и в коде "Вставка блока" не нужны никакие References.

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #7 : 24-08-2016, 10:36:13 »
Максим Маркевич, ну мы же не знаем полной истории.
P.S. Вообще есть предложение - создать отдельную тему "Обсуждение видеоуроков по VBA для AutoCAD", чтобы не засорять этот топик (ну и перенести туда #31 и далее). Как идея?
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #8 : 24-08-2016, 10:43:46 »
ну мы же не знаем полной истории.
Немножко знаем/знаю.. Дело в том, что ediczr2012 написал мне сразу в лс, я не смог четко определить, в чем дело, поэтому предложил ему оставить вопрос в теме.
P.S. Вообще есть предложение - создать отдельную тему "Обсуждение видеоуроков по VBA для AutoCAD", чтобы не засорять этот топик (ну и перенести туда #31 и далее). Как идея?
Мне кажется, идея очень крутая. Просто изначально Александр Ривилис предложил обсуждать уроки в той же теме, где и сами уроки. Но теперь я вижу, что вот я запишу, например, еще парочку и они уже будут немножко затеряны в этих страницах.
Можно было бы сделать одну тему, вот эту, оставить здесь только уроки (тогда в шапке подпишу, что обсуждение происходит в другой теме), ну и, собственно, обсуждать все в другой теме.
Но надо, конечно, посоветоваться с Александром Ривилисом, потому что изначально это была его идея - так организовать процесс.
А его что-то сегодня не видно.
Ну и, конечно, хотелось бы уже помочь ediczr2012.
ediczr2012, еще раз предлагаю прикрепить тебе свой проект - это файл с расширением .dvb.

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #9 : 24-08-2016, 12:02:39 »
Подозреваю, что проблема связана с AutoCAD / VBA. Возможно требуется переустановка, возможно установка обновлений. Интересно, у  ediczr2012 хоть что-то на VBA работает?
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #10 : 24-08-2016, 12:10:41 »
Вспомнил еще одну очень важную вещь - AutoCAD всех версий до 2014 использует VBA 6.1, которая только 32-разрядная. Если сам AutoCAD 64-разрядный (Windows 64-разрядная), то возникает масса коллизий, связанная с межпроцесным взаимодействием с разной разрядностью.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #11 : 24-08-2016, 12:17:18 »
Подозреваю, что проблема связана с AutoCAD / VBA. Возможно требуется переустановка, возможно установка обновлений. Интересно, у  ediczr2012 хоть что-то на VBA работает?
Очень хороший вопрос. )
ediczr2012, попробуй что-то самое простое типа:
Код - Visual Basic [Выбрать]
  1. Sub Hello()
  2.     MsgBox "HelloWorld!!"
  3. End Sub
Вспомнил еще одну очень важную вещь - AutoCAD всех версий до 2014 использует VBA 6.1, которая только 32-разрядная. Если сам AutoCAD 64-разрядный (Windows 64-разрядная), то возникает масса коллизий, связанная с межпроцесным взаимодействием с разной разрядностью.
А вот это вполне может быть причиной неработоспособности. Лично я начинал писать VBA на AutoCAD 2015x64 на Windows7x64. Соответственно, с тех пор менялось все в том же ключе: сейчас у меня AutoCAD 2017x64, a Windows10x64. И никогда я не ловил подобной ошибки. Вообще, никогда.

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #12 : 24-08-2016, 12:25:27 »
Ну, 2009х64 тем не менее отработал корректно... Установленного 2012х64 нет, проверить не на чем :(
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #13 : 24-08-2016, 12:25:47 »
И никогда я не ловил подобной ошибки
Гугл тоже практически ничего про такую ошибку не знает. На форуме Autodesk в разделе AutoCAD VBA такая ошибка встретилась только один раз для AutoCAD 2011 x64 в Windows 7: http://forums.autodesk.com/t5/visual-basic-customization/selectonscreen-win7-64bit-with-version-2011-acad/m-p/3156626/highlight/true#M95539
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #14 : 24-08-2016, 12:28:15 »
Лично я начинал писать VBA на AutoCAD 2015x64 на Windows7x64.
Начиная с AutoCAD 2014 он использует VBA 7.1, который имеет ту же разрядность, что и сам AutoCAD: http://adn-cis.org/autocad-2014-dlya-razrabotchikov.html
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #15 : 24-08-2016, 12:30:39 »
Ну, 2009х64 тем не менее отработал корректно... Установленного 2012х64 нет, проверить не на чем :(
Я проверил в AutoCAD 2012 SP2 x64. Код работает нормально, хотя очень тормозит перед запросом указания точки.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #16 : 24-08-2016, 12:33:00 »
Такая же беда. Правда, я не удивлен: http://adn-cis.org/autocad,-vba-i-proizvoditelnost.html
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн ediczr2012Автор темы

  • ADN OPEN
  • Сообщений: 31
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #17 : 24-08-2016, 13:08:37 »
Заранее прошу прощения, я только изучаю VBA.

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

Причина не выполнения скрипта VBA из урока №4:

Код - Visual Basic [Выбрать]
  1. pp = ThisDrawing.Utility.GetPoint (, "Укажите точку вставки блока:")

связано с ошибкой компонентов операционной системы Windows 7 (-2147418113 (8000FFFF)    Разрушительный сбой.)
Описание по ошибке в статьях:
https://support.microsoft.com/ru-ru/kb/187942
https://support.microsoft.com/ru-ru/kb/303737
https://support.microsoft.com/ru-ru/kb/243349

Причина:
Сохранение курсоров, или иными словами, не закрывает их, не является SQL Server или ANSI SQL по умолчанию. Спецификацией OLE DB не указывать значение по умолчанию для этих свойств, поскольку это поведение можно изменить для поставщик.
Обработчик курсоров, однако сохранение курсоров.

Переделанный код VBA:

Код - Visual Basic [Выбрать]
  1. Sub InsertBlock()
  2.     Dim blockRef As AcadBlockReference
  3.     Dim name As String
  4.     Dim pp As Variant
  5.     Dim insPnt(0 To 2) As Double
  6.     ' кординаты вточки втавки блока
  7.    insPnt(0) = 0
  8.     insPnt(1) = 0
  9.     insPnt(2) = 0
  10.     ' Вставка блока
  11.    name = "ИмяБлока"
  12.     Set blockRef = ThisDrawing.ModelSpace.InsertBlock(insPnt, name, 1, 1, 1, 0)
  13.  
  14. End Sub



Пользуюсь пока таким вариантом, до устранения ошибку в системе.


Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #18 : 24-08-2016, 14:12:35 »
Переделанный код VBA:
Это не решение вопроса с выбором точки вставки. Тем более, ты не можешь знать, где еще проявятся подобные штуки. Поэтому я бы посоветовал тебе задуматься над переходом на более свежий софт, в частности AutoCAD поновее.

Оффлайн ediczr2012Автор темы

  • ADN OPEN
  • Сообщений: 31
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #19 : 24-08-2016, 14:17:12 »
Порекомендуй какой софт autoCAD поставить ?
Поддержку VBA  ставить отдельно придется 

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #20 : 24-08-2016, 14:22:11 »
Off-Topic: показать
Порекомендуй какой софт autoCAD поставить ?
Ну очевидно же, что все зависит от того, что ты используешь в придачу к AutoCAD и параметров твоего компа. Я бы ставил AutoCAD2017x64 и Windows10x64.

Поддержку VBA  ставить отдельно придется 
А вот это совсем не проблема. Скачал - установил.

Оффлайн ediczr2012Автор темы

  • ADN OPEN
  • Сообщений: 31
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #21 : 24-08-2016, 14:23:43 »
Хорошо учту. :)

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #22 : 24-08-2016, 18:15:53 »
А вот это совсем не проблема. Скачал - установил.
Если это не глобальная проблема системы ediczr2012. Тут возможны варианты...
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн ZaurbekA

  • ADN OPEN
  • Сообщений: 4
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #23 : 25-09-2016, 01:24:20 »
Доброго времени суток!
Максим, большое тебе спасибо уроки!
Позволь спросить несколько вопросов (и прошу прощения, если они покажутся глупыми - программирую в первый раз в жизни):
1. Если, к примеру, у нас несколько блоков, считывающих значения из Экселя, то как реализовать это в коде?
(то место, где мы задаем имя блока: name = "ИмяБлока")
2. Если изменяемых атрибутов несколько (вот тут - If att(i).TagString = "АТРИБУТ" Then), то мы просто несколько раз повторяем эту строку с разными тэгами?
3. Мы разобрали пример того, как вставлять новый блок, а как изменять тот, который уже существует на чертеже?
4. В одной из тем тут на форуме ты упомянул о книге "autocad vba joe sutphin" - можно ли ее где-нибудь найти?
Спасибо еще раз!

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #24 : 25-09-2016, 01:48:17 »
1. Если, к примеру, у нас несколько блоков, считывающих значения из Экселя, то как реализовать это в коде?
(то место, где мы задаем имя блока: name = "ИмяБлока")
Смотря, каким образом тебе нужно их вставлять. ZaurbekA, давай конкретный пример.
2. Если изменяемых атрибутов несколько (вот тут - If att(i).TagString = "АТРИБУТ" Then), то мы просто несколько раз повторяем эту строку с разными тэгами?
Да, конечно. Ты вот попробуй.
3. Мы разобрали пример того, как вставлять новый блок, а как изменять тот, который уже существует на чертеже?
Нужно использовать селекшн сет:
Код - Visual Basic [Выбрать]
  1. On Error Resume Next
  2.     ThisDrawing.SelectionSets("SS").Delete
  3.     Set ss = ThisDrawing.SelectionSets.Add("SS")
  4.     ss.SelectOnScreen
  5.     For Each objEnt In ss
  6.     Set objBRef = objEnt
  7.     With objBRef
  8.         If .IsDynamicBlock = True Then
  9.         Props = .GetDynamicBlockProperties
  10.             For Index = LBound(Props) To UBound(Props)
  11.                 Set oProp = Props(Index)
  12.                ' Что-то делаем со свойствами блока
  13.            Next
  14.         End If
  15.     End With
  16.     Next
  17. If Not ss Is Nothing Then
  18. ss.Delete
Это фрагмент кода! Но, если ты начинающий, то лучше всего все разбирать на конкретном примере.
4. В одной из тем тут на форуме ты упомянул о книге "autocad vba joe sutphin" - можно ли ее где-нибудь найти?
Книга есть в общем доступе:
https://dwg.ru/dnl/1640

Оффлайн ZaurbekA

  • ADN OPEN
  • Сообщений: 4
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #25 : 27-09-2016, 00:14:20 »
Смотря, каким образом тебе нужно их вставлять. ZaurbekA, давай конкретный пример.
А, я, честно говоря, думал создать файл с блоками, например несколько схем рам с эпюрами (я преподаю строймех) и изменять из в соответствии с расчетами в Эксель.
А если вставлять, то, наверное, как в твоем уроке - InsertBlock. Или я не понял вопроса?
Нужно использовать селекшн сет:
Удивительно, но у меня получилось.
Книгу скачал. Спасибо, но тут у меня еще один вопрос, скорей не вопрос, а совет что-ли твой спросить хочу (извини, если длинно получится):
Моя цель  - овладеть возможностями динамических блоков и их связью с Экселем (Маткадом) в том уровне (для меня космическом - без шуток) в каком они представлены в твоих видео (ЖБК и особенно в "Эпюре материалов" - до сих пор вспоминаю то удивление, которое ощутил при первом просмотре - мое искреннее восхищение!).
Так вот - мне не хочется становится программистом (да простят меня форумчане!), вникать в тонкие аспекты и сделать код оптимальным, красивым, логичным и прочее, поскольку при просмотре твоих видео, я понял, что мое владение динамическими блоками...в общем, нет моего владения ими - даже понять. как работаю твои блоки оказалось для меня непосильным (если вдруг надумаешь делать уроки, я первый ученик буду - честно), значит - вот основной фронт познавательной работы - динамические блоки, макросы типа твоих Автокад хаков, оптимизация процесса проектирования.
А вот и сам вопрос - что из программирования и самое главное в какой мере, мне следует изучить (может есть какие-то разделы каких-то книг, которое следует прочитать или есть видео, блоги и т.п. - ведь помимо Autocad VBA, ты рекомендовал еще "Язык макрокоманд и создание кнопок") для того, чтобы достичь моей цели? Опыт и последовательность твоего познания что-ли.
p.s. понимаю заведомую глупость такой постановки вопроса (и суть), поскольку изучая что-то по-настоящему, хочется знать как можно больше и лучше, просто овладение именно этим багажом знаний на данный момент и есть для меня "больше и лучше")
Спасибо еще раз.

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #26 : 27-09-2016, 00:40:14 »
Off-Topic: "Позволю себе влезть" • показать
Если хочется из одного продукта управлять другим продуктом, то варианта 2: либо заказывать софт, либо самостоятельно его разрабатывать. В первом случае если что не так - жди, пока автор подключится, вспомнит и теде. Во втором - рано или поздно начнешь соображать, где "тонкое" место. И сможешь исправить.
Из литературы я бы в первую очередь использовал прежде всего справку и форум. Без шуток :) Сверхсерьезные книги типа "Совершненный код" и тому подобное, что рекомендует Андрей Бушман - для начала, думаю, будут тяжеловаты.
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн ZaurbekA

  • ADN OPEN
  • Сообщений: 4
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #27 : 27-09-2016, 00:52:44 »
либо самостоятельно его разрабатывать.
дык, я ж этого и боюсь! :-)
а "управлять" это как-то уж через чур громко звучит - всего только то, что Максим Маркевич проделывает со своими блоками. Спасибо за ответ! Справкой пользуюсь как могу и форумом, как видите , тоже :-).

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #28 : 27-09-2016, 01:25:24 »
А, я, честно говоря, думал создать файл с блоками, например несколько схем рам с эпюрами (я преподаю строймех) и изменять из в соответствии с расчетами в Эксель.
А если вставлять, то, наверное, как в твоем уроке - InsertBlock. Или я не понял вопроса?
Придумай простую задачу (вот совсем простую с самыми простыми рамами), сделай скрины и грамотно ее сформулируй. Тогда я тебе смогу помочь!
ЖБК и особенно в "Эпюре материалов" - до сих пор вспоминаю то удивление, которое ощутил при первом просмотре - мое искреннее восхищение!
Спасибо. Я рад, что ты оценил.. Именно эпюру материалов. Конкретно в эпюре материалов - скорей сложный блок, чем сложный код (код примитивен).
если вдруг надумаешь делать уроки, я первый ученик буду - честно
Видео уже есть, но это в лс. Не по теме.
понимаю заведомую глупость такой постановки вопроса (и суть), поскольку изучая что-то по-настоящему, хочется знать как можно больше и лучше, просто овладение именно этим багажом знаний на данный момент и есть для меня "больше и лучше")
Понимаю твой вопрос и не считаю его глупым, хоть и советую тебе немного успокоиться и не суетиться. :)
Здесь я согласен полностью с Алексеем Куликом.
Ты для себя уже решил, что тебе помогут динамические блоки + VBA AutoCAD.
Насчет изучения VBA - это справка и форум, и пробовать-пробовать-пробовать (все примеры, что найдешь, надо пробовать и разбирать). Хочу отметить, что, по сути, моих уже уроков достаточно, чтобы делать что-то типа эпюры материалов.
Насчет динамических блоков - это снова справка, форум и пробовать-пробовать-пробовать.
В общем, рецепт на все случаи жизни. :D
ZaurbekA, тебе проще, есть люди типа меня, которые помогут. Ты только формулируй правильно задачи. ;)


Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #29 : 27-09-2016, 08:24:57 »
ZaurbekA, вот если хочешь - тебе достаточно простая задачка: сделать дин.блок, растягивающийся по двум направлениям (горизонталь - вертикаль). Ну типа прямоугольника. Вставить блок в пространство модели. Через VBA внутри AutoCAD установить значения дин.параметрам этого блока.
Задача посложнее: дин.параметры сделать с ограничениями нижнего и верхнего пределов, опять через VBA установить новые значения. Попытаться установить заведомо невозможные значения. Придумать, как обойти такую проблему
Задача еще посложнее: один из дин.параметров сделать дискретным (т.е. возможные значения 50, 100, 150 ... 500) и попытаться ему установить значение, например, 146. Придумать, как обойти такую проблему.
Вот как-то так примерно ;)
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #30 : 27-09-2016, 08:25:50 »
И задача "высшего уровня": повторить все эти три шага, вызывая AutoCAD через MathCAD / Excel и "забирая" значения из каких-то переменных или ячеек ;)
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн ZaurbekA

  • ADN OPEN
  • Сообщений: 4
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #31 : 27-09-2016, 13:07:32 »
Придумай простую задачу (вот совсем простую с самыми простыми рамами), сделай скрины и грамотно ее сформулируй. Тогда я тебе смогу помочь!
Ок. Хотя, я изначально не правильно задал вопрос  - я имел ввиду сделать что-то типа твоего ЖБК (где колонны, сечения, спецификации и прочее) и поэтому спросил: "а если блоков много?" - а надо было бы для начала разобраться, как ты это делал.
Буду пробовать и постараюсь правильно формулировать задачи.
Алексей Кулик, спасибо за домашние задания.
На "задачке посложнее", конечно же, споткнулся. Нашел в справке, что это называется "AllowedValues", думаю что программу нужно научить, что если "PropertyName" есть  "AllowedValues", то сделать "неAllowedValues" - либо как-то красивей, думаю. Но проблема пока что в том, что мне "нечем кричать и разговаривать" в программировании :) и как правильно искать нужные команды и правила их написания тоже пока туго лезет.



Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #32 : 27-09-2016, 14:42:51 »
я имел ввиду сделать что-то типа твоего ЖБК (где колонны, сечения, спецификации и прочее) и поэтому спросил: "а если блоков много?".
То, о чем ты сейчас говоришь, это один блок. 8)
На самом деле, редко бывает нужно использовать много блоков - это только в сложнейших задачах.
Проблема в том, что не очень много людей умеют в AutoCAD работать с блоками, атрибутами и полями. Поэтому, если говорить о программировании в AutoCAD, то нужно сразу с разобраться с тем, что уже есть в самой программе. А вот уже манипулировать этим, красиво обернуть - в этом поможет программирование (разумеется, я говорю про начальный этап). Потом все интереснее и интереснее.  ;)

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #33 : 29-10-2016, 16:37:30 »
Замечание к 14-ому уроку. Координаты точек окна для печати следует преобразовывать из UCS в DCS. Иначе в ряде случаев печатается совсем не это окно: http://adndevblog.typepad.com/autocad/2016/05/plot-to-window-extents-using-vba.html
 
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #34 : 30-10-2016, 13:26:50 »
Замечание к 14-ому уроку. Координаты точек окна для печати следует преобразовывать из UCS в DCS. Иначе в ряде случаев печатается совсем не это окно: http://adndevblog.typepad.com/autocad/2016/05/plot-to-window-extents-using-vba.html
Принято и исправлено (прямо в посте). Лично у меня обозначенных проблем не возникало, но полностью согласен, что так правильно!

Оффлайн das-76

  • ADN OPEN
  • Сообщений: 9
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #35 : 05-12-2016, 14:13:03 »
Максим Маркевич огромное спасибо за уроки.
Пробую печатать чертежи в PDF. Немного изменил ваш код из урока №14. У меня при выполнении команды ThisDrawing.Plot.PlotToFile FileName выскакивает окно ошибки AutoCAD.

Код - Visual Basic [Выбрать]
  1. Dim Xl As Excel.Application
  2. Dim Папка As String
  3. Dim Layout As AcadLayout
  4.  
  5. Private Sub AcadDocument_Activate()
  6. ' Вычерчивание схемы1
  7.    'Call Схема1
  8.    
  9.  ' Вычерчивание схемы2
  10.    'Call Схема2
  11.    
  12.  ' Вычерчивание схемы3
  13.    'Call Схема3
  14.  
  15. ' Печать чертежей
  16.    Dim pt1(0 To 1) As Double, pt2(0 To 1) As Double
  17.     Dim iTimer As Date
  18.  
  19.     Set Xl = GetObject(, "Excel.Application")
  20.     Папка = Xl.Range("Папка")
  21.    
  22.     For i = 1 To 3
  23.         ' Устанавливаем
  24.        Set Layout = ThisDrawing.ActiveLayout
  25.        
  26.         FileName = Папка & Xl.Range("Схема" & i) & ".pdf"
  27.         pt1(0) = Xl.Range("X1_" & i): pt1(1) = Xl.Range("Y1_" & i)  ' Получаем первую точку рамки
  28.        pt2(0) = Xl.Range("X2_" & i): pt2(1) = Xl.Range("Y2_" & i)  ' Получаем вторую точку
  29.        
  30.         ' Обновим текущую плот-информацию
  31.        Layout.RefreshPlotDeviceInfo
  32.                
  33.         ' Настройка печати
  34.        Layout.ConfigName = "DWG to PDF.pc3"
  35.         Layout.CanonicalMediaName = "ISO_full_bleed_A1_(594.00_x_841.00_MM)"
  36.         Layout.PlotRotation = ac90degrees
  37.         Layout.StandardScale = acScaleToFit
  38.         Layout.StyleSheet = "acad.ctb"
  39.        
  40.         ' Устанавливаем рамки окошка
  41.        Layout.SetWindowToPlot pt1, pt2
  42.         Layout.PlotType = acWindow
  43.        
  44.         ' Отправляем на печать
  45.        ThisDrawing.Regen acAllViewports
  46.         ThisDrawing.Plot.PlotToFile FileName
  47.     Next
  48.    
  49.     MsgBox ("Печать закончена")
  50. End Sub
« Последнее редактирование: 05-12-2016, 23:45:14 от Алексей Кулик »

Оффлайн Пашин Евгений

  • ADN PRO
  • *
  • Сообщений: 662
  • Карма: 12
  • Skype: pashin.evgeniy
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #36 : 05-12-2016, 14:47:31 »
das-76, добрый день.

Попробуйте выполнить печать в PDF-файл со следующими параметрами и в строгой последовательности:
1. Убедитесь, что каноническое имя формата существует и соответствует тому, что указан в вашем коде (в моём случае он указан как UserDefinedMetric (420.00 x 1486.00мм))
2. Попробуйте выполнить печать в строгой последовательности, которая указана в моём коде:

Код - Visual Basic [Выбрать]
  1. Public Sub PlotMe()
  2.  
  3. Dim p0(1) As Double
  4. Dim p1(1) As Double
  5. Dim p2(1) As Double
  6. Dim LowerLeft As Variant
  7. Dim UpperRight As Variant
  8.  
  9. With Application.ActiveDocument.ActiveLayout
  10.     .ConfigName = "DWG To PDF.pc3"
  11.     .CanonicalMediaName = "Каноническое имя формата (следите за кирилицей букв)"
  12.     .PaperUnits = acMillimeters
  13.     .PlotHidden = False
  14.     p0(0) = 0
  15.     p0(1) = 0
  16.     .PlotOrigin = p0
  17.     .PlotRotation = ac0degrees
  18.     p1(0) = 0
  19.     p1(1) = 0
  20.     LowerLeft = p1
  21.     p2(0) = 210 ' Значение из ячейки Excel
  22.    p2(1) = 297 ' Значение из ячейки Excel
  23.    UpperRight = p2
  24.     .SetWindowToPlot LowerLeft, UpperRight
  25.     .UseStandardScale = True
  26.     .SetCustomScale 1, 1
  27.     .PlotType = 4  ' acWindows
  28.    .CenterPlot = True
  29.     .PlotViewportBorders = True
  30.     .PlotViewportsFirst = True
  31.     .PlotWithLineweights = True
  32.     .PlotWithPlotStyles = True
  33.     .StyleSheet = "acad.ctb"
  34. End With
  35.  
  36. ThisDrawing.Plot.PlotToFile "D:\0001.pdf"
  37.  
  38. MsgBox "OK"
  39.  
  40. End Sub

3. Чтобы получить канонические имена форматов можно использовать код:

Код - Visual Basic [Выбрать]
  1. Public Sub CNNCLMDNMS()
  2. For Each PL In Application.ActiveDocument.ActiveLayout.GetCanonicalMediaNames
  3.     MsgBox PL
  4. Next
  5. End Sub


Оффлайн das-76

  • ADN OPEN
  • Сообщений: 9
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #37 : 05-12-2016, 20:15:40 »
Попробуйте выполнить печать в PDF-файл со следующими параметрами и в строгой последовательности:
1. Убедитесь, что каноническое имя формата существует и соответствует тому, что указан в вашем коде (в моём случае он указан как UserDefinedMetric (420.00 x 1486.00мм))
2. Попробуйте выполнить печать в строгой последовательности, которая указана в моём коде:

Повторил ваш код, результат тот же. Формат записал правильно (проверил с помощью вашего кода).

Оффлайн Пашин Евгений

  • ADN PRO
  • *
  • Сообщений: 662
  • Карма: 12
  • Skype: pashin.evgeniy
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #38 : 08-12-2016, 11:41:11 »
das-76,  тогда у меня нет другого варианта, как самому заглянуть в Ваш код.

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

Можете приложить к нему видео-каст? Если есть проблемы с выкладыванием кода.

Оффлайн das-76

  • ADN OPEN
  • Сообщений: 9
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #39 : 08-12-2016, 12:05:41 »
Евгений код я повторил ваш, только вставил формат.

Оффлайн das-76

  • ADN OPEN
  • Сообщений: 9
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #40 : 08-12-2016, 12:06:15 »
   
Код - Visual Basic [Выбрать]
  1.  Public Sub PlotMe()
  2.      
  3.     Dim p0(1) As Double
  4.     Dim p1(1) As Double
  5.     Dim p2(1) As Double
  6.     Dim LowerLeft As Variant
  7.     Dim UpperRight As Variant
  8.      
  9.     With Application.ActiveDocument.ActiveLayout
  10.         .ConfigName = "DWG To PDF.pc3"
  11.         .CanonicalMediaName = "ISO_full_bleed_A4_(210.00_x_297.00_MM)"
  12.         .PaperUnits = acMillimeters
  13.         .PlotHidden = False
  14.         p0(0) = 0
  15.         p0(1) = 0
  16.         .PlotOrigin = p0
  17.         .PlotRotation = ac0degrees
  18.         p1(0) = 0
  19.         p1(1) = 0
  20.         LowerLeft = p1
  21.         p2(0) = 100 ' Значение из ячейки Excel
  22.        p2(1) = 100 ' Значение из ячейки Excel
  23.        UpperRight = p2
  24.         .SetWindowToPlot LowerLeft, UpperRight
  25.         .UseStandardScale = True
  26.         .SetCustomScale 1, 1
  27.         .PlotType = 4  ' acWindows
  28.        .CenterPlot = True
  29.         .PlotViewportBorders = True
  30.         .PlotViewportsFirst = True
  31.         .PlotWithLineweights = True
  32.         .PlotWithPlotStyles = True
  33.         .StyleSheet = "acad.ctb"
  34.     End With
  35.      
  36.     ThisDrawing.Plot.PlotToFile "D:\0001.pdf"
  37.      
  38.     MsgBox "OK"
  39.      
  40.     End Sub
« Последнее редактирование: 08-12-2016, 14:34:55 от Александр Ривилис »

Оффлайн Пашин Евгений

  • ADN PRO
  • *
  • Сообщений: 662
  • Карма: 12
  • Skype: pashin.evgeniy
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #41 : 08-12-2016, 13:21:44 »
        p2(0) = 100 ' Значение из ячейки Excel
        p2(1) = 100 ' Значение из ячейки Excel

das-76, пожалуйста замените эти два значения на 210 и 297 соответственно. На самом деле это вторая точка области печати.



Код, который Вы показали - работает! Я только изменил вторую точку области печати и каноническое имя формата принтера. На видео я это показал.

А у Вас что показывает?

У меня Ваш код сработал так:




Оффлайн das-76

  • ADN OPEN
  • Сообщений: 9
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #42 : 08-12-2016, 13:35:37 »
Если создать новый чертёж и вставить код из урока №14 и не сохранять, то печать идёт. Даже вносил изменения в код и всё работало. Стоит только сохранить и закрыть, то при следующем запуске файла возникает эта проблема. Автокад мне достался по наследству.

Оффлайн Пашин Евгений

  • ADN PRO
  • *
  • Сообщений: 662
  • Карма: 12
  • Skype: pashin.evgeniy
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #43 : 08-12-2016, 13:40:01 »

Если создать новый чертёж и вставить код из урока №14 и не сохранять, то печать идёт. Даже вносил изменения в код и всё работало. Стоит только сохранить и закрыть, то при следующем запуске файла возникает эта проблема. Автокад мне достался по наследству.

Ничего страшного, главное понять, что у него не корректно срабатывает.
Вопросы:
1. Запускается ли макрос без ошибок?
2. Происходит ли печать Вашего объекта в PDF-файл?
3. Что отображается в PDF-файле? (если макрос работает) Можно в виде изображения.

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #44 : 08-12-2016, 13:42:58 »
Автокад мне достался по наследству.
Кстати, что за Автокад? Какая версия, разрядность системы?

Оффлайн Пашин Евгений

  • ADN PRO
  • *
  • Сообщений: 662
  • Карма: 12
  • Skype: pashin.evgeniy
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #45 : 08-12-2016, 13:55:59 »
Может преждевременно, но может попробовать переустановить VBA Enabler?


Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #46 : 08-12-2016, 14:36:34 »
das-76
Пожалуйста прочти у меня в подписи как следует форматировать код на форуме и в дальнейшем соблюдай это правило.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн das-76

  • ADN OPEN
  • Сообщений: 9
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #47 : 08-12-2016, 15:26:13 »
Вопросы:
1. Запускается ли макрос без ошибок?
2. Происходит ли печать Вашего объекта в PDF-файл?
3. Что отображается в PDF-файле? (если макрос работает) Можно в виде изображения.

До сохранения макрос работает без ошибок. Печать выполняется, в файле PDF то что нужно. Автокад 2016 Х64

Оффлайн das-76

  • ADN OPEN
  • Сообщений: 9
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #48 : 08-12-2016, 15:27:29 »
Пожалуйста прочти у меня в подписи как следует форматировать код на форуме и в дальнейшем соблюдай это правило.

Замечание принято. Исправлюсь.

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #49 : 08-12-2016, 15:32:18 »
До сохранения макрос работает без ошибок. Печать выполняется, в файле PDF то что нужно. Автокад 2016 Х64
Сделай скрин вот этого места:


Оффлайн das-76

  • ADN OPEN
  • Сообщений: 9
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #50 : 08-12-2016, 15:52:29 »
Вот сделал скрин.

Оффлайн Пашин Евгений

  • ADN PRO
  • *
  • Сообщений: 662
  • Карма: 12
  • Skype: pashin.evgeniy
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #51 : 08-12-2016, 16:17:59 »
До сохранения макрос работает без ошибок.

Такого явления я ещё не наблюдал за всю практику :) Попробовать VBA Enabler переустановить пытались?

Оффлайн das-76

  • ADN OPEN
  • Сообщений: 9
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #52 : 08-12-2016, 16:28:00 »
Спасибо всем за участие. Попробую переустановить. Правда получится не скоро уезжаю завтра.

Оффлайн Пашин Евгений

  • ADN PRO
  • *
  • Сообщений: 662
  • Карма: 12
  • Skype: pashin.evgeniy
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #53 : 09-12-2016, 06:21:12 »
Спасибо всем за участие. Попробую переустановить. Правда получится не скоро уезжаю завтра.

Попробуйте. Будем ждать от Вас положительных результатов.

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #54 : 09-12-2016, 08:53:33 »
Off-Topic: показать
Почему-то напоминает "и каков будет Ваш положительный ответ?" :)
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Пашин Евгений

  • ADN PRO
  • *
  • Сообщений: 662
  • Карма: 12
  • Skype: pashin.evgeniy
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #55 : 09-12-2016, 09:17:50 »
Off-Topic: показать

Почему-то напоминает "и каков будет Ваш положительный ответ?"
Что всё работает :)

Оффлайн Пашин Евгений

  • ADN PRO
  • *
  • Сообщений: 662
  • Карма: 12
  • Skype: pashin.evgeniy
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #56 : 09-12-2016, 09:18:09 »
Off-Topic: показать
Произошел какой-то сбой и у меня получилось два сообщения, заменил его на :)

Оффлайн ediczr2012Автор темы

  • ADN OPEN
  • Сообщений: 31
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #57 : 16-12-2016, 14:20:47 »
Доброго времени суток.

В ходе работы с VBA криптами из курса уроков: «Видеоуроки AutoCAD VBA» Автор: Маркевич Максим тема: Ответ #6 : 18-08-2016, 00:17:53 «6 Изменение атрибутов блока».
Вопрос:
При работе с атрибутами и динамическими свойствами блока появляется проблема со штриховкой объекта. 

Проблема:
При выполнении VBA скрипта по вставки блока в autoCAD чертеж с данными из Excel, штриховка вылетает за границы объекта или наоборот не заштриховывает объект по границе.   
В блоке настроены изменяемые размеры: “<<параметрами линейный – операция растяжение>>” и выполнена штриховка объектов: ” <<Штриховка – Ассоциативная – Аннотативная>>”. 

Может кто-нибудь сталкивался с похожей проблемой?

Система:
- Windows 7 (64-разрядная),
- AutoCAD 2013 (64-разрядная)


До этого не сталкивался с данной проблемой в AutoCAD. 
При сохранении блоков «запись блока на диск» и при редактировании блока штриховка типа: «Ассоциативная – Аннотативная» слетает на обычную,  в чем может быть причина?

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #58 : 18-12-2016, 10:17:25 »
Я бы сначала проверил сам блок - насколько корректно он вообще вставляется и работает. Далее - где сам файл и проблемный код? Вставка блока выполняется с одновременным импортом из стороннего файла или описание блока в текущем документе уже есть? Выполняется ли обновление вставленного вхождения?
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Пашин Евгений

  • ADN PRO
  • *
  • Сообщений: 662
  • Карма: 12
  • Skype: pashin.evgeniy
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #59 : 19-12-2016, 06:30:59 »
При сохранении блоков «запись блока на диск» и при редактировании блока штриховка типа: «Ассоциативная – Аннотативная» слетает на обычную,  в чем может быть причина?

ediczr2012, может пример Вашего кода выложите?

Оффлайн ediczr2012Автор темы

  • ADN OPEN
  • Сообщений: 31
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #60 : 19-12-2016, 14:17:13 »
Добрый день.

Записал видео проблемы по штриховке в динамическом блоке.



Сделал отдельный чертеж в autoCAD и загрузил блок (на видео все видно)

Проблема в общем чертеже остается та же самая по штриховке (где все блоки), при выполнении VBA скрипта штриховка вылетает, хотя в блоке штриховка "ассоциативная" и в блок не добавлена базовая точка.
Как видно из видео при добавлении базовой точки - штриховка вылетает хотя штриховка "ассоциативная".

Код - Visual Basic [Выбрать]
  1. Sub InsertBlockRazrez_1()
  2.  
  3.     Dim blockRef As AcadBlockReference
  4.     Dim name As String
  5.     Dim pp As Variant
  6.     Dim AP As Excel.Application
  7.     Dim WB As Excel.Workbook
  8.     Dim WS As Excel.Worksheet
  9.     Dim insPnt(0 To 2) As Double
  10.  
  11. 'В случае ошибки переходим к следующему действию
  12.        On Error Resume Next
  13.      
  14. 'Подключаемся к Excel
  15.        Set AP = Excel.Application
  16.         Set WB = AP.Workbooks.Open("C:\Probnic\primer.xlsm")
  17.         Set WS = WB.Worksheets("Лист1")
  18.  
  19. 'Получаем точку вставки блока
  20.        pp = ThisDrawing.Utility.GetPoint(, "Укажите точку вставки блока:")
  21.        
  22. 'Считываем данные с Excel имя блока
  23.        name_b = Cells(21, 1)
  24.  
  25. ' Имя блока
  26.        name = name_b
  27.        
  28. ' Вставка блока
  29.        Set blockRef = ThisDrawing.ModelSpace.InsertBlock(pp, name, 1, 1, 1, 0)
  30.        
  31. 'Получение динамических свойств блока
  32.        If blockRef.IsDynamicBlock = True Then
  33.              Props = blockRef.GetDynamicBlockProperties
  34.                  For Index = LBound(Props) To UBound(Props)
  35.                       Set prop = Props(Index)
  36. 'Получение динамических свойств блока Расстояние1
  37.                        If prop.PropertyName = "Расстояние1" Then
  38.                              prop.Value = Cells(17, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние1
  39. 'Получение динамических свойств блока Расстояние2
  40.                        ElseIf prop.PropertyName = "Расстояние2" Then
  41.                                 prop.Value = Cells(18, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние2
  42. 'Получение динамических свойств блока Расстояние3
  43.                        ElseIf prop.PropertyName = "Расстояние3" Then
  44.                                 prop.Value = Cells(19, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние3
  45. 'Получение динамических свойств блока Расстояние4
  46.                        ElseIf prop.PropertyName = "Расстояние4" Then
  47.                                 prop.Value = Cells(20, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние4
  48. 'Получение динамических свойств блока Расстояние5
  49.                        ElseIf prop.PropertyName = "Расстояние5" Then
  50.                                 prop.Value = Cells(21, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние5
  51. 'Получение динамических свойств блока Расстояние6
  52.                        ElseIf prop.PropertyName = "Расстояние6" Then
  53.                                 prop.Value = Cells(22, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние6
  54. 'Получение динамических свойств блока Расстояние7
  55.                        ElseIf prop.PropertyName = "Расстояние7" Then
  56.                                 prop.Value = Cells(23, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние7
  57. 'Получение динамических свойств блока Расстояние8
  58.                        ElseIf prop.PropertyName = "Расстояние8" Then
  59.                                 prop.Value = Cells(24, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние8
  60. 'Получение динамических свойств блока Расстояние9
  61.                        ElseIf prop.PropertyName = "Расстояние9" Then
  62.                                 prop.Value = Cells(25, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние9
  63. 'Получение динамических свойств блока Расстояние10
  64.                        ElseIf prop.PropertyName = "Расстояние10" Then
  65.                                 prop.Value = Cells(26, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние10
  66. 'Получение динамических свойств блока Расстояние11
  67.                        ElseIf prop.PropertyName = "Расстояние11" Then
  68.                                 prop.Value = Cells(27, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние11
  69. 'Получение динамических свойств блока Расстояние12
  70.                        ElseIf prop.PropertyName = "Расстояние12" Then
  71.                                 prop.Value = Cells(28, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние12
  72. 'Получение динамических свойств блока Расстояние13
  73.                        ElseIf prop.PropertyName = "Расстояние13" Then
  74.                                 prop.Value = Cells(29, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние13
  75. 'Получение динамических свойств блока Расстояние14
  76.                        ElseIf prop.PropertyName = "Расстояние14" Then
  77.                                 prop.Value = Cells(30, 20) * 1 'Считываем данные с Excel динамических свойства Расстояние14
  78.                        End If
  79.                  Next
  80.         End If
  81.  
  82. 'Получение атрибутов
  83.        If blockRef.HasAttributes = True Then
  84.             att = blockRef.GetAttributes
  85.                 For i = LBound(att) To UBound(att)
  86.                
  87. 'Получение атрибутов TIP_GRUNDA_1
  88.                    If att(i).TagString = "TIP_GRUNDA_1" Then
  89.                         att(i).TextString = Cells(17, 8)    'Считываем данные с Excel TIP_GRUNDA_1
  90. 'Получение атрибутов TIP_GRUNDA_2
  91.                    ElseIf att(i).TagString = "TIP_GRUNDA_2" Then
  92.                         att(i).TextString = Cells(18, 8)    'Считываем данные с Excel TIP_GRUNDA_2
  93. 'Получение атрибутов TIP_GRUNDA_3
  94.                    ElseIf att(i).TagString = "TIP_GRUNDA_3" Then
  95.                         att(i).TextString = Cells(19, 8)    'Считываем данные с Excel TIP_GRUNDA_3
  96. 'Получение атрибутов TIP_GRUNDA_4
  97.                    ElseIf att(i).TagString = "TIP_GRUNDA_4" Then
  98.                         att(i).TextString = Cells(20, 8)    'Считываем данные с Excel TIP_GRUNDA_4
  99. 'Получение атрибутов UROVEN_JISTOGO_POLA
  100.                    ElseIf att(i).TagString = "UROVEN_JISTOGO_POLA" Then
  101.                         att(i).TextString = Cells(21, 8)    'Считываем данные с Excel UROVEN_JISTOGO_POLA
  102. 'Получение атрибутов UROVEN_ZEMLI
  103.                    ElseIf att(i).TagString = "UROVEN_ZEMLI" Then
  104.                         att(i).TextString = Cells(22, 8)    'Считываем данные с Excel UROVEN_ZEMLI
  105. 'Получение атрибутов UROVEN_POD_VOD
  106.                    ElseIf att(i).TagString = "UROVEN_POD_VOD" Then
  107.                         att(i).TextString = Cells(23, 8)    'Считываем данные с Excel UROVEN_POD_VOD
  108. 'Получение атрибутов OTM_FUN_V2
  109.                    ElseIf att(i).TagString = "OTM_FUN_V2" Then
  110.                         att(i).TextString = Cells(24, 8)    'Считываем данные с Excel OTM_FUN_V2
  111. 'Получение атрибутов OTM_PODUHCI
  112.                    ElseIf att(i).TagString = "OTM_PODUHCI" Then
  113.                         att(i).TextString = Cells(25, 8)    'Считываем данные с Excel OTM_PODUHCI
  114. 'Получение атрибутов OTM_SL_1
  115.                    ElseIf att(i).TagString = "OTM_SL_1" Then
  116.                         att(i).TextString = Cells(26, 8)    'Считываем данные с Excel OTM_SL_1
  117. 'Получение атрибутов OTM_SL_2
  118.                    ElseIf att(i).TagString = "OTM_SL_2" Then
  119.                         att(i).TextString = Cells(27, 8)    'Считываем данные с Excel OTM_SL_2
  120. 'Получение атрибутов OTM_SL_3
  121.                    ElseIf att(i).TagString = "OTM_SL_3" Then
  122.                         att(i).TextString = Cells(28, 8)    'Считываем данные с Excel OTM_SL_3
  123. 'Получение атрибутов OTM_CKV_1
  124.                    ElseIf att(i).TagString = "OTM_CKV_1" Then
  125.                         att(i).TextString = Cells(29, 8)    'Считываем данные с Excel OTM_CKV_1
  126. 'Получение атрибутов OTM_CKV_2
  127.                    ElseIf att(i).TagString = "OTM_CKV_2" Then
  128.                         att(i).TextString = Cells(30, 8)    'Считываем данные с Excel OTM_CKV_2
  129. 'Получение атрибутов OTM1-1.1
  130.                    ElseIf att(i).TagString = "OTM1-1.1" Then
  131.                         att(i).TextString = Cells(17, 14)   'Считываем данные с Excel OTM1-1.1
  132. 'Получение атрибутов OTM1-1.1_2
  133.                    ElseIf att(i).TagString = "OTM1-1.1_2" Then
  134.                         att(i).TextString = Cells(18, 14)   'Считываем данные с Excel OTM1-1.1_2
  135. 'Получение атрибутов OTM1-1.2
  136.                    ElseIf att(i).TagString = "OTM1-1.2" Then
  137.                         att(i).TextString = Cells(19, 14)   'Считываем данные с Excel OTM1-1.2
  138. 'Получение атрибутов OTM1-1.2_3
  139.                    ElseIf att(i).TagString = "OTM1-1.2_3" Then
  140.                         att(i).TextString = Cells(20, 14)   'Считываем данные с Excel OTM1-1.2_3
  141. 'Получение атрибутов OTM1-1.3
  142.                    ElseIf att(i).TagString = "OTM1-1.3" Then
  143.                         att(i).TextString = Cells(21, 14)   'Считываем данные с Excel OTM1-1.3
  144. 'Получение атрибутов OTM1-1.3_4
  145.                    ElseIf att(i).TagString = "OTM1-1.3_4" Then
  146.                         att(i).TextString = Cells(22, 14)   'Считываем данные с Excel OTM1-1.3_4
  147. 'Получение атрибутов OTM1-1.4
  148.                    ElseIf att(i).TagString = "OTM1-1.4" Then
  149.                         att(i).TextString = Cells(23, 14)   'Считываем данные с Excel OTM1-1.4
  150. 'Получение атрибутов OTM1-1.4_5
  151.                    ElseIf att(i).TagString = "OTM1-1.4_5" Then
  152.                         att(i).TextString = Cells(24, 14)   'Считываем данные с Excel OTM1-1.4_5
  153. 'Получение атрибутов OTM1-1.5
  154.                    ElseIf att(i).TagString = "OTM1-1.5" Then
  155.                         att(i).TextString = Cells(25, 14)   'Считываем данные с Excel OTM1-1.5
  156. 'Получение атрибутов OTM1-1.5_6
  157.                    ElseIf att(i).TagString = "OTM1-1.5_6" Then
  158.                         att(i).TextString = Cells(26, 14)   'Считываем данные с Excel OTM1-1.5_6
  159. 'Получение атрибутов OTM1-1.6
  160.                    ElseIf att(i).TagString = "OTM1-1.6" Then
  161.                         att(i).TextString = Cells(27, 14)   'Считываем данные с Excel OTM1-1.6
  162. 'Получение атрибутов OTM1-1.6_7
  163.                    ElseIf att(i).TagString = "OTM1-1.6_7" Then
  164.                         att(i).TextString = Cells(28, 14)   'Считываем данные с Excel OTM1-1.6_7
  165. 'Получение атрибутов OTM1-1.7
  166.                    ElseIf att(i).TagString = "OTM1-1.7" Then
  167.                         att(i).TextString = Cells(29, 14)   'Считываем данные с Excel OTM1-1.7
  168. 'Получение атрибутов OTM1-1.7_8
  169.                    ElseIf att(i).TagString = "OTM1-1.7_8" Then
  170.                         att(i).TextString = Cells(30, 14)   'Считываем данные с Excel OTM1-1.7_8
  171. 'Получение атрибутов OTM1-1.8
  172.                    ElseIf att(i).TagString = "OTM1-1.8" Then
  173.                         att(i).TextString = Cells(31, 14)   'Считываем данные с Excel OTM1-1.8
  174. 'Получение атрибутов OTM1-1.8_9
  175.                    ElseIf att(i).TagString = "OTM1-1.8_9" Then
  176.                         att(i).TextString = Cells(17, 17)   'Считываем данные с Excel OTM1-1.8_9
  177. 'Получение атрибутов OTM1-1.9
  178.                    ElseIf att(i).TagString = "OTM1-1.9" Then
  179.                         att(i).TextString = Cells(18, 17)   'Считываем данные с Excel OTM1-1.9
  180. 'Получение атрибутов OTM1-1.9_10
  181.                    ElseIf att(i).TagString = "OTM1-1.9_10" Then
  182.                         att(i).TextString = Cells(19, 17)   'Считываем данные с Excel OTM1-1.9_10
  183. 'Получение атрибутов OTM1-1.10
  184.                    ElseIf att(i).TagString = "OTM1-1.10" Then
  185.                         att(i).TextString = Cells(20, 17)   'Считываем данные с Excel OTM1-1.10
  186. 'Получение атрибутов OTM1-1.10_11
  187.                    ElseIf att(i).TagString = "OTM1-1.10_11" Then
  188.                         att(i).TextString = Cells(21, 17)   'Считываем данные с Excel OTM1-1.10_11
  189. 'Получение атрибутов OTM1-1.11
  190.                    ElseIf att(i).TagString = "OTM1-1.11" Then
  191.                         att(i).TextString = Cells(22, 17)   'Считываем данные с Excel OTM1-1.11
  192. 'Получение атрибутов OTM1-1.11_12
  193.                    ElseIf att(i).TagString = "OTM1-1.11_12" Then
  194.                         att(i).TextString = Cells(23, 17)   'Считываем данные с Excel OTM1-1.11_12
  195. 'Получение атрибутов OTM1-1.12
  196.                    ElseIf att(i).TagString = "OTM1-1.12" Then
  197.                         att(i).TextString = Cells(24, 17)   'Считываем данные с Excel OTM1-1.12
  198. 'Получение атрибутов OTM1-1.12_13
  199.                    ElseIf att(i).TagString = "OTM1-1.12_13" Then
  200.                         att(i).TextString = Cells(25, 17)   'Считываем данные с Excel OTM1-1.12_13
  201. 'Получение атрибутов OTM1-1.13
  202.                    ElseIf att(i).TagString = "OTM1-1.13" Then
  203.                         att(i).TextString = Cells(26, 17)   'Считываем данные с Excel OTM1-1.13
  204. 'Получение атрибутов OTM1-1.13_14
  205.                    ElseIf att(i).TagString = "OTM1-1.13_14" Then
  206.                         att(i).TextString = Cells(27, 17)   'Считываем данные с Excel OTM1-1.13_14
  207. 'Получение атрибутов OTM1-1.14
  208.                    ElseIf att(i).TagString = "OTM1-1.14" Then
  209.                         att(i).TextString = Cells(28, 17)   'Считываем данные с Excel OTM1-1.14
  210. 'Получение атрибутов OTM1-1.14_15
  211.                    ElseIf att(i).TagString = "OTM1-1.14_15" Then
  212.                         att(i).TextString = Cells(29, 17)   'Считываем данные с Excel OTM1-1.14_15
  213. 'Получение атрибутов OTM1-1.15
  214.                    ElseIf att(i).TagString = "OTM1-1.15" Then
  215.                         att(i).TextString = Cells(30, 17)   'Считываем данные с Excel OTM1-1.15
  216.                    End If
  217.                 Next
  218.         End If
  219.  
  220. 'Закрываем Excel
  221.        AP.Quit
  222.  
  223. End Sub

Не понятна сама причина не корректной работы штриховки. (в основном чертеже при выполнении VBA та же ситуация "штриховка вылетает").
Как это можно поправить, при создании блоков не делал привязку "базовой точки". Есть необходимость добавить "базовую точку", ну при исправлении блок штриховка исправляется на обычную. (В чем причина???, как исправить, таких блоков очень много).
 
« Последнее редактирование: 19-12-2016, 22:21:39 от Александр Ривилис »

Оффлайн Пашин Евгений

  • ADN PRO
  • *
  • Сообщений: 662
  • Карма: 12
  • Skype: pashin.evgeniy
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #61 : 19-12-2016, 14:27:40 »
ediczr2012, можете выслать файл с блоком?

Оффлайн ediczr2012Автор темы

  • ADN OPEN
  • Сообщений: 31
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #62 : 19-12-2016, 14:53:45 »
Файл autoCAD c блоком прикрепил.
Первый исходный блок без базовой точки, второй блок исправленный с базовой точки.

Скрипты VBA и Exсel, приложил 3 и 5 файл.



 
« Последнее редактирование: 19-12-2016, 15:27:04 от ediczr2012 »

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #63 : 19-12-2016, 22:22:40 »
ediczr2012
Не забываем про правильное форматирование кода на нашем форуме (смотри у меня в подписи).
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #64 : 20-12-2016, 00:03:42 »
Файлы не качал. ИМХО проблема может крыться в аннотативности штриховки - попробуй ее снять.
Фигню посоветовал-с...
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн trir

  • ADN Club
  • ****
  • Сообщений: 470
  • Карма: 63
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #65 : 20-12-2016, 09:37:40 »
Ммм... колонки, помню как на Delphi их строил... эх молодость
Динамические блоки - это боль
У вас контур штриховок состоит из линий, лучше сделать контур каждой штриховки отдельной полилинией

Оффлайн ediczr2012Автор темы

  • ADN OPEN
  • Сообщений: 31
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #66 : 20-12-2016, 13:28:23 »
Добрый день.

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

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

Я уже просто в растерянности и не могу понять причины данного безобразия.  :o

Данная проблема была и обсуждалась на форуме: «Сообщество программистов Autodesk в СНГ / ADN Club / AutoCAD .NET API / Изменение параметра динамического блока в новом открытом документе?»
Извините, вам запрещён просмотр содержимого спойлеров.

Только данный вопрос и решение по C#. Чем закончилось?  ??? 

P.S. начинал за здравие, заканчиваю за упокой.
 

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #67 : 22-12-2016, 22:44:56 »
Записал видео проблемы по штриховке в динамическом блоке.
Ну ты, конечно, записал, так записал. ))
Почему не сделал обычный прямоугольник со штриховкой? Там же была бы видна твоя проблема! А ты выложил блоков, кодов и экселя, что тут надо минут 15 вникать, что же ты хочешь.. :)
В общем, советую на будущее делать маленькие тестовые примеры. Больше вероятность, что быстрей помогут, да и проще понимать всю суть вопроса самому.
Итак, я сделал тестовый блок со штриховкой (см. вложения - очевидно, что штриховка должна быть ассоциативной, и что она должна работать в блоке без манипуляций при помощи программирования). Далее сформировал простейший код VBA по вставке того самого блока:
Код - Visual Basic [Выбрать]
  1. Sub InsertBlock()
  2.     Dim blockRef As AcadBlockReference
  3.     Dim name As String
  4.     Dim pp As Variant
  5.     'Получаем точку вставки блока
  6.    pp = ThisDrawing.Utility.GetPoint(, "Укажите точку вставки блока:")
  7.     'Вставка блока
  8.    name = "Тестовый"
  9.     Set blockRef = ThisDrawing.ModelSpace.InsertBlock(pp, name, 1, 1, 1, 0)
  10.     'Получение динамических свойств блока
  11.    If blockRef.IsDynamicBlock = True Then
  12.         Props = blockRef.GetDynamicBlockProperties
  13.             For Index = LBound(Props) To UBound(Props)
  14.                 Set prop = Props(Index)
  15.                     If prop.PropertyName = "Длина" Then
  16.                     prop.Value = 75#
  17.                     ElseIf prop.PropertyName = "Ширина" Then
  18.                     prop.Value = 45#
  19.                     End If
  20.             Next
  21.     End If
  22. End Sub
Блок вставлялся некорректно, чтобы штриховка "выровнялась", приходилось нажимать на одну из ручек и оставлять ее в том же месте (см. скринкаст).
Далее я решил написать такой же код, только используя C# .NET:
Извините, вам запрещён просмотр содержимого спойлеров.
И стало работать все на УРА!

Не могу понять, в чем дело. Но одно ясно точно: вставка блока с корректным отображение штриховки работает, если использовать c#.NET, и не работает, если использовать VBA. Не могу сказать, в чем дело. Помню только, что когда писал на VBA очень избегал штриховок.


Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #68 : 26-12-2016, 13:08:39 »
В общем, ребзя, кому интересна данная тема, если мы дружно позовем Александра Наумовича, то возможно он и даст дельный совет к Новому Году насчет предыдущего поста.  ;)

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #69 : 26-12-2016, 14:45:34 »
В общем, ребзя, кому интересна данная тема, если мы дружно позовем Александра Наумовича, то возможно он и даст дельный совет к Новому Году насчет предыдущего поста.  ;)
У меня не воспроизводится этот баг ни в AutoCAD 2016, ни в AutoCAD 2017 - оба со всеми обновлениями:

Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #70 : 26-12-2016, 19:23:21 »
У меня не воспроизводится этот баг ни в AutoCAD 2016, ни в AutoCAD 2017 - оба со всеми обновлениями:
Вот это поворот. У меня AutoCAD 2017 тоже со всеми обновлениями - русский.

Но в языке же не может быть проблема!

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #71 : 26-12-2016, 19:32:55 »
У меня AutoCAD 2017 тоже со всеми обновлениями - русский.
Не всеми:


Извините, вам запрещён просмотр содержимого спойлеров.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #72 : 26-12-2016, 20:08:51 »
Извините, вам запрещён просмотр содержимого спойлеров.
Спасибо за обновления.
Я обновил свой AutoCAD 2017 (русский), но обозначенная выше проблема осталась. Для меня она не является критичной, но вот тебе, ediczr2012, советую обратить внимание на подобные вещи и поэкспериментировать. Возможно, поможет.
В любом случае, пока что других мыслей на этот счет нет.
« Последнее редактирование: 26-12-2016, 20:24:52 от Александр Ривилис »

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #73 : 26-12-2016, 20:28:05 »
Мне попадалась информация о том, что такие проблемы возникают в вертикальных приложениях (Mechanical, Civil 3D). Но вроде _REGEN помогает. Ничего по этому поводу сказать не могу.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #74 : 03-01-2017, 20:12:39 »
Максим Маркевич, Максим Маркевич, Не ну Val() внутри CDbl() это совсем перестраховка. Ведь человек, который будет это делать ссылается на ячейку, в которой лежит число. Ну не будет там "43 яблока". Вполне можно было обойтись отдельно Val(), если уж на то пошло:
Код - Visual Basic [Выбрать]

У меня бывает и "43 яблока" и формула лежит в ячейке екселя. И нужно перенести все это в динамический блок Автокада. Как в этом случае быть?

Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #75 : 03-01-2017, 20:24:13 »
А если в ячейки не число? или не только число?
Стоило сразу нормально делать и парой комментариев все прояснить?
извиняюсь не поняла как правильно цитировать).

И все таки:есть файл автокада с динамическим блоком с атрибутами. Атрибуты - текст, они расчитываются в екселе. Задача - перенести в автокад. Далее - расчитать количество копий данного блока - цифру взять из екселя. Далее Данный блок скопировать и каждой копии присвоить свои атрибуты, расчитанные в екселе. Реальна ли задача для VBA?

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #76 : 03-01-2017, 20:38:07 »
Сразу вопрос: а куда вставлять-то новые блоки? Откуда брать настройки вхождений?
И почему бы не попробовать attout / attin? Часть проблемы, я думаю, они помогут решить.
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #77 : 04-01-2017, 13:33:23 »
У меня бывает и "43 яблока" и формула лежит в ячейке екселя. И нужно перенести все это в динамический блок Автокада. Как в этом случае быть?
Брать строку и с ней работать!
И все таки:есть файл автокада с динамическим блоком с атрибутами. Атрибуты - текст, они расчитываются в екселе. Задача - перенести в автокад. Далее - расчитать количество копий данного блока - цифру взять из екселя. Далее Данный блок скопировать и каждой копии присвоить свои атрибуты, расчитанные в екселе. Реальна ли задача для VBA?
Итак. Предлагаю не быть голословными. Тестовый пример, содержащий все твои проблемы в студию! Это должно быть нечто простое, при этом, такое, что даст ответ на все твои вопросы. Сформулируй задачу и мы вместе с ней разберемся!

Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #78 : 04-01-2017, 13:52:43 »
attout / attin все таки решат лишь малую часть задач. Приложу файлы. В автокаде есть блок Switch, у него есть атрибуты и видимости. Точка вставки для него определена неизменной. Допустим для первого вхождения х=94.928 y=219.4 z=100, для вторго - x=116.454, для третьего - x=137.98 и т.д. В екселе некоторый расчет (электрических щитов), состоящий из "блоков данных щита", разделенных одной строкой. В колонке 16 - номер блока щита. В колонке 18, начиная с 4 строки после номера блока щита идут уже атрибуты автокадовского блока. LINE1 - это колонка 18,LINE2 - это колонка 12... Макросом Максима Маркевича выгружю в автокадовский блок данные из 6 строки. А как проверить - есть ли в колонке 18 значение в следующей строке, (блока щита 1) данные? Если есть, то выполняем команду InsertBloc c координатами x=116.454. Доходим до пустой строки, щит закончился.
Или пойти с другого конца - макросом проверяем количество строк в блоке щита 1, далее ваполняем столько раз команду InsertBloc с заданными координатами.
Ну очень было бы хорошо автоматизировать этот процесс!

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #79 : 04-01-2017, 18:24:36 »
Это должно быть нечто простое, при этом, такое, что даст ответ на все твои вопросы.
Вот теперь представь человека, который в жизни не электрик и ничего подобного никогда не проектировал. Разве это "нечто простое"? :)
Я уже не первый раз пишу, ну придумайте вы "кирпич" с двумя атрибутами, ну быстрее же помогут на форуме!!!!
Так как мне лично не совсем понятно, что нужно сделать, то и писать я буду псевдокодом:
1. Самое первое, что тебе нужно сделать, как я понял, это определить границы блоков щитов в экселе. То есть нужно понять с какой строчки начинается блок 1 и на какой он заканчивается, то же самое нужно проделать для всех блоков.
Для этого ты декларируешь массив чисел и просто его заполняешь, пробегаясь по строчкам экселя.
То есть используешь цикл For от нуля до последней строки экселя, если, например, 1-й и 2-й столбцы нулевые, то есть равны "", то значит следующая строчка - это начало щита, в другой раз при таком же условии - предыдущая строчка будет концом щита. Таким образом, ты определяешь границы - то есть у тебя будет массив, у которого границами первого щита будут элементы с номером 0 и 1, второго - элементы с номером 2 и 3 и т.д.
2. Далее ты пробегаешься циклом по границам первого щита и смотришь, чтобы, например, в столбце 18 было не пустое значение, если оно не пустое, то вставляешь блок с нужными значениями. Все это будет выполняться в цикле без особых проблем. В цикле же задаешь приращение координат!
3. То же самое делаешь для остальных щитов.
Реальна ли задача для VBA?
Задача вполне решаемая для VBA, ничего сверхсложного нет!
Если хочешь помощи в виде кода, то, подготовь "кирпич" (это простой прямоугольный блок, например) с минимальный числом атрибутов, а также самый простой и понятный эксель. И распиши все так, чтобы не приходилось 10 раз перечитывать твое сообщение, уткнувшись в эксель, при этом я так и не разобрался - у меня остались вопросы, а сидеть и вникать - нет столько времени!.
Я вот уверен на 100%, если Вы сядете и попытаетесь четко сформулировать проблему, то более 50% Ваших вопросов отпадут!

Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #80 : 05-01-2017, 11:38:13 »
Пожалуй верно. Этот блок дала потому что он до боли знаком бо-ольшому количеству аудитории (и наверняка кто то уже изобрел этот велосипед). Отложим и будем копировать просто линию с 2 атрибутами (это кабель в электрической однолинейке). До полного блока (если удастся справится с этой задачей) дойдет очередь и я обязательно выложу его здесь.

Так как мне лично не совсем понятно, что нужно сделать
А непонятно, потому что я урезала файл ексель. Откройте скрытые строки файла, там еще 2 щита (их может быть 50).
 
Самое первое, что тебе нужно сделать, как я понял, это определить границы блоков щитов в экселе. То есть нужно понять с какой строчки начинается блок 1 и на какой он заканчивается, то же самое нужно проделать для всех блоков.
Между блоками данных щита ВСЕГДА одна пустая строка.
И в колонке 16 ВСЕГДА только номер блока. То есть границы блока щита - это расстояние между цифрами в колонке 16.

Для этого ты декларируешь массив чисел и просто его заполняешь, пробегаясь по строчкам экселя.
Так. Для данного блока "Ветка" для атрибута КАБЕЛЬ массив будет - колонка 2, строка с 6 по 11, для атрибута - ДЛИНА массив будет колонка 3, те же строки.
при этом кол - во строк в блоке щита - это переменная, номера строк - переменная, номер блока щита - переменная.

Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #81 : 05-01-2017, 12:14:51 »
То есть используешь цикл For от нуля до последней строки экселя, если, например, 1-й и 2-й столбцы нулевые, то есть равны "", то значит следующая строчка - это начало щита, в другой раз при таком же условии - предыдущая строчка будет концом щита. Таким образом, ты определяешь границы - то есть у тебя будет массив, у которого границами первого щита будут элементы с номером 0 и 1, второго - элементы с номером 2 и 3 и т.д.

Если в строке 3 колонка 16 - то есть cell (3,16) есть цифра (номер щита), то массив начинается ВСЕГДА с 3+3 строки, то есть с в данном случае с 6 строки для любых атрибутов данного блока автокад. Для второго щита (а он будет в другом файле автокад), массив начинается с строки 16 (те же  колонки 2 и 3).

Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #82 : 05-01-2017, 17:05:55 »
Итак "бежим" по столбцу 16, и проверяем, есть ли в ячейке число - номер щита. если есть, выделяем вниз строки полностью до первой пустой строки. Это блок щита, обрабатываем его, потом переходим на последнюю найденную из выделенных +1 - получается строка нового блока, далее по кругу. 

Что значит обрабатываем блок щита:
1. создаем отдельный файл .dwg, с названием например по номеру блока щита "01" в той же папке, что и ексель из шаблона .dwt, в котором уже есть наш блок "Ветка". Ну а как иначе.
2. И вот тут надо копировать копировать наш блок ВЕТКА в автокаде нужное количество раз...  :-\

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #83 : 05-01-2017, 17:37:46 »
Пожалуй верно. Этот блок дала потому что он до боли знаком бо-ольшому количеству аудитории (и наверняка кто то уже изобрел этот велосипед).
Лично мне он не знаком. Вообще, ни капельки. :)
Отложим и будем копировать просто линию с 2 атрибутами (это кабель в электрической однолинейке). До полного блока (если удастся справится с этой задачей) дойдет очередь и я обязательно выложу его здесь.
Какую линию? Какие данные? Какой эксель? Что брать? Куда записывать? Куда вставлять?
А непонятно, потому что я урезала файл ексель. Откройте скрытые строки файла, там еще 2 щита (их может быть 50).
Ну вот еще..
Если в строке 3 колонка 16 - то есть cell (3,16) есть цифра (номер щита), то массив начинается ВСЕГДА с 3+3 строки, то есть с в данном случае с 6 строки для любых атрибутов данного блока автокад. Для второго щита (а он будет в другом файле автокад), массив начинается с строки 16 (те же  колонки 2 и 3).
Хорошо. А в чем вопрос?
Итак "бежим" по столбцу 16, и проверяем, есть ли в ячейке число - номер щита. если есть, выделяем вниз строки полностью до первой пустой строки.
Ничего мы не выделяем. Мы получаем информации и ее же обрабатываем!
Что значит обрабатываем блок щита:
1. создаем отдельный файл .dwg, с названием например по номеру блока щита "01" в той же папке, что и ексель из шаблона .dwt, в котором уже есть наш блок "Ветка". Ну а как иначе.
2. И вот тут надо копировать копировать наш блок ВЕТКА в автокаде нужное количество раз... 
Лучше бы я этого не читал :)
qaaz07, ты игнорируешь полностью все мои предложения о нормальном формировании задачи!! Я готов тебе помочь, но не в таком режиме.
Мне не хочется снова перечитывать все это и снова ничего не понимать. Поэтому я формулирую задачу за тебя!! А ты смотри и корректируй ее!!!
PS. Кстати, пока я ее формирую, я бы мог тебе уже помочь!!

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #84 : 05-01-2017, 17:52:18 »
Задача от qaaz07 в моей интерпретации:
Есть блок в AutoCAD (см вложение), у которого есть параметр Расстояние1, атрибут МАРКА и в атрибуте ДЛИНА выводится через поле значение Расстояния1:

И есть файл EXCEL (см. вложение):

В этой табличке 3 марки, но их может быть и 50.
Каждой марке соответствует столько вхождений блоков, сколько идет после нее строчек с длиной экземпляра. Координаты первого экземпляра блока указаны в строчке с маркой, далее экземпляры идут с шагом 1000. Марки между собой разделены пустыми строками.
Результатом выполнения программного кода по вышеописанной таблице должно быть следующее (элементы, выделенные красным цветом, носят информативный характер):

Прошу помочь с написанием кода VBA, который делал бы вышеописанное. Заранее, спасибо.(с)qaaz07

qaaz07, скажи, пожалуйста, данная задача отражает суть твоих проблем? Если нет, то в таком же ключе сформулируй свою!
Понимаешь ли ты теперь, что я хотел от тебя, когда приводил сравнение с кирпичом?

Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #85 : 05-01-2017, 18:05:21 »
Расстояние 1 не важно. Можно вообще убрать.

Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #86 : 05-01-2017, 18:16:38 »
Важно скопировать столько раз с приращением 1000, сколько строк в блоке Тестовый1 (например) и при этом занести значения из этих строк в Атрибуты КАБЕЛЬ и ДЛИНА каждой копии блока. Например в колонке 1 будет не Расстояние1, а атрибут ДЛИНА. Н да задачка не из легких.

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #87 : 05-01-2017, 18:23:06 »
Расстояние 1 не важно. Можно вообще убрать.
Да это для наглядности! Не суть!!
Важно скопировать столько раз с приращением 1000, сколько строк в блоке Тестовый1 (например) и при этом занести значения из этих строк в Атрибуты КАБЕЛЬ и ДЛИНА каждой копии блока. Например в колонке 1 будет не Расстояние1, а атрибут ДЛИНА. Н да задачка не из легких.
Слушай, нет здесь кабелей!! Забудь про свои кабели! Понимаешь?
У нас есть атрибут МАРКА, а будет там МАРКА1, КОТЫ, СОБАКИ - это не важно.
Вот у меня такое чувство, что ты напрямую на вопросы не отвечаешь!
Еще раз!
qaaz07, скажи, пожалуйста, данная задача отражает суть твоих проблем? Если нет, то в таком же ключе сформулируй свою!
Понимаешь ли ты теперь, что я хотел от тебя, когда приводил сравнение с кирпичом?
?

Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #88 : 05-01-2017, 18:32:03 »
Ой, да Пардон, не кабели, а МАРКА) Я к сожалению не программист, ну вот надо просто скопировать блок ВЕТКА столько раз, сколько строк в блоке екселя и атрибуты взять из этих строк екселя. Все.

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #89 : 05-01-2017, 18:36:06 »
Я к сожалению не программист
Я тоже не программист!! Но это ж не значит, что я не могу нормально задачу сформировать.
ну вот надо просто скопировать блок ВЕТКА столько раз
У нас нет такого блока.  >:(  :D
Ладно, на сегодня я все. Как появится время, займусь своей/твоей задачей. Возможно, кто-то сможет помочь раньше.

Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #90 : 06-01-2017, 18:51:31 »
Сейчас прочитала на форуме АВОК фразу Алексей Кулик, , "Хорошая постановка задачи - не меньше 70% решения. Если тебе надо разработать средство для решения, к примеру, такого:
"Позволить пользователю многократно вставлять блок, находящийся в библиотеке. Блок в момент вставки динамически отрисовывается рядом с курсором. Атрибуты блоков заполняются автоматически, на основании списка возможных. Библиотека блоков лежит локально, кроме текущего пользователя, к ней никто доступа не имеет"

Вот правда. И задача примерно та же. Решена была с помощью Excel-Lookup2.lsp/
Xотелось бы попробовать решить с помощью VBA.



Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #91 : 06-01-2017, 21:11:29 »
Госспидя, я там уж сто лет не появлялся... :)
Если не использовать .NET / ObjectARX, то чуть ли не единственный способ - использвать команду "_.insert" с ожиданием ввода пользователем точки вставки блока. Ну или, если работа предполагается только в 2D, команды _.change
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #92 : 06-01-2017, 21:33:47 »
Алексей Кулик,
Госспидя, я там уж сто лет не появлялся...
. Мы все помним! :)

"_.insert" - вплне даже прекрасная команда. Она тут подойдет, точка вставки блока - определена неизменно, при этом всё в 2D.
Но вот как позволить пользователю нажать кнопочку в автокаде - и он сам вставляет Х количество блоков, причем Атрибуты этого блока заполняются автоматически, не пойму.

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #93 : 06-01-2017, 21:39:13 »
ThisDrawing.ModelSpace.InsertBlock и далее все параметры вычисляемыми передавать :) И в каждом вхождении вычислять атрибуты и задавать им значения. В принципе ничего сложного не вижу...
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #94 : 07-01-2017, 21:29:46 »
Задача от qaaz07 в моей интерпретации:
Есть блок в AutoCAD (см вложение), у которого есть параметр Расстояние1, атрибут МАРКА и в атрибуте ДЛИНА выводится через поле значение Расстояния1:

И есть файл EXCEL (см. вложение):

В этой табличке 3 марки, но их может быть и 50.
Каждой марке соответствует столько вхождений блоков, сколько идет после нее строчек с длиной экземпляра. Координаты первого экземпляра блока указаны в строчке с маркой, далее экземпляры идут с шагом 1000. Марки между собой разделены пустыми строками.
Результатом выполнения программного кода по вышеописанной таблице должно быть следующее (элементы, выделенные красным цветом, носят информативный характер):

Прошу помочь с написанием кода VBA, который делал бы вышеописанное. Заранее, спасибо.(с)qaaz07
В принципе ничего сложного не вижу...
Согласен на все 100.
Сегодня у меня добрались руки, но времени было не много, поэтому программный код можно/нужно шлифовать, тем не менее, задачка решена.
Извините, вам запрещён просмотр содержимого спойлеров.

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


Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #95 : 08-01-2017, 10:37:56 »
Ну чтож, неплохо!Максим Маркевич, , ты на высоте! Просто великолепно!В этой задаче действительно большой потенциал, и если у тебя в екселе уже есть целая VBA программа по расчету данных, а в автокад нужно перенести в общем то примитивные результаты расчета, то наверное VBA (наш устаревающий VBA) пойдет. Как я рада! :)! (я то даже английский толком не знаю, всю жизнь на руском автокаде), очень здорово, спасибо тебе огромное и дай Бог тебе развивать свой талант!

Оффлайн Владимир Шу

  • ADN Club
  • *****
  • Сообщений: 609
  • Карма: 155
    • ПГСу Бложик
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #96 : 08-01-2017, 20:36:07 »
Максим Маркевич, две пустые строчки прекращаем цикл... по поводу размерности массива, комментировать не буду.
Хотя, все это было не обсуждение видео урока, а решение конкретной задачи qaaz07, обычно это решается в других топиках и разделах.
Грустно, в итоге qaaz07, получила решение своего вопроса, но не получила навыков и знаний. Вот такой вот урок.

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #97 : 08-01-2017, 20:57:33 »
Максим Маркевич, две пустые строчки прекращаем цикл...
Да, можно было..
по поводу размерности массива, комментировать не буду.
Я особо не заморачивался. Честно говоря, сходу не вышло создать динамический массив типа
Код - Visual Basic [Выбрать]
  1. Dim ar() as Integer
и я не вспомнил, как решал подобные вещи, когда писал на VBA, поэтому оставил символическую размерность в 50.
программный код можно/нужно шлифовать
Грустно, в итоге qaaz07, получила решение своего вопроса, но не получила навыков и знаний. Вот такой вот урок.
Я понимаю суть каждого твоего слова. И сам не являюсь сторонником подобной помощи. Я совсем не хотел сделать медвежью услугу! Хотел дать понять, насколько интересные задачи можно решать при помощи VBA в AutoCAD. Возможно, это кого-то окрылит, по крайней мере, я очень на это надеюсь!!
Именно поэтому я попытался продемонстрировать, как нужно правильно формулировать задачи и не брался помогать на примерах от qaaz07.

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #98 : 08-01-2017, 21:54:08 »
я не вспомнил, как решал подобные вещи, когда писал на VBA, поэтому оставил символическую размерность в 50.
ReDim Preserve
не решит задачку? :)
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #99 : 08-01-2017, 23:42:40 »
ReDim Preserve
не решит задачку?
ReDim + Redim Preserve решит задачку. Хотя вариантов, как обыграть ситуацию с размерностью массива, тьма. Примерный алгоритм такой:
1. Задаем динамический массив:
Код - Visual Basic [Выбрать]
  1. Dim ar() As Integer
2. Перед циклом задаем ему размерность:
Код - Visual Basic [Выбрать]
  1. ReDim ar(1)
3. В цикле меняем размерность после каждого "добавления":
Код - Visual Basic [Выбрать]
  1. ReDim Preserve ar(n)
PS. Я бы не заострял на этом внимание в данном примере. Вариантов много. И решение должно формироваться по необходимости. Можно было, вообще, в экселе ввести доп столбец со всей нужной инфой.

Оффлайн Владимир Шу

  • ADN Club
  • *****
  • Сообщений: 609
  • Карма: 155
    • ПГСу Бложик
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #100 : 09-01-2017, 07:15:10 »
Дался вам этот массив, я имел в виду, что в данном случае уместно использовать то, что называется связным списком или применительно к вба, коллекциями... что то типа Dim s As New Collection. Использование массива и реДим там дороговато будет...

Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #101 : 23-01-2017, 18:58:01 »
Максим Маркевич, то есть примерно так? Но вот если я ставлю Option Explicit, то код не работает. Запрашивает i, j, index, но еще и Props =. Это как же его задать? И надо ли.
Насчет дороговато - Владимир Шу, если массив небольшой (а у меня так и есть), вполне пойдет этот вариант.




Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #102 : 23-01-2017, 19:00:29 »
Код - Visual Basic [Выбрать]
  1. Sub InsertBlocksFromExcel()
  2.     Dim AP As Excel.Application
  3.     Dim WB As Excel.Workbook
  4.     Dim ws As Excel.Worksheet
  5.     Dim ar() As Integer
  6.     Dim n As Integer
  7.     Dim blockRef As AcadBlockReference
  8.     Dim name As String
  9.     Dim insertPoint(0 To 2) As Double
  10.              
  11.     Set AP = Excel.Application
  12.     Set WB = AP.Workbooks.Open("E:\Тестовый эксель.xlsx")
  13.     Set ws = WB.Worksheets("Лист1")
  14.    
  15.     n = 0
  16.      ReDim ar(1)
  17.     'Пробегаемся по всем строчкам таблицы
  18.    For i = 2 To 21
  19.         'Если 1й и 2й столбцы пустые то в массив записываем номер следующей строки
  20.        'это и будет строчка с нашими марками
  21.        If Cells(i, 1) = "" And Cells(i, 2) = "" Then
  22.             ar(n) = i + 1
  23.             n = n + 1
  24.             ReDim Preserve ar(n)
  25.         End If
  26.     Next
  27.            
  28.     'Пробегаемся по нашему массиву, в котором лежат номера строк марок
  29.    For i = LBound(ar) To n
  30.         insertPoint(0) = CDbl(Cells(ar(i), 3))
  31.         insertPoint(1) = CDbl(Cells(ar(i), 4))
  32.         insertPoint(2) = CDbl(Cells(ar(i), 5))
  33.                
  34.             'Пробегаемся по всем экземплярам
  35.            For j = ar(i) + 1 To ar(i + 1) - 2
  36.              On Error GoTo ES:
  37.                
  38.                 'Вставляем блок
  39.                Set blockRef = ThisDrawing.ModelSpace.InsertBlock(insertPoint, "Тестовый", 1, 1, 1, 0)
  40.                 insertPoint(0) = insertPoint(0) + 1000#
  41.                
  42.                         'Работа с динамическими свойствами
  43.                        If blockRef.IsDynamicBlock = True Then
  44.                             Props = blockRef.GetDynamicBlockProperties
  45.                             For Index = LBound(Props) To UBound(Props)
  46.                                 Set Prop = Props(Index)
  47.                                     If Prop.PropertyName = "Расстояние1" Then
  48.                                     Prop.Value = Cells(j, 1) * 1
  49.                                     End If
  50.                             Next Index
  51.                         End If
  52.                         'Работа с атрибутами
  53.                        If blockRef.HasAttributes = True Then
  54.                             att = blockRef.GetAttributes
  55.                             For Index = LBound(att) To UBound(att)
  56.                                 Set at = att(Index)
  57.                                     If at.TagString = "МАРКА" Then
  58.                                     at.TextString = CStr(Cells(j, 2))
  59.                                     End If
  60.                             Next Index
  61.                         End If
  62.                        
  63.             Next
  64.     Next
  65.    
  66. 'В случае ошибки попадаем сюда
  67. ES:
  68.     AP.Quit
  69.    
  70. End Sub
  71.  
  72.  
  73.  

Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #103 : 23-01-2017, 19:18:41 »
Максим Маркевич, то есть примерно так? Но вот если я ставлю Option Explicit, то код не работает. Запрашивает i, j, index, но еще и Props =. Это как же его задать?
Вот смотри, что ты делаешь.. Ты ставишь Option Explicit, тем самым запрещаешь VBA самому типизировать переменные, которые не объявлены.
Как раз, в моем коде i, j, index не объявлены.
То есть ты берешь в начале кода и делаешь нечто типа:
Код - Visual Basic [Выбрать]
  1. Dim i As Integer
  2. Dim j As Integer
ну и так далее..
И надо ли.
Ну, видимо, тебе надо. Зачем-то же ты ставишь Option Explicit.

Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #104 : 23-01-2017, 19:48:16 »

Да, но Props = как задать? это же не переменная. то есть я пробовала задать i, j, index, но этого оказалось мало.


Оффлайн Максим Маркевич

  • ADN Club
  • ****
  • Сообщений: 254
  • Карма: 29
  • Skype: evthisrel
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #105 : 23-01-2017, 20:06:41 »
Да, но Props = как задать? это же не переменная. то есть я пробовала задать i, j, index, но этого оказалось мало.
А что это, если не переменная?
Очень легко :)
Вот здесь почитай про типы данных внимательно и все сразу станет ясно. А то ты совсем уже начинаешь бездумно спрашивать. Разбаловал я тебя!  :D

Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #106 : 23-01-2017, 21:25:22 »
Ну чтож, добавила и эти переменные, действительно все сработало. Правда поставила Variant.(а это не очень четко)).
Еще вместо умножения на единицу поставила Cdbl, так будет правильнее.


Оффлайн qaaz07

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #107 : 23-01-2017, 21:28:11 »
Извините, вам запрещён просмотр содержимого спойлеров.

Оффлайн FocusNIK

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #108 : 26-04-2017, 09:41:02 »
Добрый день. Начинаю изучение VBA AutoCAD. Хотел адаптировать Ваш код для своих нужд и столкнулся с проблемой. Не могу получить свойства InsertionPoint (GetConstantAttributes). Хочу проверить ширину атрибута, что бы она не вылезала за рамки, и если вылезает уменьшить масштаб текста.


Оффлайн Владимир П

  • ADN OPEN
  • **
  • Сообщений: 57
  • Карма: 3
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #109 : 26-04-2017, 13:11:40 »
А зачем же Вы исправили строку из примера в предыдущем сообщении
att = blockRef.GetAttributes       ?
надо вернуть как было... вернее, у Вас будет:
att=elem.GetAttributes
а уже получать свойства InsertionPoint (GetConstantAttributes)? (или какие еще) будете внутри цикла

Оффлайн FocusNIK

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #110 : 26-04-2017, 13:34:18 »
А зачем же Вы исправили строку из примера в предыдущем сообщении
att = blockRef.GetAttributes       ?

Я выбираю атрибут постоянный, а это требует записи ".GetConstantAttributes". Но даже в непостоянных атрибутах данная запись выдает ошибку. С обычным текстом проходит. С атрибутом не проходит. Если вы считаете иначе, можете предложить корректировки в коде. Вставлю, покажу результат.

Оффлайн FocusNIK

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #111 : 26-04-2017, 13:38:59 »
Код в работе, поэтому прошу не ругать за мусор.

Извините, вам запрещён просмотр содержимого спойлеров.

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #112 : 26-04-2017, 13:47:43 »
Хочу проверить ширину атрибута, что бы она не вылезала за рамки, и если вылезает уменьшить масштаб текста.
Зачем для такого обращаться к InsertionPoint? Разве нет такого, как GetBoundnigBox? Ну, нечто типа
Код - Visual Basic [Выбрать]
  1.   Dim ent As AcadEntity
  2.   Dim minp As Variant, maxp As Variant, pickpt As Variant
  3.   ThisDrawing.Utility.GetEntity ent, pickpt
  4.   ent.GetBoundingBox minp, maxp
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн FocusNIK

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #113 : 26-04-2017, 14:02:44 »
Зачем для такого обращаться к InsertionPoint? Разве нет такого, как GetBoundnigBox? Ну, нечто типа

Именно такой оператор ничего не выдает. Или я что неправильно понимаю?




Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #114 : 26-04-2017, 14:06:47 »
Посмотри на разницу в определении переменных minp (у тебя LB)
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн FocusNIK

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #115 : 26-04-2017, 14:23:11 »



Большое спасибо. Получилось решить проблему. Буду продолжать изучать ::) ::) ::)

Оффлайн Владимир П

  • ADN OPEN
  • **
  • Сообщений: 57
  • Карма: 3
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #116 : 26-04-2017, 14:46:12 »
Я выбираю атрибут постоянный, а это требует записи ".GetConstantAttributes".   
Но проверку
83.    If elem.HasAttributes = True Then
84.        att = elem.GetConstantAttributes
делаете на ВСЕ атрибуты... а если у Вас постоянных нет в блоке?

Цитировать
Но даже в непостоянных атрибутах данная запись выдает ошибку. С обычным текстом проходит. С атрибутом не проходит.
Непонятно, так на каком месте все-таки происходит ошибка? Какая "данная запись"? В куске где про ConstantAttributes, или там где про "непостоянные"?
Цитировать
Если вы считаете иначе, можете предложить корректировки в коде.    
Я бы предложил убрать совсем кусок со строки 82. до 97., а строки 86, 87, 95 перенес бы в верхний цикл
Делать еще один цикл отдельно по постоянным атрибутам не вижу смысла, если уже есть первый.
А att(i).TagString = "ШИФР" сделать редактируемым, зачем он нужен постоянный?

Оффлайн Владимир П

  • ADN OPEN
  • **
  • Сообщений: 57
  • Карма: 3
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #117 : 26-04-2017, 14:49:47 »
Получилось решить проблему.
А с нами поделиться?

Оффлайн FocusNIK

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #118 : 26-04-2017, 16:31:58 »
Вот что получилось из рабочего, но не оформленного.
" If elem.HasAttributes = True Then" так, что бы можно было блочно скопировать из одного проекта без переписывания блока.
Понимаю, что правильнее переписать в один, но по первости так проще воспринимается.

Ошибку выдавала строка :LB(0)=att(i).InsertionPoint(0
с чем связана незнаю. Не удалось понять

Так же не получилось получить значения .TextAligmentPoint. Тоже ошибка была.


Извините, вам запрещён просмотр содержимого спойлеров.

Оффлайн Владимир П

  • ADN OPEN
  • **
  • Сообщений: 57
  • Карма: 3
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #119 : 26-04-2017, 18:07:05 »
Ошибку выдавала строка :LB(0)=att(i).InsertionPoint(0 с чем связана незнаю. Не удалось понятьТак же не получилось получить значения .TextAligmentPoint. Тоже ошибка была.
1.
GetAttributes Method (ActiveX)
Gets the attributes in the block reference.
RetVal = object.GetAttributes
Return Value (RetVal)
The array of AttributeReference objects.
2.
GetConstantAttributes Method (ActiveX)
Gets the constant attributes in the block or external reference.
RetVal = object.GetConstantAttributes
Return Value (RetVal)
The array of Attribute objects that are constant for the block reference.

При внимательном рассмотрении между двумя этими методами есть различия.
Возвращаемые объекты:
1. AttributeReference objects
и
2. Attribute objects

Оффлайн FocusNIK

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #120 : 26-04-2017, 20:47:10 »
Насколько я понял из этого : http://vbamodel.narod.ru/AutoCAD/idh_insertionpoint.htm
object.InsertionPoint применяется для:  Attribute, AttributeReference, BlockRef, ExternalReference, MInsertBlock, MText, Shape, Text, Tolerance Symbol

У меня не получилось это побороть. Был бы признателен, если приложили пример использования с атрибутами блока. Применил бы в своей практике.
А еще бы не отказался от книги по данному направлению... А то после VBA для Excel был крайне дезориентирован структурированием построения кода.
PS. Я по профессии инженер по вентиляции. Поэтому изучаю по мере возможности и прошу не ругать за глупые вопросы.

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #121 : 26-04-2017, 23:33:32 »
Судя по тому, что я вижу, InsertionPoint есть как для многострочных, так и для однострочных атрибутов (равно как и TextAlignmentPoint).

Кстати, что GetAttributes, что GetConstantAttributes возвращают массив указателей на обычные атрибуты и постоянные атрибуты. Разницы в этом между ними никакой. Для примера (заранее прошу прощения за качество кода - на VBA уже очень давно ничего не писал):
Код - Visual Basic [Выбрать]
  1. Option Explicit
  2.  
  3. Public Sub test()
  4. Dim ent As AcadEntity, blkRef As AcadBlockReference
  5. Dim pt As Variant, arAttr As Variant, arConstAttr As Variant
  6.   ThisDrawing.Utility.GetEntity ent, pt
  7.   If ent.ObjectName = "AcDbBlockReference" Then
  8.     Set blkRef = ent
  9.     arAttr = blkRef.GetAttributes
  10.     arConstAttr = blkRef.GetConstantAttributes
  11.   End If
  12. End Sub
Пошаговая отладка многое покажет :)
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Владимир П

  • ADN OPEN
  • **
  • Сообщений: 57
  • Карма: 3
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #122 : 27-04-2017, 07:47:43 »
если приложили пример использования с атрибутами блока
Ну, вот если из моего примера, то вот так заработало
Код - Visual Basic [Выбрать]
  1. '    Dim att As Variant
  2.    Dim att As AcadAttributeReference
  3.     Dim LB(0 To 2) As Double
  4.     Dim blokObj As AcadBlockReference
  5.     Set blokObj = elem
  6.     Dim varAttributes As Variant
  7.     ' Получение атрибутов
  8.    If blokObj.HasAttributes = True Then
  9.         varAttributes = blokObj.GetAttributes
  10. '        varAttributes = blokObj.GetConstantAttributes
  11.        For i = LBound(varAttributes) To UBound(varAttributes)
  12.             Set att = varAttributes(i)
  13.             If att.TagString = "ШИФР" Then
  14.                  LB(0) = att.InsertionPoint(0)
  15.                 MsgBox (LB(0))
  16.             End If
  17.         Next
  18.     End If
  19.  
Но! в вашем изначальном блоке я исправил с свойствах атрибута постоянный на "НЕТ".
Вам конечно виднее, но уверен, что постоянный не нужен. Сам решал эту задачку со штампом давненько и как-то обошелся без GetConstantAttributes.
Больше того, если тупо заменить
       
Код - Visual Basic [Выбрать]
  1. varAttributes = blokObj.GetAttributes
на
'       
Код - Visual Basic [Выбрать]
  1. varAttributes = blokObj.GetConstantAttributes
возникнет ошибка связанная с тем, что все-таки Attribute и AttributeReference - разные вещи.
Можно конечно переделать все объявления правильно и наверное заработает и с GetConstantAttributes, но... зачем?


« Последнее редактирование: 27-04-2017, 21:02:16 от Александр Ривилис »

Оффлайн wavaw

  • ADN OPEN
  • Сообщений: 21
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #123 : 10-05-2017, 18:17:33 »
здравствуйте.
код со второго урока ошибку выдаёт :"user-defined type not defined"
сам код -

   
Код - Visual Basic [Выбрать]
  1.  Dim AP As Excel.Application
  2.     Dim WB As Excel.Workbook
  3.     Dim WS As Excel.Worksheet
  4.     Dim pp As Variant
с первой же строчки ошибка

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #124 : 10-05-2017, 18:46:31 »
wavaw
Библиотека Microsoft Excel подключена?



Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн wavaw

  • ADN OPEN
  • Сообщений: 21
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #125 : 21-05-2017, 11:16:52 »
да, действительно галочка "слетела".

Оффлайн AskarZ

  • ADN OPEN
  • Сообщений: 6
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #126 : 28-05-2017, 21:03:32 »
Здравствуйте! Спасибо Вам за прекрасный макрос печати. Использую код из 14 урока. Поменял принтер на PDFCreator. Появилась проблема, он не печатает А0, А1, А2 и не стандартные форматы (типа А4х3), с др. форматами нормально.

Извините, вам запрещён просмотр содержимого спойлеров.


Что нужно изменить? Спасибо

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #127 : 28-05-2017, 21:27:34 »
Что нужно изменить? Спасибо
Изменить нужно видимо строку:
Код - Visual Basic [Выбрать]
  1. Layout.CanonicalMediaName = "A1"
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн AskarZ

  • ADN OPEN
  • Сообщений: 6
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #128 : 28-05-2017, 21:57:27 »
Изменить нужно видимо строку:
VBA я толком незнаю, а на что конкретней нужно поменять? Спасибо

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #129 : 28-05-2017, 21:59:43 »
VBA я толком незнаю, а на что конкретней нужно поменять? Спасибо
Тут не вопрос знания VBA, а вопрос знания того, какое каноническое имя для PDFCreator для локального имени "A1". Вот на это имя и нужно поменять.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн AskarZ

  • ADN OPEN
  • Сообщений: 6
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #130 : 28-05-2017, 22:07:24 »
Тут не вопрос знания VBA, а вопрос знания того, какое каноническое имя для PDFCreator для локального имени "A1". Вот на это имя и нужно поменять.
Спасибо, буду разбираться

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #131 : 28-05-2017, 22:17:56 »
Обрати внимание на эту картинку:



Возможно еще зависит и от версии PDFCreator и/или версии AutoCAD.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #132 : 28-05-2017, 23:04:09 »
Я немного поигрался и сделал такой код:
Код - Visual Basic [Выбрать]
  1. '1. Печать в пдф при помощи выбора нижней левой и верхней правой точек
  2. Sub PlotByPoints()
  3.     ' Декларируем
  4.    Dim Layout As AcadLayout
  5.     Dim pt1 As Variant, pt2 As Variant
  6.    
  7.     ' Устанавливаем
  8.    Set Layout = ThisDrawing.ActiveLayout
  9.    
  10.     ' Получаем первую точку рамки
  11.    pt1 = ThisDrawing.Utility.GetPoint(, "Выберите нижний левый угол")
  12.     ' Переводим координаты из WCS в DCS
  13.    pt1 = ThisDrawing.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  14.     ReDim Preserve pt1(0 To 1)   ' Приводим массив к 2д виду, удаляем z координату
  15.    
  16.     ' Получаем вторую точку
  17.    pt2 = ThisDrawing.Utility.GetPoint(, "Выберите правый верхний угол")
  18.     ' Переводим координаты из WCS в DCS
  19.    pt2 = ThisDrawing.Utility.TranslateCoordinates(pt2, acWorld, acDisplayDCS, False)
  20.     ReDim Preserve pt2(0 To 1)   ' Приводим массив к 2д виду, удаляем z координату
  21.        
  22.     ' Настройка печати
  23.    Layout.ConfigName = "PDFCreator"
  24.    
  25.     ' Обновим текущую плот-информацию
  26.    Layout.RefreshPlotDeviceInfo
  27.    
  28.     ' Печатаем на формат A0
  29.    Layout.CanonicalMediaName = GetCanonicalFromLocalName(Layout, "A0")
  30.    
  31.     Layout.CenterPlot = True
  32.     Layout.PlotRotation = ac90degrees
  33.     Layout.StandardScale = acScaleToFit
  34.     Layout.StyleSheet = "acad.ctb"
  35.    
  36.     ' Устанавливаем рамки окошка
  37.    Layout.SetWindowToPlot pt1, pt2
  38.     Layout.PlotType = acWindow
  39.    
  40.     ' Отправляем на печать
  41.    ThisDrawing.Regen acAllViewports
  42.     ThisDrawing.Plot.PlotToDevice
  43.    
  44. End Sub
  45. ' Функция преобразует из локального имени в каноническое
  46. Function GetCanonicalFromLocalName(Layout As AcadLayout, lName As String) As String
  47.     Dim cNames As Variant
  48.     cNames = Layout.GetCanonicalMediaNames()
  49.     Dim cName As String
  50.     cName = Layout.CanonicalMediaName
  51.     For i = LBound(cNames) To UBound(cNames)
  52.       sName = Layout.GetLocaleMediaName(cNames(i))
  53.       If lName = sName Then
  54.         cName = cNames(i)
  55.         Exit For
  56.       End If
  57.     Next
  58.     GetCanonicalFromLocalName = cName
  59. End Function
Должен работать в принципе для любого принтера.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн AskarZ

  • ADN OPEN
  • Сообщений: 6
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #133 : 01-06-2017, 17:13:32 »
Александр Ривилис , спасибо Вам большое за помощь!!! Все работает как хотел :)

Оффлайн wavaw

  • ADN OPEN
  • Сообщений: 21
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #134 : 02-06-2017, 13:18:51 »
а у меня возникла проблема с уроком "пакетная печать". если печатать построчно через f8 и ждать когда распечатается каждый лист, то все получается. если запустить скрипт на авто выполнение, то печатается только первый лист.
на сколько я понимаю, это происходит от того, что первый лист начинает печататься "в фоне" и последующие задания на печать акад в таком случае игнорирует.
введение в код строчки
Код - Visual Basic [Выбрать]
  1. backgroundplot = 0
не решило проблему

сам код полностью:
Код - Visual Basic [Выбрать]
  1. ' 3. Batch printing of specific blocks-formats
  2. Sub PlotByBlocks()
  3.  
  4.     Dim objEnt As AcadEntity
  5.     Dim objBRef As AcadBlockReference
  6.     Dim pt1 As Variant
  7.     Dim pt2(0 To 1) As Double
  8.     Dim i As Integer
  9.    
  10.     Dim arr() As AcadEntity
  11.     Dim arr2() As AcadEntity
  12.  
  13.     ' Create a selection with a frame
  14.    
  15.     On Error Resume Next
  16.  
  17.     ThisDrawing.SelectionSets("SS").Delete
  18.     Set ss = ThisDrawing.SelectionSets.Add("SS")
  19.     ss.SelectOnScreen
  20.    
  21.     i = 0
  22.     For Each objEnt In ss
  23.         ReDim Preserve arr(i)
  24.         Set arr(i) = objEnt
  25.         i = i + 1
  26.     Next
  27.    
  28.     k = 0
  29.     For i = LBound(arr) To UBound(arr)
  30.        If arr(i).Layer = "Vramka" Then
  31.             ReDim Preserve arr2(k)
  32.             Set arr2(k) = arr(i)
  33.             k = k + 1
  34.        End If
  35.     Next
  36.  
  37. ' We work if the name of the A1 block
  38.    k = 0
  39.     For i = LBound(arr2) To UBound(arr2)
  40.         BlockProp = arr2(i).GetDynamicBlockProperties
  41.         If arr2(i).EffectiveName = "Mega Ramka" And BlockProp(4).Value = "A3-a" Then
  42.             pt1 = arr2(i).InsertionPoint
  43.             pt1 = ThisDrawing.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  44.             ReDim Preserve pt1(0 To 1)
  45.             pt2(0) = pt1(0) + 420 * MyScale
  46.             pt2(1) = pt1(1) + 297 * MyScale
  47.             k = k + 1
  48.             PolyPlot "c:\Users\wavaw\Desktop\А3_" + CStr(k), pt1, pt2
  49.         End If
  50.     Next
  51.    
  52. End Sub
  53. Sub PolyPlot(strFileName As String, pt1 As Variant, pt2 As Variant)
  54.  
  55.     ' Декларируем
  56.    Dim Layout As AcadLayout
  57.          
  58.     ' Устанавливаем
  59.    Set Layout = ThisDrawing.ActiveLayout
  60.        
  61.     Layout.RefreshPlotDeviceInfo
  62.            
  63.     ' Print Settings
  64.    'backgroundplot = 0
  65.    Layout.ConfigName = "DWG to PDF.pc3"
  66.     Layout.CanonicalMediaName = "ISO_full_bleed_A3_(420.00_x_297.00_MM)"
  67.     Layout.CenterPlot = True
  68.     Layout.PlotRotation = ac0degrees
  69.     Layout.StandardScale = acScaleToFit
  70.     Layout.StyleSheet = "monochrome.ctb"
  71.    
  72.     ' We set the frame and type of window
  73.    Layout.SetWindowToPlot pt1, pt2
  74.     Layout.PlotType = acWindow
  75.    
  76.     ' We send to the press
  77.    ThisDrawing.Regen acAllViewports
  78.     ThisDrawing.Plot.PlotToFile strFileName
  79.        
  80. End Sub

Оффлайн Khasan Mamaev

  • ADN Club
  • Сообщений: 44
  • Карма: 7
    • Конструктивный диалог
  • Skype: wolfram222
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #135 : 04-06-2017, 13:16:54 »
Приветствую друзья! Пишу скрипт для печати списка листов, код такой:
objPlot.SetLayoutsToPlot(layNames)
objPlot.PlotToDevice('Adobe PDF')

для каждого листа открывается окошко и нужно вручную нажимать кнопку "Сохранить". Возможно ли исключить эту ручную операцию?

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #136 : 04-06-2017, 13:21:34 »
введение в код строчки
Код - Visual Basic [Выбрать]

    backgroundplot = 0

не решило проблему
И не должно было. Проблему должно было бы решить вот это:

Код - Visual Basic [Выбрать]
  1. ThisDrawing.SetVariable "backgroundplot", 0
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #137 : 04-06-2017, 13:24:08 »
для каждого листа открывается окошко и нужно вручную нажимать кнопку "Сохранить".
Какое окошко? С запросом сохранения чертежа? Тогда сохрани его сам до запуска печати.
Код - Visual Basic [Выбрать]
  1. ThisDrawing.Save
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Khasan Mamaev

  • ADN Club
  • Сообщений: 44
  • Карма: 7
    • Конструктивный диалог
  • Skype: wolfram222
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #138 : 04-06-2017, 13:25:50 »
Какое окошко? С запросом сохранения чертежа? Тогда сохрани его сам до запуска печати.
Код - Visual Basic [Выбрать]
Сохранять печатаемый pdf файл

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #139 : 04-06-2017, 13:29:48 »
Сохранять печатаемый pdf файл
А вот это сообщение вряд ли можно убрать - его выдаёт драйвер печати. Если конечно это не сообщение о том, что такой файл уже существует. В этом случае его достаточно удалить до печати.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Khasan Mamaev

  • ADN Club
  • Сообщений: 44
  • Карма: 7
    • Конструктивный диалог
  • Skype: wolfram222
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #140 : 04-06-2017, 17:24:15 »
Сохранять печатаемый pdf файл
А вот это сообщение вряд ли можно убрать - его выдаёт драйвер печати. Если конечно это не сообщение о том, что такой файл уже существует. В этом случае его достаточно удалить до печати.
задача решается редактированием реестра https://stackoverflow.com/questions/2075104/bypass-adobe-pdf-printer-savefileas-prompt

Оффлайн AskarZ

  • ADN OPEN
  • Сообщений: 6
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #141 : 16-06-2017, 22:46:36 »
Здравствуйте! Еще раз хочу попросить о помощи. Имеется код по пакетной печати:

Извините, вам запрещён просмотр содержимого спойлеров.

В чертежах форматы листов разные (A4, A3, A2x4 и тд), рамки форматов у меня из дин. блока с выбором размера формата. Что нужно прописать вместо EffectiveName = "A1", чтобы указывалось не имя блока, а значение выбора. Спасибо за помощь!

Оффлайн Владимир Шу

  • ADN Club
  • *****
  • Сообщений: 609
  • Карма: 155
    • ПГСу Бложик
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #142 : 17-06-2017, 11:06:47 »
В чертежах форматы листов разные (A4, A3, A2x4 и тд), рамки форматов у меня из дин. блока с выбором размера формата. Что нужно прописать вместо EffectiveName = "A1", чтобы указывалось не имя блока, а значение выбора.

Т.к. вопрос абстрактный, то и ответ будет таким же.
Можно открыть справку по VBA и посмотреть раздел посвященный объекту BlockReference (ActiveX), с удивлением обнаружить там свойство IsDynamicBlock (ActiveX) и метод GetDynamicBlockProperties (ActiveX) и поработать с ними.

З.Ы.
Хотя я так и не понял, каким образом Ваш вопрос соотносится с темой обсуждения видеоуроков, т.к. очевидно, что Вы решаете какие то свои задачи.

Оффлайн AskarZ

  • ADN OPEN
  • Сообщений: 6
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #143 : 17-06-2017, 11:44:34 »
Владимир Шу, Код взят из 16-ого видео урока по пакетной печати. Спасибо за наводку про метод GetDynamicBlockProperties.  Нашел на др. форуме такой вот код:

Извините, вам запрещён просмотр содержимого спойлеров.

Но так как я незнаю vba, я не могу привязать этот код в свой.


« Последнее редактирование: 17-06-2017, 13:08:11 от AskarZ »

Оффлайн Владимир Шу

  • ADN Club
  • *****
  • Сообщений: 609
  • Карма: 155
    • ПГСу Бложик
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #144 : 17-06-2017, 12:59:18 »
16 урок посвящен пакетной печати, работа с дин. блоками приведена в 17 уроке. Нда...

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #145 : 17-06-2017, 13:21:36 »
Но так как я незнаю vba, я не могу привязать этот код в свой.
Так дело не пойдёт. Если не знаешь VBA, то изучи его.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн wavaw

  • ADN OPEN
  • Сообщений: 21
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #146 : 19-06-2017, 12:02:21 »
AskarZ, как один из вариантов "подгона для себя" можете мой код глянуть. тоже из 16 урока переделывал и с общей помощью "допилил" до работающего варианта.

Извините, вам запрещён просмотр содержимого спойлеров.

Оффлайн moland

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #147 : 09-10-2017, 16:34:04 »
Здравствуйте. Подскажите пож-та как лучше всего делать параметрические чертежи. Но данные брать из экселя.
Вообще подскажите как быстрее всего чертить однотипные чертежи но с разными размерами.
Как  скажем построить треугольник по 2 сторонам и углу между ними посредство VBA. Есть ли в видеоуроках такое. Это будет VBA  или автокад позволяет брать данные из внешних файлов.
В примере меняем размер d1 перестраивается весь чертеж.

Оффлайн Владимир Шу

  • ADN Club
  • *****
  • Сообщений: 609
  • Карма: 155
    • ПГСу Бложик
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #148 : 09-10-2017, 16:43:39 »
Вообще подскажите как быстрее всего чертить однотипные чертежи но с разными размерами.
Использовать динамические блоки.
Как  скажем построить треугольник по 2 сторонам и углу между ними посредство VBA.
Вспомнить школьные уроки по тригонометрии и по векторной алгебре.
Есть ли в видеоуроках такое.
Посмотрите уроки...
Это будет VBA  или автокад позволяет брать данные из внешних файлов.
Вообще не понятно про что это предложение.

Оффлайн moland

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #149 : 09-10-2017, 19:31:33 »
 ОК СПАСИБО.  ПЕРЕИНАЧУ ВОПРОС.  НАЗОВИТЕ САМЫЙ БЫСТРЫЙ СПОСОБ ВЫВОДА НА ЭКРАн 12ти угольника.  Есть таблица в экселе с 100 видами 12 ти угольников.  Стороны 12ти угольников рассчитываются.   Может можно и без экселя обойтись.  Подскажите как,  дайте направление. 

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #150 : 09-10-2017, 19:33:07 »
Есть таблица в экселе с 100 видами 12 ти угольников
Таблица в каком виде?
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #151 : 09-10-2017, 20:14:01 »
Создать анонимный блок
Создавать все элементы внутри этого блока
Вставить блок
Разбить вхождение
Удалить вхождение

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

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн moland

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #152 : 10-10-2017, 00:02:34 »
Таблица в каком виде?
В каждой строке находятся все размеры (длины)
1.Меня интересует можно ли в автокаде создать некое подобие библиотеки как в Компасе. т.е.выбрал нужную строку - фигура построилась.
2. Можно ли это делать с помощью VBA. Может есть у кого простой код как подгружая данные их экселя при помощи VBA построить любую фигуру например прямоугольник.

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #153 : 10-10-2017, 00:09:59 »
В каждой строке находятся все размеры (длины)
Я сомневаюсь, что 12-угольник можно построить только по длинам.
1.Меня интересует можно ли в автокаде создать некое подобие библиотеки как в Компасе. т.е.выбрал нужную строку - фигура построилась.
Я не знаю что такое в Компасе библиотека. В AutoCAD есть палитры инструментов. В них в частности можно добавлять блоки. Похоже следует начать с изучения AutoCAD, а потом уже пытаться под него программировать. Причем не пытаться дело так, как это сделано в других CAD-системах. У AutoCAD есть своя логика и идеология работы.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #154 : 10-10-2017, 00:23:57 »
при помощи VBA построить любую фигуру например прямоугольник.
Отлично. Как прямоугольник ориентирован? Строится в текущей системе координат или в мировой? Какие у него вообще должны быть параметры? Построение идет по 2 или по 3 точкам?
И подобных вопросов может быть тьма. Советую прислушаться к тому, что говорит Александр.
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн moland

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #155 : 10-10-2017, 00:29:50 »
12-ти угольник это пример.

ОК. Мне нужно построть квадрат, но данные о стороне брать извне. Это самая простая задача которую можно представить. Как мне это сделать посредством VBA. В видеоуроках есть что выводится msgbox со сторонами блока, взятыми из экселя или маткада (правда тоже через эксель в итоге). А мне нужно построить блок, взяв размеры извне. Помогите. Мне кажется этой очень простой задачей. дальше я сам разберусь.
как угодно ориентирован. просто чтобы он в итоге строился. Примеров по VBa для автокада не так много в Интернете. Самый простой случай. Хочу чтобы построился квадрат по ширине взятой извне.

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 1093
  • Карма: 172
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #156 : 10-10-2017, 00:36:23 »
Ок, повторю: система координат? Угол поворота? Откуда брать точки построения?
Если все эти данные есть, то самое простое будет (расписываю алгоритм, поскольку установленного VBA Enabler нет и ставить как-то у меня нет желания ;)):
1. Объявить пользовательский тип данных, в котором хранить координаты точки вставки, угол поворота и нормаль будущего прямоугольника / многоугольника / блока
2. Объявить массив этого пользовательского типа данных (или коллекцию - что больше нравится)
3. Открыть файл Excel (или любой другой источник данных) и прочитать данные, постоянно дополняя массив / коллекцию
4. Проходя по каждому элементу массива / коллекции, выполнять построение соответствующих примитивов.

Как-то так, я думаю.
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #157 : 10-10-2017, 00:37:15 »
Мне нужно построть квадрат, но данные о стороне брать извне.
А мне нужно построить блок, взяв размеры извне.
Определись что  тебе нужно. Квадрат в AutoCAD можно построить десятком разных способов. Это и четыре отрезка, и замкнутая полилиния с 4-мы сегментами, и 3DFACE, и SOLID и т.д. и т.п.
Блок - это блок. Я бы хотел бы чтобы мы разговаривали на одном языке. И этот язык был бы языком терминов AutoCAD.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн moland

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #158 : 10-10-2017, 00:55:40 »
ОК. в принципе все понятно. Буду признателен. если сбросите код VBA или ссылку на него, который ХОТЬ ЧТО НИБУДЬ СТРОИТ. Отрезок, два отрезка, окружность, полилинию, дугу, редуктор в сборе.
 Начало координат самое что ни на есть любое. Направдение тоже.
Я просто хочу посмотреть на любой код или ссылку на него который ЧТО_НИБУДЬ СТРОИТ. А вы мне в ответ 10 вопросов, а какого цвета линии, а начало координат, а плоскости, а толщина линий., а по скольки -точкам. Я исхожу из того что если смогу построить 1 линию смогу построить все.

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #159 : 10-10-2017, 00:58:34 »
Буду признателен. если сбросите код VBA или ссылку на него, который ХОТЬ ЧТО НИБУДЬ СТРОИТ
Вот это строит квадрат при помощи облегченной полилинии. Запрашивается левый нижний угол и высота квадрата:
Код - Visual Basic [Выбрать]
  1. Sub Add_Sqr()
  2.    
  3.     Dim returnPnt As Variant
  4.     returnPnt = ThisDrawing.Utility.GetPoint(, "Укажите левый нижний угол квадрата: ")
  5.     Dim basePnt(0 To 2) As Double
  6.     basePnt(0) = returnPnt(0): basePnt(1) = returnPnt(1): basePnt(2) = returnPnt(2)
  7.    
  8.     Dim returnDist As Double
  9.     returnDist = ThisDrawing.Utility.GetDistance(basePnt, "Укажите высоту квадрата: ")
  10.  
  11.     Dim plineObj As AcadLWPolyline
  12.     Dim points(0 To 7) As Double
  13.    
  14.     points(0) = basePnt(0): points(1) = basePnt(1)
  15.     points(2) = basePnt(0): points(3) = basePnt(1) + returnDist
  16.     points(4) = basePnt(0) + returnDist: points(5) = basePnt(1) + returnDist
  17.     points(6) = basePnt(0) + returnDist: points(7) = basePnt(1)
  18.  
  19.     Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
  20.     plineObj.Closed = True
  21.    
  22.     ZoomExtents
  23.    
  24.    
  25. End Sub
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Пашин Евгений

  • ADN PRO
  • *
  • Сообщений: 662
  • Карма: 12
  • Skype: pashin.evgeniy
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #160 : 10-10-2017, 06:47:14 »
Упс, тут уже есть ответ.

Оффлайн moland

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #161 : 10-10-2017, 09:05:55 »
ОК. Спасибо.
То что нужно.
И теперь главный вопрос ради чего я это начал.
У нас на заводе изготавливают отводы секторные из труб. Их большое кол-во. Разные диаметры, длины плеч (сами плечи в одном отводе могут быть разными, углы до 90 градусов (45,46,78.5, и т.д) т.е ассортимент большой. Я геометрически их раасчитал в экселе и с помощью VBA написал программу. Через параметризацию в автокаде я добился нужного результата, но там нужно все параметры (около 10 шт) каждый раз вводить заново и чертеж тогда перестраивается как нужно и это работает.
1.А мне хотелось бы чтобы можно было выбирать из списка что-ли. Можно ли так сделать в автокаде. Или я вообще не понимаю философию автокада.
2. И еще вопрос можно ли строить эти отводы подгружая информацию через эксель. В экселе то у меня все рассчитано.
3. Эту задачу можно ли решить через VBA? Я несмотря на свои 10 вопросов не получил ответ можно ли имея в экселе в ячейке а1 число 10 и запустив соответствующий макрос добиться построения квадрата в любой области чертежа со стороной 10 мм. Я вообще не нашел информации (кода) чтобы так делали. Может так просто не делают в автокаде?




У меня вопрос к специалистам как бы вы реализовали это задачу, просто направление (через VBA. через параметризацию. еще как-нибудь может).

Оффлайн trir

  • ADN Club
  • ****
  • Сообщений: 470
  • Карма: 63
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #162 : 10-10-2017, 09:07:36 »
Можно, реализовал бы на dotNET без Excel'я

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #163 : 10-10-2017, 09:09:53 »
Я несмотря на свои 10 вопросов не получил ответ можно ли имея в экселе в ячейке а1 число 10 и запустив соответствующий макрос добиться построения квадрата в любой области чертежа со стороной 10 мм.
Ты уроки вообще-то посмотрел? Видеоуроки AutoCAD VBA
Там про получение информации из Excel и построение по полученным данным.
На вопрос отвечаю - можно. Всё что для этого нужно есть в моём коде и уроках. Дерзай!
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн moland

  • ADN OPEN
  • Сообщений: 7
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #164 : 10-10-2017, 09:21:08 »
ОК. Спасибо. Для начала хватит инфы

Оффлайн Dimaill

  • ADN OPEN
  • Сообщений: 4
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #165 : 20-04-2018, 12:04:53 »
Добрый день!

Подскажите пожалуйста по моей проблеме:
Посмотрел видео урок "16. AutoCAD VBA. Пакетная печать блоков-форматов"
Скопировал себе код, создал блок для печати. Названия блоков в коде VBA и самом блоке совпадают. Параметры печати проверил-совпадают.
Ничего более не менял в коде, запускаю, выбираю рамкой блоки для печати (более 1 блока).
В результате на печать выводится 1 лист pdf.
В чем может быть проблема?
(Даже пробовал делать все как у автора: те же названия блоков, места для печати и т.д.) Итог один-печатается только 1 блок.

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #166 : 20-04-2018, 12:18:10 »
В результате на печать выводится 1 лист pdf.
Посмотрел код - он должен формировать столько pdf-файлов (не листов в файле, а именно файлов), сколько выбрано блоков с правильным именем.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Dimaill

  • ADN OPEN
  • Сообщений: 4
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #167 : 20-04-2018, 12:23:55 »
Все верно, должно напечататься столько файлов pdf сколько выбрано блоков с именем указанном в коде. Так вот я выбираю например 3 блока, печатается 1 файл. И сколько бы я не выбрал одинаковых блоков- печатается только 1.

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #168 : 20-04-2018, 15:20:54 »
Все верно, должно напечататься столько файлов pdf сколько выбрано блоков с именем указанном в коде. Так вот я выбираю например 3 блока, печатается 1 файл. И сколько бы я не выбрал одинаковых блоков- печатается только 1.
Запусти под отладчиком и посмотри что происходит. Подозреваю, что у тебя BACKGROUNDPLOT не установлена в 0: https://knowledge.autodesk.com/ru/support/autocad/learn-explore/caas/CloudHelp/cloudhelp/2017/RUS/AutoCAD-Core/files/GUID-713029B7-B5AC-4860-BE2E-74878D418EA4-htm.html
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Dimaill

  • ADN OPEN
  • Сообщений: 4
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #169 : 20-04-2018, 15:32:07 »
Помогло, спасибо Вам) Печатает как сумасшедший)

Оффлайн Dimaill

  • ADN OPEN
  • Сообщений: 4
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #170 : 20-04-2018, 16:50:47 »
Подскажите пожалуйста.
Хочу присвоить имени листа атрибут блока, чтобы как то идентифицировать напечатанное. Что я делаю не так? Только не пинайте сильно. Я не разбираюсь в VBA. Все происходит наощупь (пытаюсь разобраться)

Код - Visual Basic [Выбрать]
  1. ' 3. Печать заданных блоков в пдф
  2. Sub PlotByBlocks()
  3.  
  4.     Dim objEnt As AcadEntity
  5.     Dim objBRef As AcadBlockReference
  6.     Dim blockRef As AcadBlockReference
  7.     Dim pt1 As Variant
  8.     Dim pt2(0 To 1) As Double
  9.     Dim i As Integer
  10.    
  11.     ' Создаем выбор рамкой
  12.    On Error Resume Next
  13.     ThisDrawing.SelectionSets("SS").Delete
  14.     Set ss = ThisDrawing.SelectionSets.Add("SS")
  15.     ss.SelectOnScreen
  16.    
  17.     ' Работаем, если имя блока А1
  18.    For Each objEnt In ss
  19.     If objEnt.ObjectName = "AcDbBlockReference" Then
  20.     Set objBRef = objEnt
  21.         If objBRef.EffectiveName = "_ЛИСТ" Then
  22.             pt1 = objBRef.InsertionPoint
  23.             pt1 = ThisDrawing.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  24.             ReDim Preserve pt1(0 To 1)
  25.             pt2(0) = pt1(0) + 841
  26.             pt2(1) = pt1(1) + 594
  27.         End If
  28.         att = blockRef.GetAttributes
  29.                      For i = LBound(att) To UBound(att)
  30.                          If att(i).TagString = "№" Then
  31.                          PolyPlot "C:\Users\dilyasov\Desktop\PDF\Лист" + CStr(att(№)), pt1, pt2
  32.                          End If
  33.                      Next
  34.      End If
  35.      Next
  36.    
  37. End Sub
  38.  
« Последнее редактирование: 20-04-2018, 17:31:05 от Александр Ривилис »

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #171 : 20-04-2018, 17:32:15 »
Dimaill
Прочитай у меня в подписи по поводу форматирования кода на нашем форуме и соблюдай это правило!
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #172 : 20-04-2018, 17:38:00 »
Не проверял, но думаю, что вместо:
Код - Visual Basic [Выбрать]
  1.   PolyPlot "C:\Users\dilyasov\Desktop\PDF\Лист" + CStr(att(№)), pt1, pt2
должно быть:
Код - Visual Basic [Выбрать]
  1.   PolyPlot "C:\Users\dilyasov\Desktop\PDF\Лист" + CStr(att(i).TextString), pt1, pt2
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн serega374

  • ADN OPEN
  • Сообщений: 41
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #173 : 08-07-2018, 06:17:43 »
Добрый день! А как проверить что ячейка Exel пустая? пробовал "" и 0 не помогает. В Excel VBA есть  метод isEmpty(). Но в автокаде он не работает
Код - Visual Basic [Выбрать]
  1. For NumRowsExel = 1 To 100 ' цикл в котором определяю начальную строку таблицы АФУ
  2. dataString = Cells(NumRowsExel, NumColumnExel) ' переменная в которой храню значение текущей ячейки, NumColumnExel=1
  3. If dataString = "Сектора" Then ' проверяю ключевое слово "Сектора" - начало таблицы АФУ
  4. RowsBeginTableAFU = NumRowsExel ' номер строки начала таблицы АФУ
  5. End If
  6. Next
  7.  
  8. For NumRowsExel = RowsBeginTableAFU To 100 ' цикл в котором определяю конечную строку таблицы АФУ
  9. dataString = Cells(RowsBeginTableAFU, NumColumnExel) ' переменная в которой храню значение текущей ячейки, NumColumnExel=1
  10. If dataString = "" Then ' проверяю пуста ли ячейка, если да
  11. RowsEndTableAFU = NumRowsExel - 1 ' вычисляю номер строки конца таблицы АФУ
  12. GoTo 1 ' и выхожу за пределы цикла
  13. End If
  14. Next
  15.  
  16. 1
  17. NumRowsTable_AFU = RowsEndTableAFU - RowsBeginTableAFU ' вычисляю число строк таблицы АФУ
  18. NumColumnTable_AFU = 1 ' число столбцов
  19. Set New_Table_AFU = ThisDrawing.ModelSpace.AddTable(BasePointTable, NumRowsTable_AFU, NumColumnTable_AFU, 50, 50) ' вставляю таблицу
  20. End Sub
  21.  

И каким образом заполнить вставленную  таблицу в автокаде значениями из exel, не могу найти метод

Оффлайн serega374

  • ADN OPEN
  • Сообщений: 41
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #174 : 08-07-2018, 07:18:28 »
метод isEmpty(). Но в автокаде он не работает
Извините работает
Код - Visual Basic [Выбрать]
  1. x = RowsBeginTableAFU ' номер строки начала таблицы
  2. Do While IsEmpty(Cells(x, NumColumnExel)) = False ' пока не пуста
  3. x = x + 1' увеличиваем
  4. Loop
  5. RowsEndTableAFU = x ' если пуста записываем предыдущее х как номер строки конца таблицы АФУ
  6. NumRowsTable_AFU = RowsEndTableAFU - RowsBeginTableAFU ' вычисляю число строк таблицы АФУ

Оффлайн vsb

  • ADN OPEN
  • Сообщений: 2
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #175 : 17-08-2018, 06:57:54 »
Здравствуйте!
Изучив уроки, написал небольшую программку по выводу чертежей из модели в pdf файлы. Большое спасибо автору. Решил добавить возможность настройки способа вывода и качества из секции "ВЭкраны с раскрашиванием" окна вывода на Печать из Модели. Но не смог найти какие системные переменные или свойства объектов возможно использовать для реализации этой задачи. Прошу подсказать каким образом можно это сделать или где почитать об этом. Извините за возможное неправильное использование терминов, так как уровень в программировании начальный. Система Windows 8.1, Autocad 2012.

Оффлайн Вильдар

  • ADN Club
  • ****
  • Сообщений: 405
  • Карма: 77
  • Skype: vildar82
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #176 : 17-08-2018, 08:05:32 »
Про визуальный стиль:
у объекта видового экрана (ViewportTableRecord) есть свойство визуальный стиль VisualStyleId (DBVisualStyle), а у него есть Type.
Вроде это оно.

Оффлайн vsb

  • ADN OPEN
  • Сообщений: 2
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #177 : 17-08-2018, 10:36:52 »
Большое спасибо, будем разбираться.
 :)

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #178 : 18-01-2021, 16:34:43 »
Код - Visual Basic [Выбрать]
  1. Sub PlotByBlocks() 'Tools -> References-> подключить библиотеку AutoCAD 20XX Type Library
  2. On Error Resume Next
  3. Dim acadApp As AcadApplication
  4. Dim acadDoc As AcadDocument
  5. Dim n As Integer ' ДОБАВИЛ 2
  6. With Sheets("!")
  7. .Activate
  8. n = .Range("B" & 1).Value ' ДОБАВИЛ 2
  9. End With
  10. Set acadApp = GetObject(, "AutoCad.Application")
  11. Set acadDoc = acadApp.ActiveDocument
  12. If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
  13.    acadDoc.ActiveSpace = 1     '1 = acModelSpace in early binding
  14. End If
  15.     Dim objEnt As AcadObject
  16.     Dim objBRef As AcadBlockReference
  17.     Dim pt1 As Variant
  18.     Dim pt2(0 To 1) As Double
  19.     Dim i As Integer
  20.     Dim varAttributes As Variant ' ДОБАВИЛ
  21.    Dim l As Variant ' ДОБАВИЛ
  22.    Dim format As String ' ДОБАВИЛ 3
  23. Dim ss As AcadSelectionSet
  24. Set ss = acadDoc.SelectionSets.Item("SS")
  25. If ss Is Nothing Then
  26.     Set ss = acadDoc.SelectionSets.Add("SS")
  27. Else
  28.     ss.Clear ' если используем сущ. SS то очистить его
  29. End If
  30. ss.SelectonScreen
  31. On Error GoTo 0
  32.     i = 0
  33.     For Each objEnt In ss
  34.     If objEnt.ObjectName = "AcDbBlockReference" Then
  35.     Set objBRef = objEnt
  36.     varAttributes = objBRef.GetAttributes
  37.     l = varAttributes(4).TextString
  38.         If objBRef.EffectiveName = "А4кшб" Or objBRef.EffectiveName = "ОУ" Or objBRef.EffectiveName = "Титул" Then
  39.         pt1 = objBRef.InsertionPoint
  40.         varAttributes = objBRef.GetAttributes
  41.         l = varAttributes(4).TextString
  42.         ReDim Preserve pt1(0 To 1)
  43.         pt2(0) = pt1(0) + 21000
  44.         pt2(1) = pt1(1) + 29700
  45.         format = "A4к"
  46. ElseIf objBRef.EffectiveName = "ОД" Or objBRef.EffectiveName = "А3ашб" Then
  47.         pt1 = objBRef.InsertionPoint
  48.         ReDim Preserve pt1(0 To 1)
  49.         pt2(0) = pt1(0) + 42000
  50.         pt2(1) = pt1(1) + 29700
  51.         format = "A3а"
  52.         ElseIf objBRef.EffectiveName = "А3кшб" Then
  53.         pt1 = objBRef.InsertionPoint
  54.         ReDim Preserve pt1(0 To 1)
  55.         pt2(0) = pt1(0) + 29700
  56.         pt2(1) = pt1(1) + 42000
  57.         format = "A3к"
  58.         ElseIf objBRef.EffectiveName = "А2ашб" Then
  59.         pt1 = objBRef.InsertionPoint
  60.         ReDim Preserve pt1(0 To 1)
  61.         pt2(0) = pt1(0) + 59400
  62.         pt2(1) = pt1(1) + 42000
  63.         format = "A2а"
  64.         ElseIf objBRef.EffectiveName = "А2кшб" Then
  65.         pt1 = objBRef.InsertionPoint
  66.         ReDim Preserve pt1(0 To 1)
  67.         pt2(0) = pt1(0) + 42000
  68.         pt2(1) = pt1(1) + 59400
  69.         format = "A2к"
  70.         ElseIf objBRef.EffectiveName = "А1ашб" Then
  71.         pt1 = objBRef.InsertionPoint
  72.         ReDim Preserve pt1(0 To 1)
  73.         pt2(0) = pt1(0) + 84100
  74.         pt2(1) = pt1(1) + 59400
  75.         format = "A1а"
  76.         ElseIf objBRef.EffectiveName = "А1кшб" Then
  77.         pt1 = objBRef.InsertionPoint
  78.         ReDim Preserve pt1(0 To 1)
  79.         pt2(0) = pt1(0) + 59400
  80.         pt2(1) = pt1(1) + 84100
  81.         format = "A1к"
  82.         ElseIf objBRef.EffectiveName = "А0ашб" Then
  83.         pt1 = objBRef.InsertionPoint
  84.         ReDim Preserve pt1(0 To 1)
  85.         pt2(0) = pt1(0) + 11890
  86.         pt2(1) = pt1(1) + 84100
  87.         format = "A0а"
  88.         ElseIf objBRef.EffectiveName = "А0кшб" Then
  89.         pt1 = objBRef.InsertionPoint
  90.         ReDim Preserve pt1(0 To 1)
  91.         pt2(0) = pt1(0) + 84100
  92.         pt2(1) = pt1(1) + 11890
  93.         format = "A0к"
  94.         i = i + 1
  95.         PolyPlot acadDoc, ActiveWorkbook.Path + "\" + CStr(n) + " - ИЧ Лист " + CStr(l) + " - ", pt1, pt2, format
  96.         End If
  97.     End If
  98.     Next
  99. End Sub
  100. Sub PolyPlot(ByRef acadDoc, strFileName As String, pt1 As Variant, pt2 As Variant)
  101.     Dim Layout As AcadLayout
  102.     Set Layout = acadDoc.ActiveLayout
  103.     Layout.RefreshPlotDeviceInfo
  104.     Layout.ConfigName = "DWG To PDF.pc3"
  105.     acadDoc.SetVariable "BACKGROUNDPLOT", 0
  106.     If format = "A4к" Then
  107.     Layout.CanonicalMediaName = "ISO_full_bleed_A4_(210.00_x_297.00_MM)"
  108.     If format = "A3а" Then
  109.     Layout.CanonicalMediaName = "ISO_full_bleed_A3_(420.00_x_297.00_MM)"
  110.     If format = "A3к" Then
  111.     Layout.CanonicalMediaName = "ISO_full_bleed_A3_(297.00_x_420.00_MM)"
  112.     If format = "A2а" Then
  113.     Layout.CanonicalMediaName = "ISO_full_bleed_A2_(594.00_x_420.00_MM)"
  114.     If format = "A2к" Then
  115.     Layout.CanonicalMediaName = "ISO_full_bleed_A2_(420.00_x_594.00_MM)"
  116.     If format = "A1а" Then
  117.     Layout.CanonicalMediaName = "ISO_full_bleed_A1_(841.00_x_594.00_MM)"
  118.     If format = "A1к" Then
  119.     Layout.CanonicalMediaName = "ISO_full_bleed_A1_(594.00_x_841.00_MM)"
  120.     If format = "A0а" Then
  121.     Layout.CanonicalMediaName = "ISO_full_bleed_A0_(1189.00_x_841.00_MM)"
  122.     If format = "A0к" Then
  123.     Layout.CanonicalMediaName = "ISO_full_bleed_A0_(841.00_x_1189.00_MM)"
  124.     Layout.CenterPlot = True
  125.     Layout.PlotRotation = ac0degrees
  126.     Layout.StandardScale = acScaleToFit
  127.     Layout.StyleSheet = "acad.ctb"
  128.     Layout.SetWindowToPlot pt1, pt2
  129.     Layout.PlotType = acWindow
  130.     acadDoc.Regen acAllViewports
  131.     acadDoc.Plot.PlotToFile strFileName
  132. End Sub
Сделал по примерам код - ругается на строке Polyplot - compile error^ Wrong number of arguments or invalid property assignment - Подскажите что не так

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #179 : 18-01-2021, 16:37:26 »
Сделал по примерам код - ругается на строке Polyplot - compile error^ Wrong number of arguments or invalid property assignment - Подскажите что не так
Ну вообще-то у этой PolyPlot четыре аргумента, а ты передаёшь пять...
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #180 : 18-01-2021, 16:40:27 »
Делал по примеру - Ответ #146 в этой теме увидел

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #181 : 18-01-2021, 16:44:54 »
Делал по примеру - Ответ #146 в этой теме увидел
Ну я не могу гарантировать, что все примеры в этой теме 100% рабочие.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #182 : 18-01-2021, 16:55:49 »
Добавил аргумент format - код один раз отработал и напечатал формат А0 книжный один раз но не из точки блока
Код - Visual Basic [Выбрать]
  1. Sub PlotByBlocks() 'Tools -> References-> подключить библиотеку AutoCAD 20XX Type Library
  2. On Error Resume Next
  3. Dim acadApp As AcadApplication
  4. Dim acadDoc As AcadDocument
  5. Dim n As Integer ' ДОБАВИЛ 2
  6. With Sheets("!")
  7. .Activate
  8. n = .Range("B" & 1).Value ' ДОБАВИЛ 2
  9. End With
  10. Set acadApp = GetObject(, "AutoCad.Application")
  11. Set acadDoc = acadApp.ActiveDocument
  12. If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
  13.    acadDoc.ActiveSpace = 1     '1 = acModelSpace in early binding
  14. End If
  15.     Dim objEnt As AcadObject
  16.     Dim objBRef As AcadBlockReference
  17.     Dim pt1 As Variant
  18.     Dim pt2(0 To 1) As Double
  19.     Dim i As Integer
  20.     Dim varAttributes As Variant ' ДОБАВИЛ
  21.    Dim l As Variant ' ДОБАВИЛ
  22.    Dim format As String ' ДОБАВИЛ 3
  23. Dim ss As AcadSelectionSet
  24. Set ss = acadDoc.SelectionSets.Item("SS")
  25. If ss Is Nothing Then
  26.     Set ss = acadDoc.SelectionSets.Add("SS")
  27. Else
  28.     ss.Clear ' если используем сущ. SS то очистить его
  29. End If
  30. ss.SelectonScreen
  31. On Error GoTo 0
  32.     i = 0
  33.     For Each objEnt In ss
  34.     If objEnt.ObjectName = "AcDbBlockReference" Then
  35.     Set objBRef = objEnt
  36.     varAttributes = objBRef.GetAttributes
  37.     l = varAttributes(4).TextString
  38.         If objBRef.EffectiveName = "А4кшб" Or objBRef.EffectiveName = "ОУ" Or objBRef.EffectiveName = "Титул" Then
  39.         pt1 = objBRef.InsertionPoint
  40.         varAttributes = objBRef.GetAttributes
  41.         l = varAttributes(4).TextString
  42.         ReDim Preserve pt1(0 To 1)
  43.         pt2(0) = pt1(0) + 21000
  44.         pt2(1) = pt1(1) + 29700
  45.         format = "A4к"
  46. ElseIf objBRef.EffectiveName = "ОД" Or objBRef.EffectiveName = "А3ашб" Then
  47.         pt1 = objBRef.InsertionPoint
  48.         ReDim Preserve pt1(0 To 1)
  49.         pt2(0) = pt1(0) + 42000
  50.         pt2(1) = pt1(1) + 29700
  51.         format = "A3а"
  52.         ElseIf objBRef.EffectiveName = "А3кшб" Then
  53.         pt1 = objBRef.InsertionPoint
  54.         ReDim Preserve pt1(0 To 1)
  55.         pt2(0) = pt1(0) + 29700
  56.         pt2(1) = pt1(1) + 42000
  57.         format = "A3к"
  58.         ElseIf objBRef.EffectiveName = "А2ашб" Then
  59.         pt1 = objBRef.InsertionPoint
  60.         ReDim Preserve pt1(0 To 1)
  61.         pt2(0) = pt1(0) + 59400
  62.         pt2(1) = pt1(1) + 42000
  63.         format = "A2а"
  64.         ElseIf objBRef.EffectiveName = "А2кшб" Then
  65.         pt1 = objBRef.InsertionPoint
  66.         ReDim Preserve pt1(0 To 1)
  67.         pt2(0) = pt1(0) + 42000
  68.         pt2(1) = pt1(1) + 59400
  69.         format = "A2к"
  70.         ElseIf objBRef.EffectiveName = "А1ашб" Then
  71.         pt1 = objBRef.InsertionPoint
  72.         ReDim Preserve pt1(0 To 1)
  73.         pt2(0) = pt1(0) + 84100
  74.         pt2(1) = pt1(1) + 59400
  75.         format = "A1а"
  76.         ElseIf objBRef.EffectiveName = "А1кшб" Then
  77.         pt1 = objBRef.InsertionPoint
  78.         ReDim Preserve pt1(0 To 1)
  79.         pt2(0) = pt1(0) + 59400
  80.         pt2(1) = pt1(1) + 84100
  81.         format = "A1к"
  82.         ElseIf objBRef.EffectiveName = "А0ашб" Then
  83.         pt1 = objBRef.InsertionPoint
  84.         ReDim Preserve pt1(0 To 1)
  85.         pt2(0) = pt1(0) + 11890
  86.         pt2(1) = pt1(1) + 84100
  87.         format = "A0а"
  88.         ElseIf objBRef.EffectiveName = "А0кшб" Then
  89.         pt1 = objBRef.InsertionPoint
  90.         ReDim Preserve pt1(0 To 1)
  91.         pt2(0) = pt1(0) + 84100
  92.         pt2(1) = pt1(1) + 11890
  93.         format = "A0к"
  94.         i = i + 1
  95.         PolyPlot acadDoc, ActiveWorkbook.Path + "\" + CStr(n) + " - ИЧ Лист " + CStr(l) + " - ", pt1, pt2, format
  96.         End If
  97.     End If
  98.     Next
  99. End Sub
  100. Sub PolyPlot(ByRef acadDoc, strFileName As String, pt1 As Variant, pt2 As Variant, format As String)
  101.     Dim Layout As AcadLayout
  102.     Set Layout = acadDoc.ActiveLayout
  103.     Layout.RefreshPlotDeviceInfo
  104.     Layout.ConfigName = "DWG To PDF.pc3"
  105.     acadDoc.SetVariable "BACKGROUNDPLOT", 0
  106.     If format = "A4к" Then
  107.     Layout.CanonicalMediaName = "ISO_full_bleed_A4_(210.00_x_297.00_MM)"
  108.     ElseIf format = "A3а" Then
  109.     Layout.CanonicalMediaName = "ISO_full_bleed_A3_(420.00_x_297.00_MM)"
  110.     ElseIf format = "A3к" Then
  111.     Layout.CanonicalMediaName = "ISO_full_bleed_A3_(297.00_x_420.00_MM)"
  112.     ElseIf format = "A2а" Then
  113.     Layout.CanonicalMediaName = "ISO_full_bleed_A2_(594.00_x_420.00_MM)"
  114.     ElseIf format = "A2к" Then
  115.     Layout.CanonicalMediaName = "ISO_full_bleed_A2_(420.00_x_594.00_MM)"
  116.     ElseIf format = "A1а" Then
  117.     Layout.CanonicalMediaName = "ISO_full_bleed_A1_(841.00_x_594.00_MM)"
  118.     ElseIf format = "A1к" Then
  119.     Layout.CanonicalMediaName = "ISO_full_bleed_A1_(594.00_x_841.00_MM)"
  120.     ElseIf format = "A0а" Then
  121.     Layout.CanonicalMediaName = "ISO_full_bleed_A0_(1189.00_x_841.00_MM)"
  122.     ElseIf format = "A0к" Then
  123.     Layout.CanonicalMediaName = "ISO_full_bleed_A0_(841.00_x_1189.00_MM)"
  124.     End If
  125.     Layout.CenterPlot = True
  126.     Layout.PlotRotation = ac0degrees
  127.     Layout.StandardScale = acScaleToFit
  128.     Layout.StyleSheet = "acad.ctb"
  129.     Layout.SetWindowToPlot pt1, pt2
  130.     Layout.PlotType = acWindow
  131.     acadDoc.Regen acAllViewports
  132.     acadDoc.Plot.PlotToFile strFileName
  133. End Sub
  134.  

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #183 : 18-01-2021, 17:00:55 »
Как минимум координаты следует преобразовать в ДСК (DCS), как сказано в этой статье: https://adn-cis.org/pechat-granicz-okna-pri-pomoshhi-vba.html
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #184 : 18-01-2021, 17:16:54 »
Обнулил форматы как в примере. Добавил согласно статье перевод координат (может не там, может не везде). Печатается один лист и не то что надо)
Код - Visual Basic [Выбрать]
  1. Sub PlotByBlocks() 'Tools -> References-> подключить библиотеку AutoCAD 20XX Type Library
  2. On Error Resume Next
  3. Dim acadApp As AcadApplication
  4. Dim acadDoc As AcadDocument
  5. Dim n As Integer ' ДОБАВИЛ 2
  6. With Sheets("!")
  7. .Activate
  8. n = .Range("B" & 1).Value ' ДОБАВИЛ 2
  9. End With
  10. Set acadApp = GetObject(, "AutoCad.Application")
  11. Set acadDoc = acadApp.ActiveDocument
  12. If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
  13.    acadDoc.ActiveSpace = 1     '1 = acModelSpace in early binding
  14. End If
  15.     Dim objEnt As AcadObject
  16.     Dim objBRef As AcadBlockReference
  17.     Dim pt1 As Variant
  18.     Dim pt2(0 To 1) As Double
  19.     Dim i As Integer
  20.     Dim varAttributes As Variant ' ДОБАВИЛ
  21.    Dim l As Variant ' ДОБАВИЛ
  22.    Dim format As String ' ДОБАВИЛ 3
  23. Dim ss As AcadSelectionSet
  24. Set ss = acadDoc.SelectionSets.Item("SS")
  25. If ss Is Nothing Then
  26.     Set ss = acadDoc.SelectionSets.Add("SS")
  27. Else
  28.     ss.Clear ' если используем сущ. SS то очистить его
  29. End If
  30. ss.SelectonScreen
  31. On Error GoTo 0
  32.     i = 0
  33.     For Each objEnt In ss
  34.     If objEnt.ObjectName = "AcDbBlockReference" Then
  35.     Set objBRef = objEnt
  36.     varAttributes = objBRef.GetAttributes
  37.     l = varAttributes(4).TextString
  38.     A4к = 0
  39.     A3а = 0
  40.     A3к = 0
  41.     A2а = 0
  42.     A2к = 0
  43.     A1а = 0
  44.     A1к = 0
  45.     A0а = 0
  46.     A0к = 0
  47.         If objBRef.EffectiveName = "А4кшб" Or objBRef.EffectiveName = "ОУ" Or objBRef.EffectiveName = "Титул" Then
  48.         pt1 = objBRef.InsertionPoint
  49.         pt1 = acadDoc.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False) ' добавил по статье https://adn-cis.org/pechat-granicz-okna-pri-pomoshhi-vba.html
  50.        varAttributes = objBRef.GetAttributes
  51.         l = varAttributes(4).TextString
  52.         ReDim Preserve pt1(0 To 1)
  53.         pt2(0) = pt1(0) + 21000
  54.         pt2(1) = pt1(1) + 29700
  55.         A4к = A4к + 1
  56.         format = "A4к"
  57.         ElseIf objBRef.EffectiveName = "ОД" Or objBRef.EffectiveName = "А3ашб" Then
  58.         pt1 = objBRef.InsertionPoint
  59.         ReDim Preserve pt1(0 To 1)
  60.         pt2(0) = pt1(0) + 42000
  61.         pt2(1) = pt1(1) + 29700
  62.         A3а = A3а + 1
  63.         format = "A3а"
  64.         ElseIf objBRef.EffectiveName = "А3кшб" Then
  65.         pt1 = objBRef.InsertionPoint
  66.         ReDim Preserve pt1(0 To 1)
  67.         pt2(0) = pt1(0) + 29700
  68.         pt2(1) = pt1(1) + 42000
  69.         A3к = A3к + 1
  70.         format = "A3к"
  71.         ElseIf objBRef.EffectiveName = "А2ашб" Then
  72.         pt1 = objBRef.InsertionPoint
  73.         ReDim Preserve pt1(0 To 1)
  74.         pt2(0) = pt1(0) + 59400
  75.         pt2(1) = pt1(1) + 42000
  76.         A2а = A2а + 1
  77.         format = "A2а"
  78.         ElseIf objBRef.EffectiveName = "А2кшб" Then
  79.         pt1 = objBRef.InsertionPoint
  80.         ReDim Preserve pt1(0 To 1)
  81.         pt2(0) = pt1(0) + 42000
  82.         pt2(1) = pt1(1) + 59400
  83.         A2к = A2к + 1
  84.         format = "A2к"
  85.         ElseIf objBRef.EffectiveName = "А1ашб" Then
  86.         pt1 = objBRef.InsertionPoint
  87.         ReDim Preserve pt1(0 To 1)
  88.         pt2(0) = pt1(0) + 84100
  89.         pt2(1) = pt1(1) + 59400
  90.         A1а = A1а + 1
  91.         format = "A1а"
  92.         ElseIf objBRef.EffectiveName = "А1кшб" Then
  93.         pt1 = objBRef.InsertionPoint
  94.         ReDim Preserve pt1(0 To 1)
  95.         pt2(0) = pt1(0) + 59400
  96.         pt2(1) = pt1(1) + 84100
  97.         A1к = A1к + 1
  98.         format = "A1к"
  99.         ElseIf objBRef.EffectiveName = "А0ашб" Then
  100.         pt1 = objBRef.InsertionPoint
  101.         ReDim Preserve pt1(0 To 1)
  102.         pt2(0) = pt1(0) + 11890
  103.         pt2(1) = pt1(1) + 84100
  104.         A0а = A0а + 1
  105.         format = "A0а"
  106.         ElseIf objBRef.EffectiveName = "А0кшб" Then
  107.         pt1 = objBRef.InsertionPoint
  108.         ReDim Preserve pt1(0 To 1)
  109.         pt2(0) = pt1(0) + 84100
  110.         pt2(1) = pt1(1) + 11890
  111.         A0к = A0к + 1
  112.         format = "A0к"
  113.         i = i + 1
  114.         PolyPlot acadDoc, ActiveWorkbook.Path + "\" + CStr(n) + " - ИЧ Лист " + CStr(l) + " - ", pt1, pt2, format
  115.         End If
  116.     End If
  117.     Next
  118. End Sub
  119. Sub PolyPlot(ByRef acadDoc, strFileName As String, pt1 As Variant, pt2 As Variant, format As String)
  120.     Dim Layout As AcadLayout
  121.     Set Layout = acadDoc.ActiveLayout
  122.     Layout.RefreshPlotDeviceInfo
  123.     Layout.ConfigName = "DWG To PDF.pc3"
  124.     acadDoc.SetVariable "BACKGROUNDPLOT", 0
  125.     If format = "A4к" Then
  126.     Layout.CanonicalMediaName = "ISO_full_bleed_A4_(210.00_x_297.00_MM)"
  127.     ElseIf format = "A3а" Then
  128.     Layout.CanonicalMediaName = "ISO_full_bleed_A3_(420.00_x_297.00_MM)"
  129.     ElseIf format = "A3к" Then
  130.     Layout.CanonicalMediaName = "ISO_full_bleed_A3_(297.00_x_420.00_MM)"
  131.     ElseIf format = "A2а" Then
  132.     Layout.CanonicalMediaName = "ISO_full_bleed_A2_(594.00_x_420.00_MM)"
  133.     ElseIf format = "A2к" Then
  134.     Layout.CanonicalMediaName = "ISO_full_bleed_A2_(420.00_x_594.00_MM)"
  135.     ElseIf format = "A1а" Then
  136.     Layout.CanonicalMediaName = "ISO_full_bleed_A1_(841.00_x_594.00_MM)"
  137.     ElseIf format = "A1к" Then
  138.     Layout.CanonicalMediaName = "ISO_full_bleed_A1_(594.00_x_841.00_MM)"
  139.     ElseIf format = "A0а" Then
  140.     Layout.CanonicalMediaName = "ISO_full_bleed_A0_(1189.00_x_841.00_MM)"
  141.     ElseIf format = "A0к" Then
  142.     Layout.CanonicalMediaName = "ISO_full_bleed_A0_(841.00_x_1189.00_MM)"
  143.     End If
  144.     Layout.CenterPlot = True
  145.     Layout.PlotRotation = ac0degrees
  146.     Layout.StandardScale = acScaleToFit
  147.     Layout.StyleSheet = "acad.ctb"
  148.     Layout.SetWindowToPlot pt1, pt2
  149.     Layout.PlotType = acWindow
  150.     acadDoc.Regen acAllViewports
  151.     acadDoc.Plot.PlotToFile strFileName
  152. End Sub

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #185 : 18-01-2021, 17:22:19 »
pt2 тоже нужно преобразовывать. Лучше всего и pt1 и pt2 преобразовывать в методе PolyPlot перед Layout.SetWindowToPlot pt1, pt2
Всё остальное не проверял - запускай в режиме отладки и смотри что происходит.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #186 : 18-01-2021, 17:29:30 »
если переношу сюда
Код - Visual Basic [Выбрать]
  1.  pt1 = acadDoc.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False) ' добавил по статье https://adn-cis.org/pechat-granicz-okna-pri-pomoshhi-vba.html
  2.    pt2 = acadDoc.Utility.TranslateCoordinates(pt2, acWorld, acDisplayDCS, False) ' добавил по статье https://adn-cis.org/pechat-granicz-okna-pri-pomoshhi-vba.html
  3. ReDim Preserve pt1(0 To 1)
  4. ReDim Preserve pt2(0 To 1)
  5.     Layout.SetWindowToPlot pt1, pt2
То Ошибка преобразования точки из SafeArray в точку двойного массива '-2145320947 (8021000d)

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #187 : 18-01-2021, 18:08:41 »
Последнее действие убрал - в нем сразу ошибка без него хоть один лист печатало!
Пройдясь по F8 наверное не хватает в коде скорее всего последующий лист затирает предыдущего данные и поэтому печатается один лист
Вот это я пропустил:
Dim arr() As AcadEntity
Dim arr2() As AcadEntity

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #188 : 18-01-2021, 18:57:01 »
Добавил в код - все равно печатает только один лист формат 841х1189 книжный и все - чего то не хватает ....
Код - Visual Basic [Выбрать]
  1. Sub PlotByBlocks() 'Tools -> References-> подключить библиотеку AutoCAD 20XX Type Library
  2. On Error Resume Next
  3. Dim acadApp As AcadApplication
  4. Dim acadDoc As AcadDocument
  5. Dim n As Integer ' ДОБАВИЛ 2
  6. With Sheets("!")
  7. .Activate
  8. n = .Range("B" & 1).Value ' ДОБАВИЛ 2
  9. End With
  10. Set acadApp = GetObject(, "AutoCad.Application")
  11. Set acadDoc = acadApp.ActiveDocument
  12. If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
  13.    acadDoc.ActiveSpace = 1     '1 = acModelSpace in early binding
  14. End If
  15.     Dim objEnt As AcadObject
  16.     Dim objBRef As AcadBlockReference
  17.     Dim pt1 As Variant
  18.     Dim pt2(0 To 1) As Double
  19.     Dim i As Integer
  20.     Dim varAttributes As Variant ' ДОБАВИЛ
  21.    Dim l As Variant ' ДОБАВИЛ
  22.    Dim format As String ' ДОБАВИЛ 3
  23.    Dim arr() As AcadEntity ' ДОБАВИЛ 3
  24.    Dim arr2() As AcadEntity ' ДОБАВИЛ 3
  25. Dim ss As AcadSelectionSet
  26. Set ss = acadDoc.SelectionSets.Item("SS")
  27. If ss Is Nothing Then
  28.     Set ss = acadDoc.SelectionSets.Add("SS")
  29. Else
  30.     ss.Clear ' если используем сущ. SS то очистить его
  31. End If
  32. ss.SelectonScreen
  33. On Error GoTo 0
  34.     i = 0
  35.     For Each objEnt In ss
  36.     If objEnt.ObjectName = "AcDbBlockReference" Then
  37.     ReDim Preserve arr(i)
  38.     Set arr(i) = objEnt
  39.     i = i + 1
  40.     End If
  41.     Next
  42.     A4к = 0: A3а = 0
  43.     A3к = 0: A2а = 0
  44.     A2к = 0: A1а = 0
  45.     A1к = 0: A0а = 0
  46.     A0к = 0
  47.         For i = LBound(arr) To UBound(arr)
  48.         If arr(i).EffectiveName = "А4кшб" Then
  49.         varAttributes = arr(i).GetAttributes
  50.         l = varAttributes(4).TextString
  51.         pt1 = arr(i).InsertionPoint
  52.         pt1 = acadDoc.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  53.         ReDim Preserve pt1(0 To 1)
  54.         pt2(0) = pt1(0) + 21000
  55.         pt2(1) = pt1(1) + 29700
  56.         A4к = A4к + 1
  57.         format = "A4к"
  58.         ElseIf arr(i).EffectiveName = "ОД" Or arr(i).EffectiveName = "А3ашб" Then
  59.         varAttributes = arr(i).GetAttributes
  60.         l = varAttributes(4).TextString
  61.         pt1 = arr(i).InsertionPoint
  62.         pt1 = acadDoc.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  63.         ReDim Preserve pt1(0 To 1)
  64.         pt2(0) = pt1(0) + 42000
  65.         pt2(1) = pt1(1) + 29700
  66.         A3а = A3а + 1
  67.         format = "A3а"
  68.         ElseIf arr(i).EffectiveName = "А3кшб" Then
  69.         varAttributes = arr(i).GetAttributes
  70.         l = varAttributes(4).TextString
  71.         pt1 = arr(i).InsertionPoint
  72.         pt1 = acadDoc.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  73.         ReDim Preserve pt1(0 To 1)
  74.         pt2(0) = pt1(0) + 29700
  75.         pt2(1) = pt1(1) + 42000
  76.         A3к = A3к + 1
  77.         format = "A3к"
  78.         ElseIf arr(i).EffectiveName = "А2ашб" Then
  79.         varAttributes = arr(i).GetAttributes
  80.         l = varAttributes(4).TextString
  81.         pt1 = arr(i).InsertionPoint
  82.         pt1 = acadDoc.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  83.         ReDim Preserve pt1(0 To 1)
  84.         pt2(0) = pt1(0) + 59400
  85.         pt2(1) = pt1(1) + 42000
  86.         A2а = A2а + 1
  87.         format = "A2а"
  88.         ElseIf arr(i).EffectiveName = "А2кшб" Then
  89.         varAttributes = arr(i).GetAttributes
  90.         l = varAttributes(4).TextString
  91.         pt1 = arr(i).InsertionPoint
  92.         pt1 = acadDoc.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  93.         ReDim Preserve pt1(0 To 1)
  94.         pt2(0) = pt1(0) + 42000
  95.         pt2(1) = pt1(1) + 59400
  96.         A2к = A2к + 1
  97.         format = "A2к"
  98.         ElseIf arr(i).EffectiveName = "А1ашб" Then
  99.         varAttributes = arr(i).GetAttributes
  100.         l = varAttributes(4).TextString
  101.         pt1 = arr(i).InsertionPoint
  102.         pt1 = acadDoc.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  103.         ReDim Preserve pt1(0 To 1)
  104.         pt2(0) = pt1(0) + 84100
  105.         pt2(1) = pt1(1) + 59400
  106.         A1а = A1а + 1
  107.         format = "A1а"
  108.         ElseIf arr(i).EffectiveName = "А1кшб" Then
  109.         varAttributes = arr(i).GetAttributes
  110.         l = varAttributes(4).TextString
  111.         pt1 = arr(i).InsertionPoint
  112.         pt1 = acadDoc.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  113.         ReDim Preserve pt1(0 To 1)
  114.         pt2(0) = pt1(0) + 59400
  115.         pt2(1) = pt1(1) + 84100
  116.         A1к = A1к + 1
  117.         format = "A1к"
  118.         ElseIf arr(i).EffectiveName = "А0ашб" Then
  119.         varAttributes = arr(i).GetAttributes
  120.         l = varAttributes(4).TextString
  121.         pt1 = arr(i).InsertionPoint
  122.         pt1 = acadDoc.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  123.         ReDim Preserve pt1(0 To 1)
  124.         pt2(0) = pt1(0) + 11890
  125.         pt2(1) = pt1(1) + 84100
  126.         A0а = A0а + 1
  127.         format = "A0а"
  128.         ElseIf arr(i).EffectiveName = "А0кшб" Then
  129.         varAttributes = arr(i).GetAttributes
  130.         l = varAttributes(4).TextString
  131.         pt1 = arr(i).InsertionPoint
  132.         pt1 = acadDoc.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  133.         ReDim Preserve pt1(0 To 1)
  134.         pt2(0) = pt1(0) + 84100
  135.         pt2(1) = pt1(1) + 11890
  136.         A0к = A0к + 1
  137.         format = "A0к"
  138.         PolyPlot acadDoc, ActiveWorkbook.Path + "\" + CStr(n) + " - ИЧ Лист " + CStr(l) + " - ", pt1, pt2, format
  139.         End If
  140.         Next
  141. End Sub
  142. Sub PolyPlot(ByRef acadDoc, strFileName As String, pt1 As Variant, pt2 As Variant, format As String)
  143.     Dim Layout As AcadLayout
  144.     Set Layout = acadDoc.ActiveLayout
  145.     Layout.RefreshPlotDeviceInfo
  146.     Layout.ConfigName = "DWG To PDF.pc3"
  147.     acadDoc.SetVariable "BACKGROUNDPLOT", 0
  148.     If format = "A4к" Then
  149.     Layout.CanonicalMediaName = "ISO_full_bleed_A4_(210.00_x_297.00_MM)"
  150.     ElseIf format = "A3а" Then
  151.     Layout.CanonicalMediaName = "ISO_full_bleed_A3_(420.00_x_297.00_MM)"
  152.     ElseIf format = "A3к" Then
  153.     Layout.CanonicalMediaName = "ISO_full_bleed_A3_(297.00_x_420.00_MM)"
  154.     ElseIf format = "A2а" Then
  155.     Layout.CanonicalMediaName = "ISO_full_bleed_A2_(594.00_x_420.00_MM)"
  156.     ElseIf format = "A2к" Then
  157.     Layout.CanonicalMediaName = "ISO_full_bleed_A2_(420.00_x_594.00_MM)"
  158.     ElseIf format = "A1а" Then
  159.     Layout.CanonicalMediaName = "ISO_full_bleed_A1_(841.00_x_594.00_MM)"
  160.     ElseIf format = "A1к" Then
  161.     Layout.CanonicalMediaName = "ISO_full_bleed_A1_(594.00_x_841.00_MM)"
  162.     ElseIf format = "A0а" Then
  163.     Layout.CanonicalMediaName = "ISO_full_bleed_A0_(1189.00_x_841.00_MM)"
  164.     ElseIf format = "A0к" Then
  165.     Layout.CanonicalMediaName = "ISO_full_bleed_A0_(841.00_x_1189.00_MM)"
  166.     End If
  167.     Layout.CenterPlot = True
  168.     Layout.PlotRotation = ac0degrees
  169.     Layout.StandardScale = acScaleToFit
  170.     Layout.StyleSheet = "acad.ctb"
  171.     Layout.SetWindowToPlot pt1, pt2
  172.     Layout.PlotType = acWindow
  173.     acadDoc.Regen acAllViewports
  174.     acadDoc.Plot.PlotToFile strFileName
  175. End Sub

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #189 : 18-01-2021, 19:02:25 »
При чем печатается последний лист А0кшб, атрибут берет правильно, но печатает совсем не так.
Перебор значит идет но в никуда, последующее значение затирает предыдущее и перевод координат не работает видимо что-то я не дочитал

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #190 : 19-01-2021, 06:37:11 »
Уф, какой раздутый код :o

обратите внимание что в каждом блоке elseif у Вас повторяются строки:
Код - Visual Basic [Выбрать]
  1.         varAttributes = arr(i).GetAttributes
  2.         l = varAttributes(4).TextString
  3.         pt1 = arr(i).InsertionPoint
  4.         pt1 = acadDoc.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  5.         ReDim Preserve pt1(0 To 1)
  6.  
То есть код их должен выполнить обязательно, так и вынесите его до блока if. Чем больше код тем труднее его понимать и искать в нем промахи.
Почему Вы не стали реализовывать идею с единым динамическим блоком?
Я подготовил Вам пример как можно сделать намного проще:

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #191 : 19-01-2021, 10:16:00 »
Спасибо большое за пример ругается на строку 57 ReDim Preserve pt1(0 To 1) - Invalid Redim
Код - Visual Basic [Выбрать]
  1. Sub PlotByBlocks()
  2. 'Tools -> References-> ïîäêëþ÷èòü áèáëèîòåêó AutoCAD 20XX Type Library
  3. On Error Resume Next
  4.  
  5. Dim acadApp As AcadApplication
  6. Dim acadDoc As AcadDocument
  7. 'Ïîëó÷àåì ññûëêó íà ïðèëîæåíèå àâòîêàäà
  8. Set acadApp = GetObject(, "AutoCad.Application")
  9. Set acadDoc = acadApp.ActiveDocument
  10.  
  11. If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
  12.    acadDoc.ActiveSpace = 1     '1 = acModelSpace in early binding
  13. End If
  14.  
  15.     Dim objEnt As AcadObject
  16.     Dim objBRef As AcadBlockReference
  17.     Dim pt2(0 To 1) As Double
  18.     Dim ss As AcadSelectionSet
  19.  
  20. acadDoc.SetVariable "BACKGROUNDPLOT", 0
  21.  
  22. Set ss = acadDoc.SelectionSets.Item("SS")
  23. If ss Is Nothing Then
  24.     Set ss = acadDoc.SelectionSets.Add("SS")
  25. Else
  26.     ss.Clear
  27. End If
  28. On Error GoTo 0
  29.  
  30. ss.SelectonScreen
  31. If ss.Count > 0 Then
  32.         For Each objEnt In ss
  33.             If objEnt.ObjectName = "AcDbBlockReference" Then
  34.                 Set objBRef = objEnt
  35.                 If objBRef.EffectiveName = "ðàìêà" Then
  36.                     pt1 = objBRef.InsertionPoint
  37.                     pt1 = acadDoc.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  38.                    
  39.                     varAttributes = objBRef.GetAttributes '
  40.                    For Each att In varAttributes
  41.                         Select Case att.TagString
  42.                             Case "ÊÀÍÎÍ_ÔÎÐÌÀÒ"
  43.                                 CanonicalMediaName = att.TextString
  44.                         End Select
  45.                     Next
  46.                    
  47.                     dynProp = objBRef.GetDynamicBlockProperties
  48.                     For Each dyn In dynProp
  49.                         Select Case dyn.PropertyName
  50.                             Case "Äëèíà"
  51.                                 blcLength = dyn.Value
  52.                             Case "Øèðèíà"
  53.                                 blcWeigth = dyn.Value
  54.                         End Select
  55.                     Next
  56.                    
  57.                     ReDim Preserve pt1(0 To 1)
  58.                     pt2(0) = pt1(0) + blcLength
  59.                     pt2(1) = pt1(1) + blcWeigth
  60.                     i = i + 1
  61.                     Call PolyPlot(acadDoc, CanonicalMediaName, ActiveWorkbook.Path + "\À1 Ëèñò" + CStr(i), pt1, pt2)
  62.                 End If
  63.             End If
  64.         Next
  65.     End If
  66. End Sub
  67. Sub PolyPlot(ByRef acadDoc, CanonicalMediaName, strFileName As String, pt1 As Variant, pt2 As Variant)
  68.     Dim Layout As AcadLayout
  69.     Set Layout = acadDoc.ActiveLayout
  70.    
  71.     Layout.RefreshPlotDeviceInfo
  72.     Layout.ConfigName = "DWG To PDF.pc3"
  73.     Layout.CanonicalMediaName = CanonicalMediaName
  74.     Layout.CenterPlot = True
  75.     Layout.StandardScale = acScaleToFit
  76.     Layout.StyleSheet = "acad.ctb"
  77.     Layout.SetWindowToPlot pt1, pt2
  78.     Layout.PlotType = acWindow
  79.    
  80.     acadDoc.Regen acAllViewports
  81.     acadDoc.Plot.PlotToFile strFileName
  82. End Sub

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #192 : 19-01-2021, 10:19:44 »
я дал маху и удалил объявление массива pt1, с копируйте обратно

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #193 : 19-01-2021, 10:38:59 »
вернул объявление - код отработал как нужно
Пример просто отличный !!!!
Еще переменную надо добавить масштаб как-то и умножать на него координаты pt

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #194 : 19-01-2021, 10:42:43 »
не нужно ни каких переменных, попробуйте увеличьте в 1000 раз блок и прогоните скрипт.
А потом можно дебагом посмотреть почему все равно получается

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #195 : 19-01-2021, 11:13:52 »
Во вложении файл
Не получается задать параметр длина в цикле

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #196 : 19-01-2021, 11:26:45 »
ох-хо-хох..

Попытайтесь приучить себя писать код без директивы On error resume next.
Когда Вы ее прописываете то отключаются все уведомления об ошибках, а у Вас их там порядочно.

а что собственно, Вы пытаетесь сделать? не легче приучить себя работать в лисах и этих проблем с расстановкой форматок в принципе не будет

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #197 : 19-01-2021, 11:30:56 »
В листах было бы вообще замечательно если бы я смог програмно их создать и настроить под печать. Пока много одинаковых шаблонных файлов планируется создавать и хочу от проблемы распечатки уйти настроив сразу расстановку
и из эксель мне это проще делать меняя атрибуты
'On Error Resume Next - закомментировал- код отработал но Длина не берется

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #198 : 19-01-2021, 11:33:35 »
"если бы я смог програмно их создать и настроить под печать." - сможете! Идите почитайте те ссылки что я кидал, там ведь есть примеры кода, потом открываете объектную модель и ищете объект лист, читаете какие у него метода и свойства

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #199 : 19-01-2021, 11:36:28 »
я читаю и смотрю видео - пока все туго идет, но я стараюсь и ошибку хотелось бы устранить в этой идее расстановки форматок в модели

Оффлайн Nutson

  • ADN OPEN
  • Сообщений: 43
  • Карма: 6
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #200 : 19-01-2021, 11:58:54 »
В листах было бы вообще замечательно если бы я смог програмно их создать и настроить под печать. Пока много одинаковых шаблонных файлов планируется создавать и хочу от проблемы распечатки уйти настроив сразу расстановку
и из эксель мне это проще делать меняя атрибуты
'On Error Resume Next - закомментировал- код отработал но Длина не берется

Вот прям отработал? и без одной ошибки?
и где отступы?? расставлены для галочки

Код - Visual Basic [Выбрать]
  1. Option Explicit
  2. Private Type ScaleFactor
  3.     X As Double
  4.     Y As Double
  5.     Z As Double
  6. End Type
  7. Sub InsertBlocks()
  8.     Dim acadApp                 As Object
  9.     Dim height                  As Double
  10.     Dim acadDoc                 As Object
  11.     Dim acadBlock               As Object
  12.     Dim attributeObj            As Object
  13.     Dim LastRow                 As Long
  14.     Dim i                       As Long
  15.     Dim InsertionPoint(0 To 2)  As Double
  16.     Dim BlockName               As String
  17.     Dim BlockScale              As ScaleFactor
  18.     Dim RotationAngle           As Double
  19.     Dim tag                     As String
  20.     Dim value                   As String
  21.     Dim prompt                  As String
  22.     Dim varAttributes As Variant
  23.     Dim varBlockProperties As Variant
  24.     Dim Index As Variant
  25.     Dim prop As Variant
  26.     Dim propatr As Variant
  27.    'Activate the coordinates sheet and find the last row.
  28.    With Sheets("Coordinates")
  29.         .Activate
  30.         LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
  31.     End With
  32.        
  33.     'Check if there are coordinates for at least one circle.
  34.    If LastRow < 2 Then
  35.         MsgBox "There are no coordinates for the insertion point!", vbCritical, "Insertion Point Error"
  36.         Exit Sub
  37.     End If
  38.     'Check if AutoCAD application is open. If is not opened create a new instance and make it visible.
  39.    On Error Resume Next
  40.     Set acadApp = GetObject(, "AutoCAD.Application")
  41.     If acadApp Is Nothing Then
  42.         Set acadApp = CreateObject("AutoCAD.Application")
  43.         acadApp.Visible = True
  44.     End If
  45.     'Check (again) if there is an AutoCAD object.
  46.    If acadApp Is Nothing Then
  47.         MsgBox "Sorry, it was impossible to start AutoCAD!", vbCritical, "AutoCAD Error"
  48.         Exit Sub
  49.     End If
  50.     On Error GoTo 0
  51.     'If there is no active drawing create a new one.
  52.    On Error Resume Next
  53.     Set acadDoc = acadApp.ActiveDocument
  54.     If acadDoc Is Nothing Then
  55.         Set acadDoc = acadApp.Documents.Add
  56.     End If
  57.     On Error GoTo 0
  58.     'Check if the active space is paper space and change it to model space.
  59.    If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding
  60.        acadDoc.ActiveSpace = 1     '1 = acModelSpace in early binding
  61.    End If
  62.  
  63.  
  64.     'On Error Resume Next ' --  здесь комментируем
  65.  
  66.  
  67.     'Loop through all the rows and add the corresponding blocks in AutoCAD.
  68.    With Sheets("Coordinates")
  69.         For i = 2 To LastRow
  70.             'Задаем имя блока
  71.            BlockName = .Range("A" & i).value
  72.             'Вставляем блок если он есть
  73.            If BlockName <> vbNullString Then
  74.                 'Задаем координаты вставки блока
  75.                InsertionPoint(0) = .Range("B" & i).value
  76.                 InsertionPoint(1) = .Range("C" & i).value
  77.                 InsertionPoint(2) = .Range("D" & i).value
  78.                 'Задаем геометрию блока
  79.                BlockScale.X = .Range("E" & i).value
  80.                 BlockScale.Y = .Range("F" & i).value
  81.                 BlockScale.Z = .Range("G" & i).value
  82.                 'Задаем Поворот блока
  83.                RotationAngle = 0
  84.                 Set attributeObj = acadBlock.AddAttribute(height, prompt, InsertionPoint, tag, value) ' ошибка №1
  85.                Set acadBlock = acadDoc.ModelSpace.InsertBlock(InsertionPoint, BlockName, BlockScale.X, BlockScale.Y, BlockScale.Z, RotationAngle * 0.0174532925)
  86.             End If
  87.                 varAttributes = acadBlock.GetAttributes
  88.                 varAttributes(0).TextString = .Range("L" & i).value
  89.                 varAttributes(1).TextString = .Range("M" & i).value
  90.                 varAttributes(2).TextString = .Range("N" & i).value    ' ошибка №2
  91.                varAttributes(3).TextString = .Range("O" & i).value    ' ошибка №3
  92.                varAttributes(4).TextString = .Range("P" & i).value    ' ошибка №4
  93.                varAttributes(5).TextString = .Range("Q" & i).value    ' ошибка №5
  94.                'varAttributes(6).TextString = .Range("L" & i).value
  95.                'varAttributes(7).TextString = .Range("M" & i).value
  96.                acadBlock.Layer = .Range("K" & i).value    
  97.                 If acadBlock.IsDynamicBlock = True Then
  98.                 varBlockProperties = acadBlock.GetDynamicBlockProperties
  99.                 For Index = LBound(varBlockProperties) To UBound(varBlockProperties)
  100.                 Set prop = varBlockProperties(Index)
  101.                 If prop = prop.PropertyName = "Ширина" Then    ' ошибка №6
  102.                    prop.value = .Range("H" & i).value
  103.                 ElseIf prop = prop.PropertyName = "Длина" Then    ' ошибка №7
  104.                    prop.value = .Range("Длина" & i).value
  105.                 End If
  106.                 acadBlock.Layer = .Range("K" & i).value    ' это нафига в цикле, плюс это дубль
  107.                Next
  108.                 End If
  109.                 'varBlockProperties.Update
  110.        Next i
  111.     End With
  112.     'Zoom in to the drawing area.
  113.    acadApp.ZoomExtents
  114.     'Release the objects.
  115.    Set acadBlock = Nothing
  116.     Set acadDoc = Nothing
  117.     Set acadApp = Nothing
  118. End Sub
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #201 : 19-01-2021, 13:05:12 »
Подскажите если у дин блока имена .PropertyName - называются для обращения, то как обратится к атрибуту? какая там фраза?

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13827
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #202 : 19-01-2021, 13:10:09 »
Подскажите если у дин блока имена .PropertyName - называются для обращения, то как обратится к атрибуту? какая там фраза?
Эту фразу я не понял, но ты наверное говоришь про .TagString
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Timofeev

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Обсуждение видеоуроков AutoCAD VBA
« Ответ #203 : 19-01-2021, 13:17:14 »
спасибо да о ней
Работа над ошибками: прокомментировал как понимаю, поправил вроде все какие замечания дали. Поглядите все ли норм
Код - Visual Basic [Выбрать]
  1. Option Explicit
  2. Private Type ScaleFactor
  3.     X As Double 'Объявляем переменные
  4.    Y As Double
  5.     Z As Double
  6. End Type
  7. Sub InsertBlocks()
  8.     Dim acadApp                 As Object 'Объявляем переменные
  9.    Dim height                  As Double
  10.     Dim acadDoc                 As Object
  11.     Dim acadBlock               As Object
  12.     Dim attributeObj            As Object
  13.     Dim LastRow                 As Long
  14.     Dim i                       As Long
  15.     Dim InsertionPoint(0 To 2)  As Double
  16.     Dim BlockName               As String
  17.     Dim BlockScale              As ScaleFactor
  18.     Dim RotationAngle           As Double
  19.     Dim tag                     As String
  20.     Dim value                   As String
  21.     Dim prompt                  As String
  22.     Dim varAttributes As Variant
  23.     Dim varBlockProperties As Variant
  24.     Dim Index As Variant
  25.     Dim prop As Variant
  26.     Dim propatr As Variant
  27.    
  28.     With Sheets("Coordinates") 'Делаем активным лист координаты
  29.        .Activate
  30.         LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'Ищем последнюю заполненную строку столбца A
  31.    End With
  32.     If LastRow < 2 Then 'Если номер последней строки меньше чем два
  33.        MsgBox "Нет ни одной координаты для вставки блока", vbCritical, "Ошибка координат вставки блока"
  34.         Exit Sub
  35.     End If
  36.     On Error Resume Next
  37.    
  38.     Set acadApp = GetObject(, "AutoCAD.Application") 'Проверяем открыт ли автокад
  39.    If acadApp Is Nothing Then 'Если автокад не открыт
  40.        Set acadApp = CreateObject("AutoCAD.Application") 'Создаем новую сессию автокад
  41.        acadApp.Visible = True 'Делаем автокад видимым
  42.    End If
  43.     If acadApp Is Nothing Then 'Если опять автокад не открыт
  44.        MsgBox "Извините, но мы не можем запустить автокад", vbCritical, "Ошибка запуска автокад"
  45.         Exit Sub
  46.     End If
  47.     On Error GoTo 0 'Если ошибка то идем хз куда
  48.    On Error Resume Next 'Если ошибка то идем дальше
  49.    
  50.     Set acadDoc = acadApp.ActiveDocument 'Присваиваем переменную активному чертежу автокада
  51.    If acadDoc Is Nothing Then 'Если ни один чертеж автокада не активен
  52.        Set acadDoc = acadApp.Documents.Add 'Создаем новый чертеж
  53.    End If
  54.     On Error GoTo 0 'Если ошибка то идем хз куда
  55.    If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding. Если чертеж открыт не в модели, а в листах
  56.        acadDoc.ActiveSpace = 1     '1 = acModelSpace in early binding. Делаем активной модель
  57.    End If
  58.    
  59.     With Sheets("Coordinates") 'С листом Coordinates Excel
  60.        For i = 2 To LastRow 'Цикл начиная со второй строки до последней заполненной в столбце А
  61.            BlockName = .Range("A" & i).value 'Присваиваем переменную имя блока по значению из ячейки А листа эксель
  62.            'Вставляем блок если он есть
  63.            If BlockName <> vbNullString Then 'Если данный блок присутствует в чертеже автокад
  64.            
  65.                 InsertionPoint(0) = .Range("B" & i).value 'Задаем координату X вставки блока
  66.                InsertionPoint(1) = .Range("C" & i).value 'Задаем координату Y вставки блока
  67.                InsertionPoint(2) = .Range("D" & i).value 'Задаем координату Z вставки блока
  68.                
  69.                 BlockScale.X = .Range("E" & i).value 'Задаем масштаб по X вставки блока
  70.                BlockScale.Y = .Range("F" & i).value 'Задаем масштаб по Y вставки блока
  71.                BlockScale.Z = .Range("G" & i).value 'Задаем масштаб по Z вставки блока
  72.                
  73.                 RotationAngle = 0 'Задаем угол поворота блока равным нулю
  74.                
  75.                 Set acadBlock = acadDoc.ModelSpace.InsertBlock(InsertionPoint, BlockName, BlockScale.X, BlockScale.Y, BlockScale.Z, RotationAngle * 0.0174532925) 'Вставляем блок в чертеж
  76.                acadBlock.Layer = .Range("K" & i).value  'Устанавливаем нулевой слой для блока
  77.            End If
  78.                
  79.             varAttributes = acadBlock.GetAttributes 'Получаем атрибуты блока
  80.                For Each propatr In varAttributes 'Циклом проходим по всем атрибутам
  81.                    Select Case propatr.TagString 'Открываем портфель атрибутов
  82.                        Case "КАНОН-ФОРМАТ"
  83.                             propatr.TagString = .Range("L" & i).value 'Задаем значение атрибута 1
  84.                        Case "ОРИЕНТАЦИЯ"
  85.                             propatr.TagString = .Range("M" & i).value 'Задаем значение атрибута 2
  86.                    End Select 'Завершаем выбор
  87.                Next
  88.    
  89.                 If acadBlock.IsDynamicBlock = True Then 'Если блок динамический (обязательно ли это?)
  90.                    varBlockProperties = acadBlock.GetDynamicBlockProperties 'Получаем свойства дин блока
  91.                    For Each prop In varBlockProperties 'Циклом проходим по всем свойствам
  92.                        Select Case prop.PropertyName 'Открываем портфель свойств
  93.                            Case "Длина"
  94.                                 prop.value = .Range("I" & i).value * 1 'Задаем свойство 1
  95.                            Case "Ширина"
  96.                                 prop.value = .Range("H" & i).value * 1 'Задаем свойство 2
  97.                        End Select 'Завершаем выбор
  98.                    Next
  99.                 End If
  100.         Next i ' Переход к следующей строке эксель
  101.    End With ' Завершение взятия данных с листа эксель
  102.    acadApp.ZoomExtents ' Двойное нажатие на колесико мыши
  103.    Set acadBlock = Nothing ' ХЗ зачем обнуляем наверное перменные
  104.    Set acadDoc = Nothing ' ХЗ зачем обнуляем наверное перменные
  105.    Set acadApp = Nothing ' ХЗ зачем обнуляем наверное перменные
  106. End Sub