[Из песочницы] Автоматизация рутинных операций между Excel и AutoCAD при помощи VBA30.06.2015 13:48

Уже не первый год я встречаю на профильных форумах мнение, что VBA для AutoCAD отмирает, и AutoDesk не будет его включать в следующих релизах в дистрибутив, и вообще, истинные падаваны пользуются lisp, C# и прочим, но только не VBA.

Я инженер-проектировщик ОВиК, не программист. И не хочу, да и некогда, вникать в серьезное программирование. Чаще всего появляется ситуация, что нужно как-то автоматизировать рутину здесь и сейчас. На помощь приходит простой язык VBA.

Далее я покажу, как можно без особых забот сделать самому то, за что серьезные ребята берут не плохие денежки. А именно перенос данных из Excel в AutoCAD и обратно. Заинтересованных прошу под кат.
Программировать будем на стороне Excel — мне так проще. Для подключения нужно войти в режим разработчика: Alt+F8 Либо можно открыть вкладку «разработчик» из настроек ленты.

В окне разработчика VBA входим в верхнее меню: Tools/References. В этом окне нужно поставить галочку на вашей версии AutoCAD

a5c43a4642ed4213905d145426a224e8.PNG

В моем случае это AutoCAD 2014 Type Library. Далее нужно в левом окне создать в вашей книге модуль, как на скриншоте (Module)

938ab902abf843178668bfc0d4b4e707.png

И в модуль вставляем нижеприведенный код: 

Sub DrawMLeader() 'рисуем выноску

    Dim acadApp As AcadApplication
    Dim acadDoc As AcadDocument

    Application.DisplayAlerts = False 'чтобы отключить ненужные сообщения
      
    'Проверяем открыт Автокад или нет

    On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
    On Error GoTo 0
    
    'Если Автокад не открыт, создаем новый экземпляр и делаем его видимым
    If acadApp Is Nothing Then
        Set acadApp = New AcadApplication
        acadApp.Visible = True
    End If
    
    'Проверяем активный документ
    On Error Resume Next
    Set acadDoc = acadApp.ActiveDocument
    On Error GoTo 0
    
    'Если активных нет - создаем новый документ
    If acadDoc Is Nothing Then
        Set acadDoc = acadApp.Documents.Add
        acadApp.Visible = True
    End If
   
Dim AML As AcadMLeader
Dim xx As Long
Dim ss As String

ActiveCell.Cells.Activate 'активируем ячейку в экселе
ss = ActiveCell.Cells.Value 'заносим данные из ячейки в переменную

Dim points(0 To 5) As Double 'массив точек для вставки выноски

 Dim startPnt As Variant, endPnt As Variant
  Dim prompt1 As String, prompt2 As String
  prompt1 = vbCrLf & "Начало выноски: "
  prompt2 = vbCrLf & "Конец выноски: "
  startPnt = acadDoc.Utility.GetPoint(, prompt1) 'запрашиваем у пользователя первую точку выноски
  endPnt = acadDoc.Utility.GetPoint(startPnt, prompt2) 'запрашиваем у пользователя вторую точку выноски

'заполняем массив точек для MLeader
    points(0) = startPnt(0)
    points(1) = startPnt(1)
    points(2) = 0
  
    points(3) = endPnt(0)
    points(4) = endPnt(1)
    points(5) = 0

Set AML = acadDoc.ModelSpace.AddMLeader(points, xx) 'вставляем примитив в автокад и заполняем ниже его свойства
AML.TextString = ss
AML.ArrowheadType = acArrowNone
'если нужна другая высота текста - эту позицию меняем тут, или в настройках Mleader в AutoCAD
AML.TextHeight = 250
AML.TextLeftAttachmentType = acAttachmentBottomOfTopLine
AML.TextRightAttachmentType = acAttachmentBottomOfTopLine
AML.LandingGap = 2

Dim entHandle As String

entHandle = AML.Handle 'получаем хэндл выноски, чтобы вставить его в соседнюю ячейку, чтобы в дальнейшем можно было обновить данные в выноске прямо из эксель

ActiveCell.Offset(0, 1).Value = entHandle
   
acadDoc.Application.Update
'меняю цвет ячейки, откуда получил текст, чтобы было понятно, что текст обработан.

ActiveCell.Cells.Interior.ColorIndex = 6
End Sub


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

Dim blockObj As Object 'обозвали блок

'вставили блок, маркер воздухообмена - это имя вашего блока, который должен быть уже в чертеже:
'можно сделать так, чтобы блок вставлялся автоматически из чертежа-донора, но я на это уже не заморачивался

Set blockObj = acadDoc.ModelSpace.InsertBlock(startPnt, "Маркер воздухообмена", 1, 1, 1, 0, [])

'заполняем атрибуты, можно сделать по-умнее, но мне лень было разбираться, я сделал по рабоче-крестьянски (работает и ладно)

Dim varAttributes As Variant
    varAttributes = blockObj.GetAttributes
    varAttributes(0).TextString = ss1 'приток
    varAttributes(1).TextString = ss2 'вытяжка
    varAttributes(2).TextString = ss 'описание помещения
    
Dim entHandle As String 'тут я получаю хэндл нашего блока и пишу его в соседнюю ячейку, для того, чтобы можно было при изменении текста в Excel обновить просто блок в AutoCAD.

entHandle = blockObj.Handle
ActiveCell.Offset(0, 3).Value = entHandle


Код обновления текста по хэндлу — написан ниже: 'получаем хэндл из ячейки, в которую мы записали кодом выше.

entHandle = ActiveCell.Offset (0, 3).Value 'получили наш блок по хэндлу
Set blockObj = acadDoc.HandleToObject (entHandle)

А дальше делаем всё то же самое, что и выше.

Для того, чтобы немного разъяснить как это работает вживую — записал видео:

Как видите, кода минимум, однако на больших объектах мне экономит по несколько часов работы. И снижается риск ошибки. Т.к. обычно это выглядит следующим образом у проектировщиков — открываются два окна на разных экранах, и или вручную, или через буфер обмена начинается заполнение выносок или блоков на чертеже.

Опять же чем хорош VBA — что он всегда под рукой :) Excel-то основной инструмент у инженера.

© Habrahabr.ru