Опубликован: 21.02.2012 | Уровень: специалист | Доступ: свободно
Лекция 8:

Программирование на VBA

Многострочный текст

Принципальное отличие многострочного текста (мультитекста) от текста в том, что форматровать можно отдельные слова и даже символы. Мультитекст может состоять из любого числа параграфов, весь блок мультитекста можно подвергнуть форматированию сразу. Так же только для мультитекста есть подчеркивание.

Создание многострочного текста

Метод AddMText требует три параметра - текстовая строка, точка вставки и ширина рамки в которую будет втиснут мультитекст. Последний параметр представляет положительное число, в единицах текущего чертежа. Высота блока мультитекста зависит от количества вводимых символов. Пример создания мультитекста.

Sub CreateMText()
  Dim mtextObj As AcadMText
  Dim insertPoint(0 To 2) As Double
  Dim width As Double
  Dim textString As String
  insertPoint(0) = 2: insertPoint(1) = 2: insertPoint(2) = 0: width = 4
  textString = "Длиная строка являющаяся примером многострочного текста."
  Set mtextObj = ThisDrawing.ModelSpace.AddMText(insertPoint, width, textString)
  ZoomExtents
End Sub

Форматирование мультитекста

Вновь вводимому тексту автоматически назначается форматирование текущего текстового стиля. (по умолчанию стиль STANDARD) Форматирование можно впоследствии изменить используя специальные символы и свойства объекта. Ориентация, выравнивание, ширина и вращение могут назначаться только целому объекту мультитекст, в отличие например от подчеркивания, которое может выделять лишь нужное слово или букву.

Форматирование отдельных символов мультитекста

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

Формат-символ Назначение Вводится так
\0...\o надчеркивание Autodesk \OAutoCAD\o 2000
\L...\l подчеркивание Autodesk \LAutoCAD\l 2000
\∼ неразрывный пробел AutoCAD\∼2000
\\ обратный слеш Autodesk\\AutoCAD
\{...\} фигурные скобки Autodesk\{AutoCAD\} 2000
\File name; имя файла шрифта Autodesk \Ftimes; AutoCAD 2000
\Hvalue; высота текста в единицах чертежа \H2;AutoCAD
\Hvaluex; высота текста умножением Autocad \H3x;2000
\S...^...; текст стопкой используя символы \ # ^ 1.000\S+0.010^-0.000;
\Tvalue; межсимвольный интервал от 0.75 до 4 \T2;Autodesk
\Qangle; угол наклона \Q20;Autodesk
\Wvalue; ширина букв \W2;Autodesk
\A выравнивание 0-низ, 1-центр,2-верх \A1;1\S1/2

В последнем примере вводится дробь 1 и 1/2. Использование фигурных скобок применяет форматирование только внутри них. Вложенность скобок может достигать 8 уровней. Пример форматирования с ASCII-кодами {{\H1.5x; Big text} \A2; over text\A1;/\A0; under text} Пример использования форматирующих символов

Sub FormatMText()
  Dim mtextObj As AcadMText
  Dim insertPoint(0 To 2) As Double
  Dim width As Double
  Dim textString As String
  
  insertPoint(0) = 2: insertPoint(1) = 2: insertPoint(2) = 0: width = 100
  
  Dim OB As Long,CB As Long,BS As Long,FS As Long,SC As Long
  OB = Asc("{")
  CB = Asc("}")
  BS = Asc("\")
  FS = Asc("/")
  SC = Asc(";")
  
  ' {{\H1.5x; Big text}\A2; over text\A1;/\A0; under text}
  
  textString = Chr(OB) + Chr(OB) + Chr(BS) + "H1.5x" _
  + Chr(SC) + "Big text" + Chr(CB) + Chr(BS) + "A2" _
  + Chr(SC) + "over text" + Chr(BS) + "A1" + Chr(SC) _
  + Chr(FS) + Chr(BS) + "A0" + Chr(SC) + "under text" _
  + Chr(CB)
  
  Set mtextObj = ThisDrawing.ModelSpace.AddMText(insertPoint, width, textString)
  ZoomExtents
End Sub

Форматирование многострочных текстовых объектов

Установка свойства объекта StyleName задает стиль по умолчанию для вновь создаваемых объектов мультитекста. При применении нового стиля к ранее созданным объектам имеющее сложное форматирование будет утеряно. Выравнивание текста бывает левое, правое и по центру, а положение вверху, внизу и по центру. AutoCAD предлагает 9 установок выравнивания: TL (вверх и влево), TC (вверх и по центру), TR (вверх и вправо), ML, MC, MR, BL, BC, BR. Изменять эти значения можно через свойство AttachmentPoint.

Использование символов unicode, управляющих и специальных символов

Символы unicode \U+00B0 градусы, \U+00B1 плюс-минус, \U+2205 диаметр. Указав %%код_символа можно вводить и другие спец-символы. %%o - надчеркивание, %%u - подчеркивание, %%d - градусы, %%p - плюс-минус, %%c - диаметр, %%% - проценты.

Замена шрифтов

Если AutoCAD не находит шрифт указанный в чертеже можно укзать другой. Для чего в любом текстовом редакторе создается таблица замены fmp-файл, каждая строка которого имеет вид romanc.shx; times.ttf (какой менять; на какой). Для указания файла замены шрифтов отличного от того, что входит в стандартную поставку AutoCAD, используйте свойство FontFileMap объекта Preferences.

Установка альтернативного шрифта по-умолчанию

По умолчанию для замены несуществующего шрифта используется simplex.shx, однако можно укзать любой другой через свойство AltFontFile объекта Preferences.

Размерности, допуски и указатели

Размерности представляют собой геометрические характеристики объектов - расстояния углы между ними. В AutoCADе их три разновидности - линейные, радиальные (от слова радиус) и угловые. Они могут создаваться как для объектов (линий, мультилиний, дуг, окружностей, сегментов полилинии) так и самостоятельно. Каждая размерность имеет свой размерный стиль, включающий цвет, тип линий, стиль текста. Переменные, определяющие вид размерностей: DIMAUNIT, DIMUPT, DIMTOFL, DIMFIT, DIMTIH, DIMTOH, DIMJUST, DIMTAD. Однострочный текст размерности использует текущий текстовый стиль. Ассациативные размерности это те, в которых все линии, стрелки, дуги и тексты рисуются как единый объект. По умолчанию системная переменная DIMASO, отвечающая за ассациативность размерностей, включена.

Создание размерностей

Можно создавать линейные, радиальные, угловые и ординатные размерности. При этом используется активный размерный стиль. Линейные размеры могут вращаться и выравниваться. Они строятся параллельно измеряемой части объекта с использованием методов AddDimAligned, AddDimRotated, AddDim3PointAligned. Для создания радиальных размеров дуг и окружностей есть метод AddDimRadial, пример построения радиальных размеров:

Sub CreateRadialDimension()
  Dim dimObj As AcadDimRadial
  Dim center(0 To 2) As Double
  Dim chordPoint(0 To 2) As Double
  Dim leaderLen As Integer
  
  center(0) = 0: center(1) = 0: center(2) = 0
  chordPoint(0) = 5: chordPoint(1) = 5: chordPoint(2) = 0
  leaderLen = 5
  
  Set dimObj = ThisDrawing.ModelSpace.AddDimRadial(center, chordPoint, leaderLen)
  ZoomExtents
End Sub

Пример создания угловых размеров

Sub CreateAngularDimension()
  Dim dimObj As AcadDimAngular
  Dim angVert(0 To 2) As Double
  Dim FirstPoint(0 To 2) As Double
  Dim SecondPoint(0 To 2) As Double
  Dim TextPoint(0 To 2) As Double
  
  angVert(0) = 0: angVert(1) = 5: angVert(2) = 0
  FirstPoint(0) = 1: FirstPoint(1) = 7: FirstPoint(2) = 0
  SecondPoint(0) = 1: SecondPoint(1) = 3: SecondPoint(2) = 0
  TextPoint(0) = 3: TextPoint(1) = 5: TextPoint(2) = 0
  
  Set dimObj = ThisDrawing.ModelSpace.AddDimAngular(angVert, FirstPoint, SecondPoint, TextPoint)
  ZoomAll
End Sub

Ординатные размеры измеряют перпиндикулярное расстояние от заданной точки до измеремого объекта. Обычно используются, чтобы избежать ошибок взаимного положения объектов.

Пример:

Sub CreatingOrdinateDimension()
  Dim dimObj As AcadDimOrdinate
  Dim definingPoint(0 To 2) As Double
  Dim leaderEndPoint(0 To 2) As Double
  Dim useXAxis As Long
  
  definingPoint(0) = 5: definingPoint(1) = 5: definingPoint(2) = 0
  leaderEndPoint(0) = 10: leaderEndPoint(1) = 5: leaderEndPoint(2) = 0
  useXAxis = 5
  
  Set dimObj = ThisDrawing.ModelSpace.AddDimOrdinate(definingPoint, leaderEndPoint, useXAxis)
  ZoomExtents
End Sub

Для редактирования размеров используется следующие свойства

  • Rotation - задает угол поворота в радианах;
  • StyleName - задает имя размерного стиля;
  • TextPosition - задает положение текста размера;
  • TextRotation - задает угол вращения текста размера;
  • Measurement - задает актуальное измерение для размера;

А в дополнение следующие методы

  • ArrayPolar - создает полярный массив;
  • ArrayRectangular - создает прямоугольный массив;
  • Copy - копирует;
  • Erase - стирает;
  • Mirror - зеркально отражает;
  • Move - перемещает;
  • Rotate - вращает;
  • ScaleEntity - масштабирует.

Пример переопределения текста размера

Sub OverrideDimensionText()
  Dim dimObj As AcadDimAligned
  Dim point1(0 To 2) As Double
  Dim point2(0 To 2) As Double
  Dim location(0 To 2) As Double
  
  ' задаем размер
  point1(0) = 5#: point1(1) = 3#: point1(2) = 0#
  point2(0) = 10#: point2(1) = 3#: point2(2) = 0#
  location(0) = 7.5: location(1) = 5#: location(2) = 0#
  
  Set dimObj = ThisDrawing.ModelSpace.AddDimAligned(point1, point2, location)
  
  ' меняем текст
  dimObj.TextOverride = "Значение <>"
  dimObj.Update
End Sub

Работа с размерными стилями

Именованный размерный стиль - группа настроек определяющих вид размеров. Создание нового стиля осуществляется методом Add, метод CopyFrom позволяет копировать стиль. При этом если копировать стиль не с объекта Style, а с объекта Document, то переносятся все переопределения стиля.

Пример копирования стиля с переопределениями. Он создает три размерных стиля и копирует их при разных установках. Для его работы следует в новом рисунке создать линейный размер, изменить цвет на желтый, изменить значение системной переменной DIMCLRD на 5.

Sub CopyDimStyles()
  Dim newStyle1 As AcadDimStyle,newStyle2 As AcadDimStyle
  Dim newStyle3 As AcadDimStyle
  
  Set newStyle1 = ThisDrawing.DimStyles.Add ("Стиль 1 скопирован с dim")
  Call newStyle1.CopyFrom(ThisDrawing.ModelSpace(0))
  
  Set newStyle2 = ThisDrawing.DimStyles.Add ("Стиль 2 скопирован со Стиль 1")
  Call newStyle2.CopyFrom(ThisDrawing.DimStyles.Item ("Стиль 1 скопирован с dim"))
                  
  Set newStyle2 = ThisDrawing.DimStyles.Add ("Стиль 3 скопирован с настройками")
  Call newStyle2.CopyFrom(ThisDrawing)
End Sub

Если открыть диалог DIMSTYLE, то там должны появиться три разных стиля.

Переопределение размерного стиля

Следующие свойства доступны для большинства размеров:

  • AltRoundDistance - задает округление изменяемых единиц;
  • AngleFormat - задает формат единиц для угловых размеров;
  • Arrowhead1Block, Arrowhead2Block - задает блок используемый как пользовательский тип стрелок;
  • Arrowhead1Type, Arrowhead2Type - задает тип стрелок;
  • ArrowheadSize - задает размеры стрелок и hook lines;
  • CenterMarkSize - задает размер центральной отметки для радиальных размеров;
  • CenterType - задает тип центральной отметки для радиальных размеров;
  • DecimalSeparator - задает символ используемый как десятичный разделитель в десятичных размерах и значениях допуска;
  • DimensionLineColor - задает цвет размерной линии;
  • DimensionLineWeight - задает вес линии;
  • DimLine1Suppress, DimLine2Suppress - задает подавление;
  • DimLineInside - задает показ размеров внутри линий расширения;
  • ExtensionLineColor - задает цвет для размеров линий расширения;
  • ExtensionLineExtend - задает расстояние линии расширения;
  • ExtensionLineOffset - задает расстояние линии расширения по смещению;
  • ExtensionLineWeight - задает вес линии расширения;
  • ExtLine1EndPoint, ExtLine2EndPoint - задает конечную точку линии расширения;
  • ExtLine1StartPoint, ExtLine2StartPoint - задает начальную точку линии расширения;
  • ExtLine1Suppress, ExtLine2Suppress - задает подавление линий расширения;
  • Fit - задает полодение текста и стрелок внутри или снаружи линий расширения;
  • ForceLineInside - задает если размерная линия чертится между линией расширения даже когда текст расположен вне линии расширения;
  • FractionFormat - задает формат дробной части;
  • HorizontalTextPosition - задает горизонтальное выравнивание текста;
  • LinearScaleFactor - задает глобальный масштаб для r for измерений линейных размеров;
  • PrimaryUnitsPrecision - задает число десятичных знаков для первичных единиц;
  • SuppressLeadingZeros, SuppressTrailingZeros - задает подавление лидирующих и хвостовых нолей в значениях размеров;
  • SuppressZeroFeet, SuppressZeroInches - задает подавление нулевых футов и дюймов в измерениях размеров;
  • TextColor - задает цвет текста;
  • TextGap - задает расстояние между текстом размера и размерной линией когда разрывается линия для размещения текста;
  • TextHeight - задает высоту текста размера и допуска;
  • TextInside - задает если текст размера рисуется внутри линий расширения;
  • TextInsideAlign - задает положение текста размера внутри линий расширения для всех типов размеров кроме ординатных;
  • TextMovement - задает как текст размера рисуется когда текст перемещен;
  • TextOutsideAlign - задает положение текста размера вне линий расширения для всех типов размеров кроме ординатных;
  • TextPosition - задает положение текста размера;
  • TextPrecision - задает точность текста угловых размеров;
  • TextPrefix - задает префикс значения размера;
  • TextRotation - задает угол вращения текста размера;
  • TextSuffix - задает суффикс значения размера;
  • ToleranceDisplay - задает если допусков отображается с текстом размера;
  • ToleranceHeightScale - задает масштаб для текста или высоту текста допуска относительно высоты текста размера;
  • ToleranceJustification - задает вертикальное выравнивание значений допуска относительно номинального текста размера;
  • ToleranceLowerLimit - задает миним. предел допуска для текста размера;
  • TolerancePrecision - задает точность значений допуска в первичном размере;
  • ToleranceSuppressLeadingZeros - задает подавление лидирующих нулей в значениях допуска;
  • ToleranceSuppressTrailingZeros - задает подавление хвостовых нулей в значениях допуска;
  • ToleranceUpperLimit - задает макс. предел допуска для текста размера;
  • UnitsFormat - задает формат единиц для всех размеров исключая ept угловые;
  • VerticalTextPosition - задает вертикальное положение текста в отношении к линии размера.

Пример выровненного размера с суффиксом определенным пользователем:

Sub AddTextSuffix()
  Dim dimObj As AcadDimAligned
  Dim point1(0 To 2) As Double
  Dim point2(0 To 2) As Double
  Dim location(0 To 2) As Double
  Dim suffix As String
  
  ' Определим размер
  point1(0) = 0: point1(1) = 5: point1(2) = 0
  point2(0) = 5: point2(1) = 5: point2(2) = 0
  location(0) = 5: location(1) = 7: location(2) = 0
  
  Set dimObj = ThisDrawing.ModelSpace.AddDimAligned(point1, point2, location)
  
  ThisDrawing.Application.ZoomExtents
  ' Позволим пользователю сменить суффикс
  suffix = InputBox("Новый суффикс для размера", "Set Dimension Suffix", ":SUFFIX")
  
  dimObj.TextSuffix = suffix
  ThisDrawing.Regen acAllViewports
End Sub
Алексей Тимонин
Алексей Тимонин
Алексей Потапкин
Алексей Потапкин

Здравствуйте.

Подскажите, пожалуйста, каким образом можно передать параметры в макрос написанный в Autocad на VBA? Например, есть процедура, которая отрисовывает заштрихованный прямоугольник (см. ниже). Как её изменить, чтобы на входе от пользователя требовалось ввести также в качестве параметров координаты углов прямоугольника?

Public Sub DrawHatchedBox()

...

End Sub