[alle]

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

[Кулик Алексей aka kpblc]

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

[michvp]

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

[maratovich]

Сообщение от michvp Очень нужно!

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

[Сергей812]

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

[michvp]

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

[Сергей812]

Ваше право, хотя чем больше занимаюсь лиспом - тем больше очаровываюсь его элегантностью) Хотя сложные вещи - однозначно 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]

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

[michvp]

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

[trir]

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

Какой?

[michvp]

Код "Сергей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]

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

Где? Не вижу!

[michvp]

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

[trir]

Сообщение от 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]

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

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

[Кулик Алексей aka kpblc]

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]

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

[Кулик Алексей aka kpblc]

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

[michvp]

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

[trir]

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

[AlexV]

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

Код:

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

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