VBA в AutoCAD

VBA в AutoCAD · 27.12.2005, 21:04

Уважаемые коллеги
Посоветуйте литературу и проч. по использованию VBA для разработки пользовательских приложений применительно к AutoCAD

C1 · 27.12.2005, 23:36

Мне вполне достаточно примеров в справке AutoCAD и самой этой справки (и опыта в Visual Basic). Копирую пример, вставляю в новый модуль и все проверяю вживую.

p_sh · 28.12.2005, 08:52

в vba получается косовато: нет динамического вида создаваемых объектов (максимум резиновая лента). если есть оригинальные задумки лучше сразу изучать си и писать .arx приложения.
если получится изучить .arx, и понравилась идея: http://dwg.ru/dwl/453 , то можно будет переписать (самому времени не хватает).

Огурец · 28.12.2005, 10:28

Уважаемые коллеги!
Противоположный вопрос - а как отключить VBA в автокаде? У одной из наших сотрудниц он автоматически грузится во все файлы, создаёт ненужные и непонятные макросы, x-refы и откровенно мешает работать. Отключить не сумел, загружаеется и довольно долго при входе в ACAD.

p_sh · 28.12.2005, 13:07

1. при установке автокада отключите опцию vba.
2. просто удалите acvba.arx из каталога автокада (но это хуже 1)

Кулик Алексей aka kpblc · 28.12.2005, 13:14

Можно не так жестоко, по-моему:
- поискать файл acad.dvb и снести его, если он находится по путям поддержки када.
- где-то на autocad.ru вроде как была тема по поводу отключения vba-макросов. Но как это делать, я чего-то не усек - даже в какой области копаться.

p_sh · 28.12.2005, 15:07

может быть в dwt шаблоне есть встроенный макрос, и по этому vba грузится автоматом. (соответственно он есть и вовсех созданных по этому шаблону файлах. и при их загрузке автоматом подгружаются vba.
Выковырять их можно так:
запустить диспетчер vba: сервис->макросы-> диспетчер vba
в диалоговом окне - кнопка в рамке "Рисунок" - ИЗВЛЕЧЬ
или по п 2. см выше.
хотя обычно макросы (хорошие) позволяют несколько расширить акад и повысить производительность.
опущусь до саморекламы
http://dwg.ru/dwl/453

p_sh · Регистрация: 19.06.2005

Цитата:

Сообщение от alle

Уважаемые коллеги
Посоветуйте литературу и проч. по использованию VBA для разработки пользовательских приложений применительно к AutoCAD

я частенько заглядывал в Интернет учебники vbnet.ru и т.п. по vb- очень помогало.

C1 · 28.12.2005, 20:58

Цитата:

Сообщение от p_sh

в vba получается косовато: нет динамического вида создаваемых объектов (максимум резиновая лента). если есть оригинальные задумки лучше сразу изучать си и писать .arx приложения.

Использую для динамической вставки создаваемых объектов буфер обмена через SendCommand:
"_copybase 0,0,0 l "
"_erase l "
"_pasteclip"

Agens · 04.05.2009, 13:55

Может есть тут специалисты по VBА, хочу для ACADа на VBA реализовать след. вещь - поиск элементов (линий, блоков и т.д.) аналог команды - "_qselect". Для начала надо найти в чертеже все блоки с именем "*Ux", где х - лубое число от 0 до 1000 и выбрать их... можте кто поможет, подскажет...
или может кто пример скинет, чтобы просто выбирал все линии, а я потом разберусь как нить... Спасибо... Жду...

Сергей Дубина · 12.05.2009, 18:00

Sub Example()
Dim BlockObj As AcadBlockReference
Dim entry As AcadEntity

For Each entry In ThisDrawing.ModelSpace

If entry.ObjectName = "AcDbBlockReference" Then
Set BlockObj = entry
MsgBox BlockObj.Name 'имя текущего блока, дальше делай с ним что нужно
'(перебираются все вхождения блоков в модели)
End If
Next
End Sub

Dima13 · Регистрация: 15.03.2010

Друзья, подскажите пожалуйста начинающему программисту.
У меня есть фрагмент программного кода, который ищет первый приметив и выводит его имя:

Код:

[Выделить все]

[size=3]Sub FindFirstEntity()[/size]
[size=3]On Error Resume Next[/size]
[size=3]Dim entity As AcadEntity[/size]
[size=3]If ThisDrawing.ModelSpace.count <> 0 Then[/size]
[size=3]Set entity = ThisDrawing.ModelSpace.Item(0)[/size]
[size=3]MsgBox entity.ObjectName + " первый примитив в пространстве модели."[/size]
[size=3]Else[/size]
[size=3]MsgBox "Нет ни одного объекта в пространстве модели."[/size]
[size=3]End If[/size]
[size=3]End Sub[/size]

[size=3]А как мне вывести не имя, а его координаты (x, y)? Заранее благодарю![/size]

Кулик Алексей aka kpblc · 15.03.2010, 11:43

Интересно... а какие координаты должны быть в результате, например, у выноски? Или у размера?

Dima13 · 15.03.2010, 12:42

Цитата:

Сообщение от Кулик Алексей aka kpblc

Интересно... а какие координаты должны быть в результате, например, у выноски? Или у размера?

Да, вы правы, но меня интересуют координаты только текста.

AlexV · 15.03.2010, 13:03

Цитата:

Сообщение от Dima13

Да, вы правы, но меня интересуют координаты только текста.

Добавь после

Код:

[Выделить все]

Set entity = ThisDrawing.ModelSpace.Item(0)

:

Код:

[Выделить все]

Dim pnt
If TypeName(entity) = "IAcadText" Then
  pnt = entity.InsertionPoint
  MsgBox "X=" & pnt(0) & " Y=" & pnt(1)
End If

Dima13 · 15.03.2010, 15:02

Цитата:

Сообщение от AlexV

Добавь после

Код:

[Выделить все]

Set entity = ThisDrawing.ModelSpace.Item(0)

:

Код:

[Выделить все]

Dim pnt
If TypeName(entity) = "IAcadText" Then
  pnt = entity.InsertionPoint
  MsgBox "X=" & pnt(0) & " Y=" & pnt(1)
End If

Спасибо, получилось

Кулик Алексей aka kpblc · 15.03.2010, 15:15

Это "получилось" до тех пор, пока у текста (если, конечно, имеется в виду именно однострочный текст) выравнивание установлено "вниз-влево".

AlexV · 15.03.2010, 16:52

Цитата:

Сообщение от Кулик Алексей aka kpblc

Это "получилось" до тех пор, пока у текста (если, конечно, имеется в виду именно однострочный текст) выравнивание установлено "вниз-влево".

Ну, ошибки код не выдает и при другом выравнивании..

Кулик Алексей aka kpblc · 15.03.2010, 20:46

Ошибку-то он не выдаст. Но вот какие результаты?
Создаем примитив TEXT следующим лиспом (ну так, чтобы запутать

):

Код:

[Выделить все]

(defun test ()
  (entmakex '((0 . "TEXT")
	      (100 . "AcDbEntity")
	      (100 . "AcDbText")
	      (10 0. 0. 0.0)
	      (40 . 2.5)
	      (1 . "qwerty")
	      (50 . 0.0)
	      (41 . 0.75)
	      (51 . 0.0)
	      (71 . 0)
	      (72 . 1)
	      (11 17457.5 15522.3 0.0)
	      (210 0.0 0.0 1.0)
	      (100 . "AcDbText")
	      (73 . 2)
	      )
	    ) ;_ end of entmakex
  ) ;_ end of defun

И прочитай его InserionPoint

Я сейчас проверить и написать код не могу, но сильно подозреваю, что результатом будет значение 10 группы...

AlexV · 15.03.2010, 22:12

Цитата:

Сообщение от Кулик Алексей aka kpblc

Ошибку-то он не выдаст. Но вот какие результаты?
Создаем примитив TEXT следующим лиспом (ну так, чтобы запутать

):
И прочитай его InserionPoint

Я сейчас проверить и написать код не могу, но сильно подозреваю, что результатом будет значение 10 группы...

...Я не знаю, кто такая Чили... и какое значение у 10 группы..

но у созданного текста есть значение InserionPoint... (фиолетовая точка на рисунке). Можно использовать TextAlignmentPoint, тогда получим координаты зеленой точки. Можно через

Код:

[Выделить все]

entity.GetBoundingBox p1, p2
pnt(0) = (p1(0) + p2(0)) / 2
pnt(1) = (p1(1) + p2(1)) / 2

получить красную точку.. Смотря что нужно..

Кулик Алексей aka kpblc · 15.03.2010, 22:31

http://www.arcada.com.ua/forum/viewtopic.php?t=653
Offtop: Cейчас в раздумках - вносить статью на сайт autolisp или нет...

michvp · 29.11.2014, 21:26

Очень нужно! Раньше с атрибутами не связывался, не было нужды...
Мне нужно, выделив блок, забрать в MsgBox или в текстовое окно на форме значение атрибута блока.

maratovich · 29.11.2014, 21:38

Цитата:

Сообщение от michvp

Очень нужно!

Вот для начала пример, а далее уже добавите что требуется.

Сергей812 · 30.11.2014, 18:12

Если хотите писать на VBA под 64битный автокад старых версий (вроде в 2014 только новый VBA появился) - то ожидайте "приятных" сюрпризов. Так как нормального 64битного VBA в старых версиях нет, есть лишь обертки над 32битным.. И поэтому может быть все что угодно - у меня "последней каплей" стало периодическое пропадание стандартных функций типа "Mid" во время вызова макросов)

michvp · 30.11.2014, 19:26

Мне нужно просто переменной присвоить значение атрибута блока, который будет выделен мышкой. На сегодняшний день я вынужден вначале запускать Lisp-программу, которая атрибуты переводит в однострочный текст, а потом МОЕЙ программой на VBA забирать этот текст куда мне надо. Я очень хочу уйти от использования Lisp программы, так как не хочу разрушать блоки.

Сергей812 · 30.11.2014, 19:39

Ваше право, хотя чем больше занимаюсь лиспом - тем больше очаровываюсь его элегантностью) Хотя сложные вещи - однозначно NET (из знакомых технологий), имхо.
У вас блок статический, динамический?

----- добавлено через ~9 мин. -----
Точнее атрибут. Для статических атрибутов будет выглядеть примерно так код

Сейчас в блокноте напишу примерный код) А то глючит форма ввода

----- добавлено через ~7 мин. -----
В общем, примерно (написан на коленке) такой код:

Код:

[Выделить все]

Dim lBlock As AcadBlockReference
Dim lAttrBlock As Object
Dim I1 As Integer

'Если у блока есть атрибут
If (lBlock.HasAttributes) Then
	' Получаем атрибуты блока   
	lAttrBlock = lBlock.GetAttributes()
   	For I1 = 0 To UBound(lAttrBlock)
		if(lAttrBlock(I1).TagString = "%Имя атрибута откуда взять значение%")then
			' И получаем значение атрибута
			% Ваша переменная %=lAttrBlock(I1).TextString
                        Exit For
		End If	

   	Next I1
End If

можете оформить в виде функции, принимающей ссылку на блок ( lBlock) и (Название атрибута), можете так использовать.

----- добавлено через ~4 ч. -----
Да, если где то будет ругаться при присваивании - что типа требуется объект, то перед переменной ставите Set %Переменная% = %Выражение%. Выдирал из старого проекта на VB.NET, там чуть синтаксис отличается.

michvp · 01.12.2014, 07:59

К сожалению код в среде VBA не работает (дает ошибку) VB.net я не знаю. У меня много разных наработок на VBA и очень не хватает теперь этой возможности получить атрибут. Кстати блок у меня динамический, тег у блока например
"WWWW", нужно нажать кнопку на моей форме (немодальной), указать мышкой блок и получить в окне формы значение атрибута

michvp · 01.12.2014, 08:10

К сожалению код на VBA не работает.

trir · 01.12.2014, 08:31

Цитата:

Сообщение от michvp

К сожалению код на VBA не работает.

Какой?

michvp · 01.12.2014, 08:38

Код "Сергей812" на VBA не работает. Мне нужно получит value атрибута блока, который я выделю мышкой

Dim lBlock As AcadBlockReference
Dim lAttrBlock As Object
Dim I1 As Integer

'Если у блока есть атрибут
If (lBlock.HasAttributes) Then
' Получаем атрибуты блока
lAttrBlock = lBlock.GetAttributes()
For I1 = 0 To UBound(lAttrBlock)
if(lAttrBlock(I1).TagString = "%Имя атрибута откуда взять значение%")then
' И получаем значение атрибута
% Ваша переменная %=lAttrBlock(I1).TextString
Exit For
End If

Next I1
End If

trir · 01.12.2014, 08:44

Цитата:

который я выделю мышкой

Где? Не вижу!

michvp · 01.12.2014, 09:00

У меня есть в модели блоки с атрибутами, например блок в виде круга и атрибут - цифра. Например геодезические отметки. Мне нужно например в MsgBox вывести значение атрибута (цифры-отметки).

trir · 01.12.2014, 09:08

Цитата:

Сообщение от michvp

У меня есть в модели блоки с атрибутами, например блок в виде круга и атрибут - цифра. Например геодезические отметки. Мне нужно например в MsgBox вывести значение атрибута (цифры-отметки).

И?

Код:

[Выделить все]

   Dim returnObj As AcadObject
   Dim basePnt As Variant
   ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select an object"
   If returnObj.ObjectName = "AcDbBlockReference" Then
    MsgBox "good"
   End If

Сергей812 · 01.12.2014, 10:02

Цитата:

Сообщение от michvp

К сожалению код на VBA не работает.

Чего именно не работает? И на этапе компиляции программы ругается, или ничего не делает? Если второе - переменной lBlock было присвоено значение?

Кулик Алексей aka kpblc · 01.12.2014, 10:02

trir, может, не GetEntity, а GetSubEntity?

Код:

[Выделить все]

Sub Example_GetSubEntity()
    ' This example prompts the user to select on object on the screen with a mouse click,
    ' and returns some information about the selected object.
    
    Dim Object As Object
    Dim PickedPoint As Variant, TransMatrix As Variant, ContextData As Variant
    Dim HasContextData As String
    
    On Error GoTo NOT_ENTITY
        
TRYAGAIN:
        
    MsgBox "Use the mouse to click on an object in the current drawing after dismissing this dialog box."
        
    ' Get information about selected object
    ThisDrawing.Utility.GetSubEntity Object, PickedPoint, TransMatrix, ContextData
    
    ' Process and display selected object properties
    HasContextData = IIf(VarType(ContextData) = vbEmpty, " does not ", " does ")
    
    MsgBox "The object you chose was an: " & TypeName(Object) & vbCrLf & _
            "Your point of selection was: " & PickedPoint(0) & ", " & _
                                              PickedPoint(1) & ", " & _
                                              PickedPoint(2) & vbCrLf & _
            "This object" & HasContextData & "have nested objects."
    
    Exit Sub
    
NOT_ENTITY:
    ' If you click on empty space or do not select an entity,
    ' this error will be generated
    If MsgBox("You have not selected an object.  Click OK to try again.", _
               vbOKCancel & vbInformation) = vbOK Then
        Resume TRYAGAIN
    End If
End Sub

michvp · 01.12.2014, 11:42

Код работает, только мне нужно, чтобы еще в MsgBox заходило значение атрибута блока, когда я на нем щелкну курсором в виде квадратика.
Данный код пишет, что объект - атрибут и дает координаты, а нужно ЗНАЧЕНИЕ конкретного атрибута

Кулик Алексей aka kpblc · 01.12.2014, 11:49

Получи указатель на вхождение атрибута и сними TextString (кажется, так).

michvp · 01.12.2014, 12:02

Не совсем понятно, что нужно сделать...
Если бы у меня был не атрибут, а однострочный текст, то переменной txt присваивается значение:
txt = ActiveDocument.ActiveSelectionSet.Item(0).textString
А как у атрибута это же сделать?

trir · 01.12.2014, 12:13

michvp, тебе просто надо скрестить код Кулик Алексей aka kpblc и Сергей812 (а именно методом GetSubEntity получить блок в переменую lBlock)

AlexV · 01.12.2014, 13:17

че то типа где то как то..

Код:

[Выделить все]

Dim returnObj As AcadObject, Attr
Dim basePnt As Variant
ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select an object"
If returnObj.ObjectName = "AcDbBlockReference" Then
 For Each Attr In returnObj.GetAttributes
   If Attr.TagString = "(имя нужного атрибута)" Then
	msgbox Attr.TextString
   End If
 next
End If

michvp · 01.12.2014, 15:05

Спасибо большее. Все получилось. Мне это и нужно было!

Boxa · 02.12.2014, 18:13

Offtop: Вот молодец michvp, ловко провернул.
Сначала сказал что у него есть программа на VBA:

Цитата:

Сообщение от michvp

а потом МОЕЙ программой на VBA забирать

Ему коды из справки накидали, но он шлангом прикинулся и в итоге за него все написали. Хотя любой, кто написал СВОЮ программу на VBA под автокад или офис, эти куски кода собрал бы в легкую, да и вообще подобного вопроса не задал бы, т.к. как работать с атрибутами в справке написано. Молодец. Я вот так не умею, потому и восхищаюсь.

Вопрос к админам: А название топика разве не нарушает п.4.3 правил форума?

trir · 02.12.2014, 18:55

offtop: Низкий КПД однако, я за это время бы написал нормальный импорт txt/xml формата

Сергей812 · 02.12.2014, 19:42

толку от того, что он получил значение атрибута?)
Но вот упоминания: я в программировании не силен, нету времени разбираться и т.д. - давно уже пора внести в список отягчающих... ) не видно-что человек хоть что-то пытался сам сделать... в программировании ему делать нечего, имхо

AlexV · 02.12.2014, 22:25

Цитата:

Сообщение от Boxa

[offtop]Вопрос к админам: А название топика разве не нарушает п.4.3 правил форума?

Тема родилась в славные либерально-демократичные времена, когда еще не было бота, отслеживающего нарушение п.4.3 ..

michvp · 03.12.2014, 08:11

Поясняю для BOXA: Атрибуты не использовал, а если встречались, то применял программу <bgtools2.27.lsp>, которая превращала значения атрибутов в однострочный текст.
Затем моей программой на VBA получал координаты нужных мне объектов и однострочного текста, в который превращались атрибуты. Теперь я понял, как можно напрямую получать значение атрибута и, естественно, включил фрагмент этого кода в свою программу. Кстати, хотелось бы все переписать на Lisp, пока его изучаю. Еще раз спасибо за возможность разобраться с кодом для получения атрибутов. В справке было не понятно.

Boxa · 03.12.2014, 09:44

Offtop: michvp, Вы оправдываетесь? Так тут не перед кем оправдываться, все и так все видят и понимают. В любом случае, мне понравилось как вы это сделали.

trir · 03.12.2014, 11:26

Offtop: Подозреваю, будет проще взять Civil 3D и не мучатся...

27.12.2005, 21:04		#1
VBA в AutoCAD alle Регистрация: 11.08.2005 Сообщений: 921 Уважаемые коллеги Посоветуйте литературу и проч. по использованию VBA для разработки пользовательских приложений применительно к AutoCAD
Просмотров: 17907