Translate to: |
|||||||
Обратная связь | Новости САПР | Программы | Документация | Полезные советы | Обзорные статьи | ||
Заказ и разработка | Каталог САПР | САПР-конференция | Библиотека ГОСТов | Наши соавторы | Коммерческое ПО |
В уроке 3 мы начали ваше первое VBA-приложение для AutoCAD, FancyText. Вы создали диалоговое окно и теперь вы готовы работать с тем, что пользователь будет в них вводить.
Готовы? Переместимся в событие Click объекта CmdGo (командная кнопка). Когда что-нибудь произойдет, ваша програма должна прежде всего проверить то что введено пользователем. Она должна проверить тип текста и его наличие, и обратить внимание пользователя, если он что-то забыл ввести. Наберите:
If (Trim(txtText.Text) = "") Then MsgBox "Please enter some text!" txtText.SetFocus Exit Sub End If
Изучение свойства Text блока текста сообщит вам, если пользователь забыл заполнить его. Используйте SetFocus tчто бы переместить курсор на поле, где отсутствует информация, что сделает Fancy Text более дружественной к пользователю. В противном случае пользователь должен будет сам перейти на незаполненное поле.
Проверка высоты текста более сложна. Вы можете использовать 5 различных систем едениц что-бы вводить растояние в AutoCAD, и Fancy Text принимает ввод пользователем в текущих еденицах чертежа. Мало того, что Вы должны проверить что пользователь ввел высоту, вы так же должны конвертировать высоту в число:
If (Trim(txtHeight.Text) = "") Then MsgBox "Please enter a text height!" txtHeight.SetFocus Exit Sub End If Dim unit% unit% = mappAcad.ActiveDocument._ GetVariable("LUNITS") On Error Resume Next Dim height# height# = mappAcad.ActiveDocument._ Utility.DistanceToReal(_ txtHeight.Text, unit%) If (Err.Number <> 0) Then MsgBox "Please enter a " _ & "valid text height!" txtHeight.SetFocus End If
Используйте GetVariable() что бы получить значение любой системной переменной AutoCAD или переменной окуржения, подобно тому, как вы используете функии (getvar) и (getenv) в AutoLISP.
После того, как вы определили текущие еденицы чертежа, вы можете использовать метод DistanceToReal() объекта Utility что бы конвертировать расстояние из строковой переменной в числовую. Ошибка происходит когда конвертация не удается, поэтому при попытке конвертации вы должны осуществлять проверку на возможность ошибки, и сообить пользователю, если введенная высота не может быть сконвертирована.
Теперь вы почти готовы начать создание текста, но вам еще нужна центральная точка текста. Переместимся в начало события Click и добавим несколько констант:
Const L_PT_FIRST = 0 Const L_PT_X = 0 Const L_PT_Y = 1 Const L_PT_Z = 2 Const L_PT_LAST = 2
Точка представляется в VBA как массив из трех элементов типа doubles. Эти константы помогут вам легко объявит точечные переменные и доступ к параметрам этих точек. Теперь переместимся в конец события Click.
Вы можете использовать GetPoint() метод объекта Utility что бы получить стартовую точку текста от пользователя, но здесь имеет место одна из причуд VBA. VBA формы - модальные, что означает, что вы не можете ничего делать в приложении - родителе формы пока форма отображена на экране. Другими словами, вы должны скрыть форму перед тем, как должен указать стартовую точку:
Dim ptPickd As Variant Dim ptInsert#(L_PT_FIRST To L_PT_LAST) Me.Hide mappAcad.ActiveDocument.Utility._ InitializeUserInput 1 + 2 ptPickd = mappAcad.ActiveDocument._ Utility.GetPoint(, "Pick the " _ & "center point for the text: ") ptInsert#(L_PT_X) = ptPickd(L_PT_X) ptInsert#(L_PT_Y) = ptPickd(L_PT_Y) ptInsert#(L_PT_Z) = ptPickd(L_PT_Z)
Метод InitializeUserInput() позволяет вам указать какой метод семейства GetXxx проверяет ввод пользователя; аргумент 1 + 2 говорит GetPoint() что бы он игнорировал нулевой ввод. После того как у вас есть точка, вы должны сконвертировать ее. GetPoint() возращает точку как Variant, но большинство функций VBA, которые используют точки требует трех-элементный массив типа double. Вы должны выполнить черную работу копирования x-, y-, и z-координат точки из Variant в массив типа double.
Теперь, когда вы имеете всю информацию, создадим текст. Текст будет состоять из двух частей - сам текст и его обводка. Добавить текст просто: нужно только вызвать метод AddText() коллекции ModelSpace и сообщить ему, какой текст нужно добавить, где его добавить, и какой высоты он должен быть:
Dim objText As Object Set objText = mappAcad.ActiveDocument._ ModelSpace.AddText(txtText.Text, _ ptInsert#, height#)
Все функции типа Add<EntityName> возвращают последний созданный примитив. Вам необходимо ссылаться на них несколько раз, так что за ними необходимо следить.
Создание обводки текста более сложный процесс. Что бы начать обводку нам нужно знать какую площадь занимает текст. К счастью каждый примитив имеет метод GetBoundingBox который обеспечивает вас нжней левой и верхней правой координатами:
Dim ptMinBound As Variant Dim ptMaxBound As Variant objText.GetBoundingBox ptMinBound, _ ptMaxBoundДальше добавим немного для памяти, что бы обводка и текст не пересекались:
Dim offDist# offDist# = height# / 3 ptMinBound(L_PT_X) = _ ptMinBound(L_PT_X) - offDist# ptMinBound(L_PT_Y) = _ ptMinBound(L_PT_Y) - offDist# ptMaxBound(L_PT_X) = _ ptMaxBound(L_PT_X) + offDist# ptMaxBound(L_PT_Y) = _ ptMaxBound(L_PT_Y) + offDist#Вы так же должный вычислить центр текста что бы иметь возможность вращать текст и его обводку вокруг этой точки. Обводка для текста по кругу используют эту точку как ее центр:
Dim bndHeight# Dim bndWidth# bndHeight# = ptMaxBound(L_PT_Y) _ - ptMinBound(L_PT_Y) bndWidth# = ptMaxBound(L_PT_X) _ - ptMinBound(L_PT_X) Dim ptCenter#(L_PT_FIRST To L_PT_LAST) ptCenter#(L_PT_X) = ptMinBound(L_PT_X) _ + (bndWidth# / 2) ptCenter#(L_PT_Y) = ptMinBound(L_PT_Y) _ + (bndHeight# / 2) ptCenter#(L_PT_Z) = ptMinBound(L_PT_Z)
Вы должны быть способны установить текст горизонтально и вертикально, в этом случае точка вставки текста и его центральная точка должны быть одинаковыми.
Теперь вы готовы создавать обводку, которая будет выполнена с помощью полилинии. Здесь мы встретимся с другой причудой VBA.
В отличии от большинства других примитивов, полилинии не имеют z-координату, что означает массив координат должен иметь только восем элементов, а не двенадцать:Dim pts#(0 To 7) pts#(0) = ptMinBound(L_PT_X) pts#(1) = ptMinBound(L_PT_Y) pts#(2) = ptMinBound(L_PT_X) pts#(3) = ptMaxBound(L_PT_Y) pts#(4) = ptMaxBound(L_PT_X) pts#(5) = ptMaxBound(L_PT_Y) pts#(6) = ptMaxBound(L_PT_X) pts#(7) = ptMinBound(L_PT_Y) Set objOutline = mappAcad._ ActiveDocument.ModelSpace._ AddLightWeightPolyline(pts#) objOutline.Closed = True ' a sausage is simply a rectangle whose ' short edges are bulged. objOutline.SetBulge 0, -1 objOutline.SetBulge 2, -1Теперь будем вращать текст и его обводку. Большинство людей представляет себе углы в градусах, но VBA требует их в радианах. Необходимо сконвертировать угол вращения перед тем как он будет передан в метод Rotate.
Const L_PI = 3.14159 objText.Rotate ptCenter#, _ (txtRotation.Text * L_PI / 180#) objOutline.Rotate ptCenter#, _ (txtRotation.Text * L_PI / 180#)И наконец, переместим текст и его обводку так что бы их центры совпали с точкой, указанной пользователем.
objText.Move ptCenter#, ptStart# ptCenter#(L_PT_Z) = 0 objOutline.Move ptCenter#, ptStart#Теперь, обновим текст и его обводку на экране, освободим наши ссылки на них и выгрузим:
objText.Update objOutline.Update Set objOutline = Nothing Set objText = Nothing Unload MeНаше приложение FancyText теперь завершено. Сохраните вашу работу, а затем протестируйте. Вы должны быть способны создавать текст любого размера и под любым углом. После того как вы убедитесь, что все работает правильно нам остается выполнить последний штрих, что бы завершить программу.
Sub FancyText() frmFancyText.Show End SubТеперь запустите FancyText набрав
-vbarun modApps.FancyTextв командной строке AutoCAD.
Теперь вы знаете как создавать диалоговые окна для взаимодействия с пользователем, как добавлять новые примитивы к чертежу, и как манипулировать текстовыми примитивами в чертеже.
Вы можете улучшить FancyText различными способами, включая установку высоты текста по умолчанию к текущей высоте текста по умолчанию в AutoCAD и добавление дополнительных типов обводки.
Версия FancyText доступная на Web-сайт журнала CADALYST добавляет прямоугольные и круговые текстовые стили. Я был бы заинтересован узнать, как Вы улучшите ее.
Copyright © Сайт поддержки пользователей САПР