Связь Autocad VBA с Access

Автор Тема: Связь Autocad VBA с Access  (Прочитано 2646 раз)

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

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

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Связь Autocad VBA с Access
« : 14-02-2019, 18:35:02 »
Здравствуйте. Пытаюсь решить простенькую задачку. Есть Программа под Autocad. С помощью формы загружаю нужный блок с атрибутами (как на картинке)



Блок вставляется нормально. Но есть проблема. Я не могу связать выпадающие списки с ячейками в базе данных.



Идеальная работа программы такова: открывается форма, далее мы выбираем из открывающегося списка нужное нам название из базы данных, нажимаем добавить и появляется этот блок но в местах атрибута - выбранный из базы текст.

Как альтернативу можно за место access использовать просто файл excel

Код формы
Код - Visual Basic [Выбрать]
  1. Option Explicit
  2.  
  3.  
  4. Private Sub ComboBox1_Change()
  5.  
  6. End Sub
  7.  
  8. Private Sub ComboBox2_Change()
  9.  
  10. End Sub
  11.  
  12. Private Sub ComboBox3_Change()
  13.  
  14. End Sub
  15.  
  16. Private Sub Frame1_Click()
  17.  
  18. End Sub
  19.  
  20. Private Sub Label3_Click()
  21.  
  22. End Sub
  23.  
  24.  
  25. Private Sub UserForm_Initialize()
  26.   Dim intCnt As Integer
  27.   Dim objAcBlocks As AcadBlocks
  28.   Dim objAcBlock As AcadBlock
  29.  
  30.   Set objAcBlocks = ThisDrawing.Blocks
  31.   ' Заполняем список именами блоков
  32.  For Each objAcBlock In objAcBlocks
  33.     If Not Left(objAcBlock.name, 1) = "*" Then
  34.     ' Нам не нужны анонимные блоки и блоки типа
  35.    ' *Model_Spase и *Paper_Spase
  36.      ComboBox2.AddItem objAcBlock.name
  37.     End If
  38.   Next
  39.   ComboBox2.ListIndex = 0
  40.  
  41.   CommandButton1.Caption = "Вставить"
  42.  
  43.   Label2.Caption = "Выбрать тип штампа"
  44.   Label1.Caption = "Масштаб"
  45.  
  46.   For intCnt = 1 To 10
  47.     ComboBox1.AddItem intCnt
  48.   Next intCnt
  49.     ComboBox1.ListIndex = 0
  50.     CheckBox1.Caption = "Указать точку вставки"
  51.  
  52. End Sub
  53.  
  54. Private Sub CommandButton1_Click()
  55.   Dim varInsPnt As Variant
  56.   Dim dblBlkScale As Double
  57.   Dim blnScale As Boolean
  58.   Dim strBlock As String
  59.  
  60.   If Len(ComboBox1.Text) > 0 Then
  61.     blnScale = True
  62.     dblBlkScale = ComboBox1.Text
  63.   End If
  64.   If Len(ComboBox2.Text) > 0 Then
  65.     strBlock = ComboBox2.Text
  66.   End If
  67.   If CheckBox1 Then
  68.     Me.Hide
  69.     varInsPnt = _
  70.     ThisDrawing.Utility.GetPoint(prompt:="Insertion Point: ")
  71.     If blnScale Then
  72.       InsertOption strBlock, varInsPnt, dblBlkScale
  73.     Else
  74.       InsertOption strBlock, varInsPnt
  75.     End If
  76.     Me.show
  77.   Else
  78.     If blnScale Then
  79.       InsertOption strBlock, dblScale:=dblBlkScale
  80.     Else
  81.       InsertOption strBlock
  82.     End If
  83.   End If
  84. End Sub
  85.  
  86. Public Sub InsertOption(strName As String, _
  87. Optional varPnt As Variant, Optional dblScale As Double = 1)
  88.   Dim objUtil As Object
  89.   If IsMissing(varPnt) Then
  90.     Set objUtil = ThisDrawing.Utility
  91.     objUtil.CreateTypedArray varPnt, vbDouble, 0, 0, 0
  92.   End If
  93.   'I just left rotation at 0
  94.  'В данном примере угол поворота вставляемого блока
  95.  'всегда равен 0 градусов
  96.  If ThisDrawing.ActiveSpace = acModelSpace Then
  97.     ThisDrawing.ModelSpace.InsertBlock varPnt, _
  98.     strName, dblScale, dblScale, dblScale, 0
  99.   Else
  100.     ThisDrawing.PaperSpace.InsertBlock varPnt, _
  101.     strName, dblScale, dblScale, dblScale, 0
  102.   End If
  103.   Application.Update
  104. End Sub
  105.  

Код модуля
Код - Visual Basic [Выбрать]
  1. Option Explicit
  2.  
  3. '@=========================================@'
  4. '@ Функция проверки строки на возможность  @'
  5. '@ использования ее в качестве имени блока @'
  6. '@ Если эта строка уже используется в      @'
  7. '@ качестве имени блока, то функция сгене- @'
  8. '@ рирует на базе заданного новое имя      @'
  9. '@=========================================@'
  10. Public Function BlockNameIncrement(strName As String) As String
  11.   Dim objBlocks As AcadBlocks
  12.   Dim objBlock As AcadBlock
  13.   Dim strValue As String
  14.   Dim intCnt As Integer
  15.   Dim blnFound As Boolean
  16.  
  17.   On Error GoTo Err_Control
  18.   Set objBlocks = ThisDrawing.Blocks
  19.   strValue = strName
  20.   Do
  21.     For Each objBlock In objBlocks
  22.       If objBlock.name = strValue Then
  23.         blnFound = True
  24.         intCnt = intCnt + 1
  25.         strValue = strName & intCnt
  26.         Exit For
  27.       Else
  28.         blnFound = False
  29.       End If
  30.     Next objBlock
  31.   Loop Until Not blnFound
  32.   BlockNameIncrement = strValue
  33. Exit_Here:
  34.     Exit Function
  35. Err_Control:
  36.     MsgBox Err.Description
  37. End Function
  38.  
  39. '@=========================================@'
  40. '@ Функция для создания блока из набора    @'
  41. '@ объектов objSelSet, с именем strName и  @'
  42. '@ с базовой точкой varPnt                 @'
  43. '@=========================================@'
  44. Public Function BlockSelSet(objSelSet As AcadSelectionSet, _
  45. varPnt As Variant, strName As String) As AcadBlock
  46.   Dim objBlks As AcadBlocks
  47.   Dim objTemp As AcadBlock
  48.   Dim objArray() As AcadEntity
  49.   Dim intCnt As Integer
  50.   Set objBlks = ThisDrawing.Blocks
  51.   For intCnt = 0 To objSelSet.Count - 1
  52.     ReDim Preserve objArray(intCnt)
  53.     Set objArray(intCnt) = objSelSet(intCnt)
  54.   Next intCnt
  55.   Set objTemp = objBlks.Add(varPnt, strName)
  56.   ThisDrawing.CopyObjects objArray, objTemp
  57.   Set BlockSelSet = objTemp
  58.   Set objBlks = Nothing
  59.   Set objTemp = Nothing
  60. End Function
  61.  
  62. Public Sub TEST_BlockSelSet()
  63.   Dim strBlkName As String
  64.   Dim varPnt As Variant
  65.   Dim objSelSet As AcadSelectionSet
  66.   Dim objSelCol As AcadSelectionSets
  67.   Dim objNewBlock As AcadBlock
  68.  
  69.   On Error Resume Next
  70.   Set objSelCol = ThisDrawing.SelectionSets
  71.   For Each objSelSet In objSelCol
  72.     If objSelSet.name = "SelSetForBlock" Then
  73.       objSelSet.Delete
  74.       Exit For
  75.     End If
  76.   Next
  77.   Set objSelSet = ThisDrawing.SelectionSets.Add("SelSetForBlock")
  78.   objSelSet.SelectOnScreen
  79.  
  80.   With ThisDrawing.Utility
  81.     varPnt = .GetPoint(, vbCr & _
  82.              "Укажите базовую точку блока: ")
  83.     strBlkName = .GetString(False, vbCr & _
  84.                  "Введите имя создаваемого блока: ")
  85.   End With
  86.  
  87.   Set objNewBlock = BlockSelSet(objSelSet, _
  88.   varPnt, BlockNameIncrement(strBlkName))
  89. End Sub
  90.  
И второго модуля
Код - Visual Basic [Выбрать]
  1. Option Explicit
  2.  
  3. Public Sub TEST_frmBlkInsert()
  4.   frmBlkInsert.show
  5. End Sub
  6.  
  7.  
« Последнее редактирование: 14-02-2019, 23:00:25 от Александр Ривилис »

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

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Связь Autocad VBA с Access
« Ответ #1 : 14-02-2019, 23:08:47 »
Yeezussniper,
Приветствую на форуме!
1. В первую очередь ознакомьтесь с правилом форматирования кода на форуме (в Правилах и у меня в подписи) и соблюдайте его.
2. Вопрос явно не по программированию под AutoCAD, а по чтению из базы (Access или Excel). По работе с Excel у нас есть примеры здесь: Видеоуроки AutoCAD VBA
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

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

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Связь Autocad VBA с Access
« Ответ #2 : 15-02-2019, 10:44:09 »
1. В первую очередь ознакомьтесь с правилом форматирования кода на форуме (в Правилах и у меня в подписи) и соблюдайте его.
2. Вопрос явно не по программированию под AutoCAD, а по чтению из базы (Access или Excel). По работе с Excel у нас есть примеры здесь: Видеоуроки AutoCAD VBA

Спасибо, учту. Видеоуроки по excel я просматривал, там указывается просто связь и управление через редактирование excel. Меня же интересует с помощью формы vba выбирать нужную ячейку из excel для атрибута

Оффлайн trir

  • ADN Club
  • ****
  • Сообщений: 470
  • Карма: 63
Re: Связь Autocad VBA с Access
« Ответ #3 : 16-02-2019, 18:50:03 »
просто нужно познать DAO, а лучше ADO
а ещё лучше использовать .NET - там сильно приятней всё это делать...

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

  • ADN OPEN
  • Сообщений: 17
  • Карма: 0
Re: Связь Autocad VBA с Access
« Ответ #4 : 16-02-2019, 18:52:02 »
просто нужно познать DAO, а лучше ADO
а ещё лучше использовать .NET - там сильно приятней всё это делать...

Да я сам уже задумался над .NET. Просто нужно доделать эту программу под VBA, а далее можно уже перейти