Уже не первый год я встречаю на профильных форумах мнение, что VBA для AutoCAD отмирает, и AutoDesk не будет его включать в следующих релизах в дистрибутив, и вообще, истинные падаваны пользуются lisp, C# и прочим, но только не VBA.
Я инженер-проектировщик ОВиК, не программист. И не хочу, да и некогда, вникать в серьезное программирование. Чаще всего появляется ситуация, что нужно как-то автоматизировать рутину здесь и сейчас. На помощь приходит простой язык VBA.
Далее я покажу, как можно без особых забот сделать самому то, за что серьезные ребята берут не плохие денежки. А именно перенос данных из Excel в AutoCAD и обратно. Заинтересованных прошу под кат.
Программировать будем на стороне Excel — мне так проще. Для подключения нужно войти в режим разработчика: Alt+F8 Либо можно открыть вкладку «разработчик» из настроек ленты.
В окне разработчика VBA входим в верхнее меню: Tools/References. В этом окне нужно поставить галочку на вашей версии AutoCAD
В моем случае это AutoCAD 2014 Type Library. Далее нужно в левом окне создать в вашей книге модуль, как на скриншоте (Module)
И в модуль вставляем нижеприведенный код:
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-то основной инструмент у инженера.
ссылка на оригинал статьи http://habrahabr.ru/post/261461/
Добавить комментарий