[best_vint]

здравствуйте, уважаемые, подскажите, есть ли возможность получить в vba метку объекта, через отладчик копался, не нашёл.
Буду благодарен за любую информацию)
Спасибо.

[maratovich]

Сообщение от best_vint получить в vba метку объекта

А что Вы подразумеваете под понятием "метка" ?

[best_vint]

к объектам через связь привязаны строки экселя, через шаблон метки, контекстное меню на объекте:
связь и метка
вот меня интересует метка
Хотя скорее нет, интересует достать данные из связи, если есть возможность
maratovich, а какие понятия под слово метка и autocad Вам приходят в голову, когда вы читали мой вопрос? Спасибо.

[Сергей812]

ну первое - что приходит на ум при "метке" объекта - это его хендл (handle). Его имеют все визуальные объекты в чертеже, хэндл уникален в пределах чертежа.

----- добавлено через ~2 мин. -----
но в целом, опять, гадание на кофейной гуще... Как к объектам привязаны строки экселя? и т.д.

[maratovich]

best_vint
Я думаю если Вы скажете что именно Вы хотите получить в конечном результате, то будет лучше т.к. если не знать что делать, можно и неверно действовать.
Сергей812 верно сказал хендл, при определённых условиях ID. Можно вообще с атрибутами работать (если блоки), а если использовать DXF то вообще круто получится
Ну и как всегда - пример в студию !

[best_vint]

Сообщение от maratovich best_vint Я думаю если Вы скажете что именно Вы хотите получить в конечном результате, то будет лучше т.к. если не знать что делать, можно и неверно действовать. Сергей812 верно сказал хендл, при определённых условиях ID. Можно вообще с атрибутами работать (если блоки), а если использовать DXF то вообще круто получится Ну и как всегда - пример в студию !

согласен, вот решил что метки не совсем то)
Я про диспетчер подключения к БД, там есть запросы связи, и строку таблицы данных можно привязать к объету(объектам), так вот и интересует возможность вытащить данные из этой таблицы для конкретного объекта. Может кто нибудь подсказать? Как конкретнее описать, уже незнаю)
Жду Ваших ответов, спасибо.

[trir]

Это называется dbConnect http://adndevblog.typepad.com/autoca...-and-lisp.html
раньше был chm-файл со справкой

[best_vint]

Сообщение от trir Это называется dbConnect http://adndevblog.typepad.com/autoca...-and-lisp.html раньше был chm-файл со справкой

А то я в объектной модели autocad vba смотрел и что-то не нашёл этих связей)
Спасибо Вам большое, помоему как раз то, что мне нужно, завтра на работе попробую разобраться, в этом у меня главная загвозтка была)

[maratovich]

Вот ещё пригодится.

[best_vint]

Сообщение от maratovich Вот ещё пригодится.

спасибо, тоже пригодится, буду разбираться.

[Александр Ривилис]

Сообщение от Сергей812 Его имеют все визуальные объекты в чертеже, хэндл уникален в пределах чертежа.

Не только "визуальные объекты", но и вообще все объекты чертежа. В том числе слои, типы линий, текстовые и размерные стили и т.д.

[best_vint]

Уважаемые, всем большое спасибо за помощь, вроде что-то получается. После окончания хотел бы выложить код, чтобы другим было удобнее разбираться, подскажите вот что, почему когда копирую код из vba на форум или в блокнот, то русские комменты превращаются в знаки вопросов. Спасибо.

[swell{d}]

гы, перед копированием поставь русскую раскладку клавиатуры и затем копируй =)

[best_vint]

Сообщение от swell{d} гы, перед копированием поставь русскую раскладку клавиатуры и затем копируй =)

и правда))) Спасибо)
Доделаю, выложу код) и формочку)

[best_vint]

Ещё вопрос, не пойму в чём дело, на строке rs.MoveFirst -выскакивает ошибка-Драйвер ODBC Excel - Переполнение числового поля.
Вот код, соответственно весь выкладывать пока не буду, вот та чать:

Код:

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

    Dim cmd As ADODB.Command
    Set rs = Nothing
    Set rs = New ADODB.Recordset
    Set cmd = New ADODB.Command
    Set cmd.ActiveConnection = ADOConnect
    cmd.CommandText = "SELECT * from " + strTable
    rs.Open cmd, , ADODB.adOpenKeyset, ADODB.adLockBatchOptimistic
  

    Dim Field As ADODB.Field
   
        For Each Field In rs.Fields: ComboBox2.AddItem Field.Name 'НАЧАЛО_наполняем комбоксы 2 и 3
        ComboBox3.AddItem Field.Name
        Next Field 'КОНЕЦ_наполняем комбоксы 2 и 3
    ComboBox2.Value = ComboBox2.List(1) 'устанавливаем значение комбобокса поумалчанию
    ComboBox3.Value = ComboBox3.List(4) 'устанавливаем значение комбобокса поумалчанию
    Dim Count As Integer: Count = 0 'внутренний счётчик для шагания по базе данных по строкам
    'rs.MoveFirst
    Do While Not rs.EOF
    Count = Count + 1
    rs.MoveNext 'пойдём по строкам нашей базы данных
    Loop
    ReDim DataConnect(Count, CInt(rs.Fields.Count)) As String 'переопределяем массив, в который мы читаем из базы данных
    rs.MoveFirst 'перейдём на первую строку нашей базы данных

для одной связи(таблицы)работает, для другой значение EOF сразу true, непонятно

[trir]

Код:

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

rs.MoveLast
rs.MoveFirst

[best_vint]

Сообщение от trir Код: [Выделить все] rs.MoveLast rs.MoveFirst

не понимаю Вас, я насколько понял чтение из бд пустое, как прыжки по базе помогут?)

[trir]

Или это для DAO...
http://www.techrepublic.com/blog/10-...rdset-objects/

Код:

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

If Not(rst.BOF And rst.EOF) Then

[best_vint]

Сообщение от trir Или это для DAO... http://www.techrepublic.com/blog/10-...rdset-objects/ Код: [Выделить все] If Not(rst.BOF And rst.EOF) Then

Спасибо, вот так сделал

Код:

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

     Dim Count As Integer: Count = 0 'внутренний счётчик для шагания по базе данных по строкам
    'rs.MoveFirst
    Do While Not rs.EOF
    Count = Count + 1
    rs.MoveNext 'пойдём по строкам нашей базы данных
    Loop
    ReDim DataConnect(Count, CInt(rs.Fields.Count)) As String 'переопределяем массив, в который мы читаем из базы данных
    If Count <> 0 Then

Из положения вышел, но почему база данных из одной читается, а из другой нет?(

----- добавлено через ~19 ч. -----
Код программы, как и обещал. Из изменённых свойств кнопок- это свйоство Enabled на False(на картинке видно).
TextBox1-забыл подписать это текст бокс и он всего один на экране, найдёте я думаю.
Как поднимал вопрос выше, программка работает не со всеми запросами из БД.
Код программы- это то, что находил на разных сайтах, адаптировал, а так же использовал пример автокада, и конечно же Ваши ссылки, спасибо за них.
Надеюсь людям пригодится, темболее что dwg.ru очень хорошо отображается в поиске
Да, не везде исправлены ошибки или предусмотрены варианты обработки событий, слепил как научился, если кто то сможет подсказать как упростить программу, буду рад.

Вот код как и обещал:

Код:

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

'данная программа записывает в гиперссылки выбранных объектов значения из связанной базы данных
'всё это происходит в активном документе

'
'
'
'ВНИМАНИЕ: не забудьте подключить библиотеки CAO 1.0 type library
'и библиотеку Microsoft ActiveX Data Objects x.x Library
'библиотеки подключаются через меню Tools->References...-должна стоять галочка у нужных библиотек

'объявляем глобальные переменные
Public SSetColl As IAcadSelectionSet 'создаём набор элементов, в который добавим потом выделением
Public labelTemplates As CAO.labelTemplates
Public Doc As AcadDocument
Public databa As dbConnect
Public objLinkTemplate As CAO.LinkTemplate
Dim objIds() As Long 'массив данных с ObjectID
Dim linkNow() As Long 'массив данных с ObjectID и ссылками
Dim DataConnect() As String 'массив, в который мы читаем из базы данных
'Глобальные переменные для ADO
Dim ADOConnect As New ADODB.Connection 'Создание подключения к таблице Excel
Dim rs As ADODB.Recordset 'Открываем набор данных

Private Sub ComboBox1_Click()
    Set objLinkTemplate = databa.GetLinkTemplates().Item(CInt(ComboBox1.ListIndex))
End Sub

Private Sub ComboBox2_Change()
If ComboBox2.Value = ComboBox3.Value Then
MsgBox "Выбирите другое значение в этом поле." + vbCrLf + "Значения в обоих полях не могут быть одинаковыми."
Else
    If ComboBox2.Text <> "" And ComboBox3.Text <> "" Then
        TextBox1.Text = " " 'НАЧАЛО_заполняем поле текстбокс
        For i = 0 To UBound(DataConnect)
        TextBox1.Text = TextBox1.Text & vbCrLf & DataConnect(i, ComboBox2.ListIndex) & "@" & DataConnect(i, ComboBox3.ListIndex) & ";"
        Next i 'КОНЕЦ_заполняем поле текстбокс
    End If
End If
End Sub

Private Sub ComboBox3_Change()
If ComboBox2.Value = ComboBox3.Value Then
MsgBox "Выбирите другое значение в этом поле." + vbCrLf + "Значения в обоих полях не могут быть одинаковыми."
Else
    If ComboBox2.Text <> "" And ComboBox3.Text <> "" Then
        TextBox1.Text = " " 'НАЧАЛО_заполняем поле текстбокс
        For i = 0 To UBound(DataConnect)
        TextBox1.Text = TextBox1.Text & vbCrLf & DataConnect(i, ComboBox2.ListIndex) & "@" & DataConnect(i, ComboBox3.ListIndex) & ";"
        Next i 'КОНЕЦ_заполняем поле текстбокс
    End If
End If
End Sub

Private Sub CommandButton1_Click()

UserForm1.Hide
ThisDrawing.SendCommand "медвед2" & vbCr 'чтобы использовать вывод в командную строку, нужно скрыть форму
Exit Sub
End Sub

Private Sub DataBaseToHyperlink_Click()
Dim linkSel As CAO.Links: Set linkSel = databa.GetLinks(objLinkTemplate, objIds, 0)

For i = 0 To UBound(linkNow) 'это внешний цикл мы идём по выделенным объектам они у нас записаны в objIds()
    For j = 0 To linkSel.Count - 1 'НАЧАЛО_получаем номер ключевого поля для каждого objectID в выделенной нами коллекции
        If linkNow(i, 0) = linkSel.Item(j).ObjectID Then
            If linkSel.Item(j).KeyValues.Count - 1 >= 1 Then 'пройдёмся по запросу
            MsgBox "В элементе с ID: " & linkSel.Item(j).ObjectID & " присвоено несколько значений в базе, что недопустимо" 'спорный вопрос, тут можно и переделать будет
            Else: linkNow(i, 1) = linkSel.Item(j).KeyValues.Item(0).Value 'запишем данные ИД и ключ в массив двумерный
            End If
         End If
    Next j
Next i 'КОНЕЦ_получаем номер ключевого поля для каждого objectID
'теперь пройдёмся по выделенным объектам(объектам из коллекции)
For i = 0 To SSetColl.Count - 1
'проверим, есть ли у объекта гиперссылка, если её нету, то создадим её.
If SSetColl.Item(i).Hyperlinks.Count = 0 And linkNow(i, 1) <> 0 Then 'проверяем, есть ли у текущего объекта гиперссылка, если нету, то добавляем
SSetColl.Item(i).Hyperlinks.Add ("новая гиперссылка")
End If
If SSetColl.Item(i).Hyperlinks.Count <> 0 Then 'если есть гиперссылка у объекта, то пишем туда
    If linkNow(i, 1) = 0 Then 'проверяем, в данном объекте есть ли ссылка на выбранный запрос, запрос выбираем в ComboBox1
    MsgBox "В объекте с ID: " & linkNow(i, 0) & " ссылка на данный запрос из БД отсутствует"
    Else
    SSetColl.Item(i).Hyperlinks.Item(0).URLDescription = DataConnect(linkNow(i, 1) - 1, ComboBox2.ListIndex) & "@" & DataConnect(linkNow(i, 1) - 1, ComboBox3.ListIndex)
    SSetColl.Item(i).Hyperlinks.Item(0).URL = "about: blank"
    End If
End If
Next i
DataBaseToHyperlink.Enabled = True 'разблокируем кнопку, для последующих действий
End Sub

Private Sub DbConnectButton_Click()
    Dim strDataSource As String
    strDataSource = objLinkTemplate.Datasource
    If Not databa.IsConnected(strDataSource) Then dbConnect.Connect strDataSource
    Dim strDataSourceLoc As String
    strDataSourceLoc = databa.DataSourceLocation + "\"
    
    If ADOConnect.State = adStateOpen Then ADOConnect.Close
    currConnectionString = "File Name=" + strDataSourceLoc + strDataSource + ".udl;User ID=;Password=;"
    ADOConnect.ConnectionString = currConnectionString
    ADOConnect.Open
If ADOConnect.State = adStateOpen Then 'НАЧАЛО_проверка подключения к базе данных
MsgBox strDataSource + " база данных подключена." + msgStr + vbCrLf + " Version = " + ADOConnect.Version + msgStr + " Provider = " + ADOConnect.Provider
Else
MsgBox "Нету подключения к базе данных " & strDataSource
End If 'КОНЕЦ_проверка подключения к базе данных
    ComboBox2.Clear: ComboBox3.Clear 'почистим комбобоксы для заполнения
    
    Dim strTable As String
    strTable = objLinkTemplate.Table 'таблица в базе данных, к которой мы подключаемся
    Dim cmd As ADODB.Command
    Set rs = Nothing
    Set rs = New ADODB.Recordset
    Set cmd = New ADODB.Command
    Set cmd.ActiveConnection = ADOConnect
    cmd.CommandText = "SELECT * from " + strTable
    rs.Open cmd, , ADODB.adOpenKeyset, ADODB.adLockBatchOptimistic
  

    Dim Field As ADODB.Field
   
        For Each Field In rs.Fields: ComboBox2.AddItem Field.Name 'НАЧАЛО_наполняем комбоксы 2 и 3
        ComboBox3.AddItem Field.Name
        Next Field 'КОНЕЦ_наполняем комбоксы 2 и 3
    Dim Count As Integer: Count = 0 'внутренний счётчик для шагания по базе данных по строкам
    'rs.MoveFirst
    Do While Not rs.EOF
    Count = Count + 1
    rs.MoveNext 'пойдём по строкам нашей базы данных
    Loop
    ReDim DataConnect(Count, CInt(rs.Fields.Count)) As String 'переопределяем массив, в который мы читаем из базы данных
    If Count <> 0 Then
        rs.MoveFirst 'перейдём на первую строку нашей базы данных
        Count = 0
        Do While Not rs.EOF
            Count = Count + 1
            For i = 0 To rs.Fields.Count - 1
                If IsNull(rs.Fields(i)) = False Then
                DataConnect(Count - 1, i) = CStr(rs.Fields(i))
                Else: DataConnect(Count - 1, i) = "0"
                End If
            Next i
            rs.MoveNext
        Loop
    Else
        MsgBox "База данных пустая, либо не была прочитана"
    End If
   rs.Close 'закрываем соединение
     ComboBox2.Value = ComboBox2.List(1) 'устанавливаем значение комбобокса поумалчанию
    ComboBox3.Value = ComboBox3.List(4) 'устанавливаем значение комбобокса поумалчанию
 
DataBaseToHyperlink.Enabled = True 'разблокируем кнопку, для последующих действий
End Sub
Private Sub SetObjectsButton_Click()
Dim i As Long
Dim j As Long
UserForm1.Hide 'скрываем форму
Dim k As Long
Dim DocIndex As Long
DataBaseToHyperlink.Enabled = False 'блокируем кнопку DataBaseToHyperlink на всякий случай, при повторном нажатии в форме
If Application.Documents.Count > 0 Then 'НАЧАЛО_ищем номер активного документа из всех открытых
UserForm1.Hide
k = 0
For k = 0 To Application.Documents.Count - 1
    If Application.Documents.Item(k).Name = Application.ActiveDocument.Name Then
    DocIndex = k
    Exit For
    End If
    k = k + 1
Next k
End If
Set Doc = Documents.Item(DocIndex) 'КОНЕЦ_ищем номер активного документа из всех открытых
'DataBaseToHyperlink.Enabled = True
    If Application.ActiveDocument.SelectionSets.Count > 0 Then 'НАЧАЛО_удаляем все имеющиеся коллекции примитивов
    Do Until j = Application.ActiveDocument.SelectionSets.Count
    Application.ActiveDocument.SelectionSets.Item(j).Delete
    Loop
    End If 'КОНЕЦ_удаляем все имеющиеся коллекции примитивов
Set SSetColl = Application.ActiveDocument.SelectionSets.Add("123") 'создаём коллекцию примитивов, с которой потом будем работать
SSetColl.SelectOnScreen 'для добавления во вновь созданную коллекцию, необходимо выделить на экране

    If SSetColl.Count = 0 Then
    MsgBox "Ничего не выбрано"
    DataBaseToHyperlink.Enabled = False
    UserForm1.Show
    End If
Set databa = AutoCAD.GetInterfaceObject("CAO.DbConnect.16")
ReDim objIds(0 To SSetColl.Count - 1) As Long 'переопределяем массив элементов которые мы выделили
ReDim linkNow(CInt(UBound(objIds)), 1) As Long 'переопределяем массив элементов итоговый
For i = 0 To SSetColl.Count - 1
objIds(i) = SSetColl.Item(i).ObjectID 'в массив добавляем id выбранных элементов
linkNow(i, 0) = objIds(i) 'в массив общий запишем сразу id выбранных объектов
Next i
ComboBox1.Clear
For i = 0 To databa.GetLinkTemplates().Count - 1
ComboBox1.AddItem databa.GetLinkTemplates().Item(i).Name 'в ComboBox1 добавляем имена запросов
Next i
ComboBox1.Value = ComboBox1.List(0)
DbConnectButton.Enabled = True
UserForm1.Show
End Sub
Private Sub UserForm_Initialize()
MsgBox "Для корректной работы программы необходимо подключить используемую базу данных."
End Sub

Private Sub UserForm_Terminate()
    If Application.ActiveDocument.SelectionSets.Count > 0 Then 'НАЧАЛО_удаляем все имеющиеся коллекции примитивов
    Do Until j = Application.ActiveDocument.SelectionSets.Count
    Application.ActiveDocument.SelectionSets.Item(j).Delete
    Loop
    End If 'КОНЕЦ_удаляем все имеющиеся коллекции примитивов
End Sub