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

Редактирование образца штриховки

Для образца штриховки можно менять некоторые свойства (например угол, интервалы). AutoCAD для уменьшения размера файла штриховку хранит не в виде множества подобных объектов, а как один повторяющийся по определенным правилам. Имеются следующие свойства и методы:

• PatternAngle - задает угол образца штриховки;
• PatternDouble - задает пользовательскую двойную штриховку;
• PatternName - задает имя штриховки;
• PatternScale - задает масштаб штриховки;
• PatternSpace - задает пользовательский шаг штриховки;
• SetPattern - задает имя и тип штриховки.

Пример

Sub ChangeHatchPatternSpace()
  Dim hatchObj As AcadHatch
  Dim patternName As String
  Dim PatternType As Long
  Dim bAssociativity As Boolean

  ' Зададим штриховку
  patternName = "ANSI31"
  PatternType = 0
  bAssociativity = True
  ' Создадим ассациированный объект
  Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)

  ' Создадим внешнюю петлю
  Dim outLoop(0 To 0) As AcadEntity
  Dim center(0 To 2) As Double
  Dim radius As Double
  center(0) = 5: center(1) = 3: center(2) = 0: radius = 100
  Set outLoop(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
  hatchObj.AppendOuterLoop (outLoop)
  hatchObj.Evaluate

  ' Изменим шаг образца штриховки на +2
  hatchObj.PatternSpace = hatchObj.PatternSpace + 2
  hatchObj.Evaluate
  ThisDrawing.Regen True
  ZoomExtents
End Sub

Слои, цвета и типы линий

Слои подобны прозрачным пленкам на которых разложены различные группы элементов. Любой созданный объект имеет свойства: Слой, Цвет, Тип Линии. Цвет позволяет различать похожие объекты, тип линии позволяет быстро отличить, например, центральные и скрытые линии. Раскладка объектов по слоям упрощает работу над сложными чертежами.

Работа со слоями

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

Сортировка слоев и типов линий

Все слои и типы линий хранятся в соответствующих коллекциях. Поэтому можно выполнять их перебор пройдя по содержимому коллекции и получить все слои и типы линий рисунка. Пример:

Sub IteratingLayers()
  Dim layerNames As String
  Dim entry As AcadLayer
  layerNames = ""
  For Each entry In ThisDrawing.Layers
    layerNames = layerNames + entry.Name + vbCrLf
  Next
  MsgBox "Слои рисунка: " + vbCrLf + layerNames
End Sub

Создание слоя и присвоение ему имени

Для нового чертежа AutoCAD создает специальный слой с именем "0", по умолчанию ему назначается цвет = 7 (черный или белый в зависимости от цвета фона) и тип линий continuous. Данный слой не может быть удален. Вы же можете создавать новые слои и назначать им цвета и типы линий по своему усмотрению. Каждый слоя является часть коллекции Layers, для создания слоя и добавления его в коллекцию есть метод Add. При создании слою можно сразу назначить имя или переименовать его впоследствии изменив свойство Name. Имя слоя может быть не больше 31 символа, пробелы недопустимы. Пример назначения объекту другого слоя.

Sub NewLayer()
  ' Создадим окружность
  Dim circleObj As AcadCircle
  Dim center(0 To 2) As Double
  Dim radius As Double
  center(0) = 2: center(1) = 2: center(2) = 0: radius = 1
  Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
  ZoomExtents
  ' Назначим окружности цвет "ByLayer" (по слою)
  circleObj.Color = acByLayer
  ' Создадим слой "ABC"
  Dim layerObj As AcadLayer
  Set layerObj = ThisDrawing.Layers.Add("ABC")
  ' назначим ему красный цвет
  layerObj.Color = acRed

  ' назначим окружности слой "ABC"
  circleObj.Layer = "ABC"
  circleObj.Update
  ' окружность изменила цвет (!)
End Sub

Установка активного слоя

В рисунке всегда один из слоев активный, новые объекты создаются на нем. Можно изменить активный слой установив у него свойство ActiveLayer, замороженный слой не может стать активным.

Dim newlayer As AcadLayer
Set newlayer = ThisDrawing.Layers.Add("LAYER1")
ThisDrawing.ActiveLayer = newlayer

Управление видимостью слоев

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

Включение и выключение слоев

Sub LayerInvisble()
  Dim circleObj As AcadCircle
  Dim center(0 To 2) As Double
  Dim radius As Double
  center(0) = 2: center(1) = 2: center(2) = 0: radius = 1
  Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
  circleObj.Color = acByLayer

  Dim layerObj As AcadLayer
  Set layerObj = ThisDrawing.Layers.Add("ABC")
  layerObj.Color = acRed

  circleObj.Layer = "ABC"
  circleObj.Update

  ' отключим слой "ABC"
  layerObj.LayerOn = False
  ThisDrawing.Regen acActiveViewport
End Sub

Заморозка и разморозка слоев

Заморозка слоя ускоряет прорисовку чертежа, увеличат скорость отбора объектов и уменьшает время регенерации сложных чертежей. AutoCAD не отображает, не выводит на печать и не регенерирует объекты на замороженных слоях. Замораживайте те слои которые долго не понадобятся в работе. Свойство Freeze управляет заморозкой и разморозкой. Пример

Sub LayerFreeze()
  Dim layerObj As AcadLayer
  Set layerObj = ThisDrawing.Layers.Add("ABC")
  layerObj.Freeze = True
End Sub

Блокировка и разблокировка слоев

Блокировка слоя полезна, когда необходимо редактировать объекты других слоев, но при этом видеть без возможности изменения объекты других слоев. Если слой только блокирован, а не отключен и не заморожен - объекты на нем видны. Блокированный слой можно сделать текущим и добавить на него объекты (!). Но удалить вновь добавленный объект нельзя до тех пор, пока слой не будет разблокирован. Для заблокированного слоя можно менять цвет и тип линий. Для блокировки и разблокировки слоя используется свойство Lock.

Sub LayerLock()
  Dim layerObj As AcadLayer
  Set layerObj = ThisDrawing.Layers.Add("ABC")
  layerObj.Lock = True
End Sub

Назначение слою цвета

При назначении цвета слою следует вводить имя цвета или его индекс. Стандартные имена имеются только для цветов с индексами от 1 до 7. Цвет объекту можно назначать независимый от цвета слоя. Значение индекса цвета от 0 до 256, именованные константы только для цветов 1 до 7 и Byblock и Bylayer. Если используется AcbyBlock, AutoCAD вычерчивает новые объекты в цвете по умолчанию до тех пор, пока они не группируются в блок. Когда же блок вставляется в рисунок, объекты, входящие в него, наследуют свойство цвета от блока.

Назначение типа линий для слоя

Тип линий это повторяющийся образец из черточек, точек и пробелов, созданный для того чтобы отличать различные линии на чертеже. Имя и определение типа линий описывают отдельный образец-последовательность, относительную длину и включенные текстовые фрагменты или формы (shapes) для сложных типов линий. Для назначения слою типа линий есть свойство Linetype.

Удаление слоя

Для удаления слоя есть метод Delete. Нельзя удалить текущий слой, нулевой слой, слой зависящий от внешних ссылок и слой содержащий объекты. Слои, ссылающиеся на определение блока, называемые Defpoints, не могут быть удалены, даже если не содержат видимых объектов.

Работа с цветами

Цвет можно назначить слою или отдельному объекту, цвета определяются именами или индексами от 1 до 255 (кроме того 256 - по слою, 0 - по блоку). Стандартные имена цветов: 1 - красный, 2 - желтый, 3 - зеленый, 4 - синий, 5 - голубой, 6 - магента, 7 - черный или белый. Для установки цвета используй свойство Color.

Работа с типами линий

Тип линии представляет повторяющийся последовательности точек, тире и пробелов. Сложные типы линий включают так же символы. Описание типа линий включает эти последовательности и расстояния между их отдельными элементами, а так же их размеры. Можно создавать собственные типы линий. Перед использованием типа линии их следует загрузить в чертеж. Определение типа линий должно храниться в LIN-файле-библиотеке. Загружаются они методом Load. Пример:

Sub LoadLinetype()
  On Error GoTo ERRORHANDLER
  Dim linetypeName As String
  linetypeName = "CENTER"
  ' Загрузим тип линии "CENTER" из файла acad.lin
  ThisDrawing.Linetypes.Load linetypeName, "acad.lin"
  Exit Sub

ERRORHANDLER:
  MsgBox Err.Description
End Sub

Не стоит смешивать внутренние типы линий AutoCAD с типами линий некоторых плоттеров, их совместное использование может привести к непредсказуемым результатам.

Установка активного типа линий

Чтобы использовать загруженный тип линий его следует сделать активным. Все вновь создаваемые объекты рисуются активным типом линий. Если выбрано "по слою" вновь создаваемые объекты используют активный тип линий, если выбрано "по блоку" новые объекты рисуются используя активный тип линий до тех пор пока не будут объединены в блок. Свойство ActiveLineType устанавливает активный тип линий.

ThisDrawing.ActiveLinetype = ThisDrawing.Linetypes.Item("CONTINUOUS") 

Переименование типа линий

При переименовании типа линий меняется имя только определения типа линий, в файле LINE все остается без изменений. Для переименования применяется свойство Name.

Удаление типа линий

В любой момент можно удалить тип линий, кроме следующих: Bylayer, Byblock, Continuous, текущей и зависящей от внешней ссылки. Также нельзя удалить тип линии, которая входит в определение блока. Для удаления используется метод Delete.

Изменение описания типа линий

Типы линий могут иметь описание, которое можно изменить через свойство Description. Описание может содержать до 47 символов?

 ThisDrawing.ActiveLinetype.Description = "Внешняя стена" 

Задание масштаба типа линий

Чем меньше масштаб типа линий тем более плотная линия получается на единицу рисунка. По-умолчанию AutoCAD использует масштаб равный 1.0, для его изменения используется метод LinetypeScale. Системная переменная CELTSCALE задает масштаб типов линий для вновь создаваемых объектов. Пример:

Sub ChangeLinetypeScale()
  Dim center(0 To 2) As Double
  Dim radius As Double
  Dim circleObj As AcadCircle
  center(0) = 2: center(1) = 2: center(2) = 0: radius = 4
  Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
  ' задать масштаб типа линий окружности .5
  circleObj.LinetypeScale = 0.5
  circleObj.Update
End Sub

Назначение слоев, цветов и типов линий объектам

Число слоев в рисунке и число объектов на слое виртуально неограниченно. Пример изменения слоя объекта с применением свойства Layer.

Sub MoveObjectNewLayer()
  Dim circleObj As AcadCircle
  Dim center(0 To 2) As Double
  Dim radius As Double
  center(0) = 2: center(1) = 2: center(2) = 0: radius = 1
  Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
  Dim layerObj As AcadLayer
  Set layerObj = ThisDrawing.Layers.Add("ABC")
  circleObj.Layer = "ABC"
  circleObj.Update
End Sub

Константы для цвета объекта: acRed, acYellow, acGreen, acCyan, acBlue, acMagenta, acWhite. Пример изменения свойства Color у объекта:

Sub ColorCircle()
  Dim circleObj As AcadCircle
  Dim center(0 To 2) As Double
  Dim radius As Double
  center(0) = 2: center(1) = 2: center(2) = 0: radius = 1
  Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
  circleObj.Color = acRed
  circleObj.Update
End Sub

Пример изменения типа линий объекта. Создается окружность, делается попытка загрузить тип линии из acad.lin. Если тип линии уже есть или файл не существует, выдается сообщение об ошибке. В итоге для окружности устанавливается нужный тип линии.

Sub ChangeCircleLinetype()
  On Error Resume Next
  Dim circleObj As AcadCircle
  Dim center(0 To 2) As Double
  Dim radius As Double
  center(0) = 2: center(1) = 2: center(2) = 0: radius = 1
  Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)

  Dim linetypeName As String
  linetypeName = "CENTER"

  ' Загрузим тип линии "CENTER" из файла acad.lin
  ThisDrawing.Linetypes.Load linetypeName, "acad.lin"
  If Err.Description <> "" Then MsgBox Err.Description

  ' Назначим окружности тип линии "CENTER"
  circleObj.Linetype = "CENTER"
  circleObj.Update
  ZoomExtents
End Sub

Работа с текстом

Вставка текста в рисунок

AutoCAD предоставляет несколько возможностей по созданию текста. В простейшем случае это однострочный текст. Для длинных блоков с внутренним форматированием используется многострочный текст. Хотя вводимый текст использует текущий текстовый стиль, основанный на шрифте и его настройках по умолчанию, есть несколько способов изменить оформление.

Работа со стилями текста

Каждый текст имеет связанный с ним стиль. Стиль задает шрифт, размер, угол, ориентацию и другие характеристики текста. Атрибут стиля перечислены ниже в таблице.

Создание и изменение текстового стиля

Исключая стиль по умолчанию standard можно создавать любой собственный. Вновь вводимый текст наследует высоту, ширину, угол и др. свойства текущего стиля. После создания стиля текст имя его изменить нельзя. AutoCAD автоматически преобразует имя стиля в верхний регистр. Если не вводить имя, то оно будет Style[N] где N следующее числовое значение. Изменение текущего текстового стиля осуществляется модификацией свойств объекта TextStyle.

• FontFile - задает файл связанный со шрифтом;
• BigFontFile - задает форму не ASCII-символов;
• Height - задает высоту символа;
• Width - задает сжатие или растяжение символов;
• ObliqueAngle - задает угол наклона текста;
• TextGenerationFlag - задает зеркальный, перевернутый или оба.

Если изменить ориентацию текстового стиля все ранее введенные тексты этим стилем изменят ориентацию, изменение же размера, ширины, наклона так не влияет на ранее введенный текст. Впрочем поведение довольно загадочно, иногда меняется и отображение ранее введенного текста в последнем случае. Шрифт определяет форму символов. Один шрифт может быть использован для создания различных стилей. Пример назначении текстового стиля.

Sub UpdateTextFont()
  Dim typeFace As String
  Dim Bold As Boolean
  Dim Italic As Boolean
  Dim charSet As Long
  Dim PitchandFamily As Long
  ThisDrawing.ActiveTextStyle.GetFont typeFace, Bold, Italic, charSet, PitchandFamily
  typeFace = "PlayBill"
' Установить ранее созданный текстовой стиль
  ThisDrawing.ActiveTextStyle.SetFont typeFace, Bold, Italic, charSet, PitchandFamily
  ThisDrawing.Regen acActiveViewport
End Sub

Примение шрифтов true type (ttf)

Шрифты True Type всегда выглядят со сплошной заливкой, однако на печать они могут выводиться контурами, все зависит от состояния системной переменной TEXTFILL. При экспорте рисунка в формат PostScript шрифты будут печататься как было задуманно. Для повышения производительности AutoCAD Windows печатает TrueType шрифты непосредстенно, но в следствии ограничений Windows AutoCAD может по-своему их обрабатывать в случаях если текст перевернут, зеркально отражен и т.д. Трансформированный текст может выглядеть чуть толще чем задуманно при просмотре, но на печати должно быть все ОК.

Применение шрифтов unicode и bigfont

AutoCAD поддерживает стандарт Unicode, при котором в шрифте может содержаться до 65 тыс. символов из различных языков, правда ввести такие символы непосредственно невозможно, приходится пользоваться последовательностями \U+nnnn, где nnnn - шестнадцатиричный код символа. Все AutoCAD SHX-шрифты являются Unicode. Предыдущие релизы AutoCAD вплоть до 13, не поддерживают эту возможность. Шрифты BIGFONT используются для представления символов, алфавиты которых содержат тысячи "букв". Пример изменения файла шрифтов:

Sub ChangeFontFiles()
    ThisDrawing.ActiveTextStyle.BigFontFile = "C:/AutoCAD/Fonts/bigfont.shx"
    ThisDrawing.ActiveTextStyle.fontFile = "C:/AutoCAD/Fonts/italic.shx"
End Sub

Примечание: нельзя использовать длинные имена файлов содержащие запятую в качестве имени файла шрифта.

Установка высоты текста

Высота текста определяется размером символа в единицах вычерчивания. Значение обычно представляет размер букв верхнего регистра, исключение шрифты TrueType. Для них к высоте заглавных букв может прибавляться резевная зона для символов ударения. Причем этот размер определяется самостоятельно создателем шрифта. Кроме того для некоторых символов оставляется еще и резерв с низу (q, p, g и т.д.). Пример изменения размера шрифта текстового объекта.

Sub ChangeTextHeight()
  Dim textObj As AcadText
  Dim textString As String
  Dim insertionPoint(0 To 2) As Double
  Dim height As Double
  textString = "Hello, World."
  insertionPoint(0) = 3: insertionPoint(1) = 3: insertionPoint(2) = 0
  height = 0.5
  
  Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

  textObj.height = 1
  textObj.Update
End Sub

Пример установки наклона для текстового объекта

Sub ObliqueText()
  Dim textObj As AcadText
  Dim textString As String
  Dim insertionPoint(0 To 2) As Double
  Dim height As Double
  textString = "Hello, World."
  insertionPoint(0) = 3: insertionPoint(1) = 3: insertionPoint(2) = 0
  height = 0.5
  
  Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
  
  ' Изменим угол на 45 градусов (.707 радиан)
  textObj.ObliqueAngle = 0.707
  textObj.Update
  ZoomExtents
End Sub

Установка флага генерации текста

Данный флаг устанавливает режим отражения текста - "вверх ногами", зеркально или оба.

Sub ChangingTextGenerationFlag()
  Dim textObj As AcadText
  Dim textString As String
  Dim insertionPoint(0 To 2) As Double
  Dim height As Double
  textString = "Hello, World."
  insertionPoint(0) = 3: insertionPoint(1) = 3: insertionPoint(2) = 0
  height = 0.5
  Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)

  Dim Center(0 To 2) As Double
  Dim magnification As Double
  Center(0) = 3: Center(1) = 3: Center(2) = 0: magnification = 10
  ThisDrawing.Application.ZoomCenter Center, magnification

  textObj.TextGenerationFlag = acTextFlagBackward
  textObj.Update
  msgbox "Первая трансформация"
  textObj.TextGenerationFlag = acTextFlagUpsideDown
  textObj.Update
  msgbox "Вторая трансформация"
  textObj.TextGenerationFlag = acTextFlagUpsideDown+acTextFlagBackward
  textObj.Update
  msgbox "Обе трансформации сразу"
End Sub

Создание текста

Для создания текстового объекта используй метод AddLineText, требующий три параметра: собственно строка текста, точка вставки и высота текста. В качестве текстовой строки принимаются Unicode-символы, управляющие и специальные символы. Точка вставки - переменная типа Variant. Высота текста положительное значение в текущих единицах чертежа.

Пример:

Sub CreateText()
  Dim textObj As AcadText
  Dim textString As String
  Dim insertionPoint(0 To 2) As Double
  Dim height As Double
  textString = "Hello, World."
  insertionPoint(0) = 2: insertionPoint(1) = 2: insertionPoint(2) = 0
  height = 0.5
  Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
  textObj.Update
End Sub

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

Изменить оформление текста можно либо изменив назначенный ему текстовый стиль, либо меняя свойства самого текстового объекта. Форматировать можно только полностью строку, а не отдельное слово. Для изменения стиля есть свойство StyleName, после его изменения следует применять метод Update. Дополнительные свойства характерные только для текстов:

• Alignment - задает горизонтальное и вертикальное выравнивание;
• InsertionPoint - задает точку вставки;
• ObliqueAngle - задает угол наклона;
• Rotation - задает угол вращения в радианах;
• ScaleFactor - задает фактор масштабирования;
• TextAlignmentPoint - задает точку выравнивания;
• TextGenerationFlag - задает отоброжение вверх ногами,зеркальное и оба;
• TextString - задает текстовую строку.

Полный список свойств и методов приведен в справочной системе.

Повторное выравнивание текста

Пример создает объект Text и объект Point, последний задает точку выравнивания текста и меняется на красное перекрестие.

Sub TextAlignment()
  Dim textObj As AcadText
  Dim textString As String
  Dim insertionPoint(0 To 2) As Double
  Dim height As Double
  textString = "Hello, World."
  insertionPoint(0) = 3: insertionPoint(1) = 3: insertionPoint(2) = 0
  height = 0.5
  
  Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
  
  Dim Center(0 To 2) As Double
  Dim magnification As Double
  Center(0) = 3: Center(1) = 3: Center(2) = 0: magnification = 10
  ThisDrawing.Application.ZoomCenter Center, magnification

  Dim pointObj As AcadPoint
  Dim alignmentPoint(0 To 2) As Double
  alignmentPoint(0) = 3: alignmentPoint(1) = 3: alignmentPoint(2) = 0
  Set pointObj = ThisDrawing.ModelSpace.AddPoint(alignmentPoint)
  pointObj.Color = acRed
  
  ' сменим стиль отображения точки
  ThisDrawing.SetVariable "PDMODE", 2
  ' выровняем текст влево
  textObj.Alignment = acAlignmentLeft
  ThisDrawing.Regen acActiveViewport
  MsgBox "Текст выровнян по левому краю"
  
  ' теперь по центру
  textObj.Alignment = acAlignmentCenter
  
  ' теперь по точке
  textObj.TextAlignmentPoint = alignmentPoint
  
  ThisDrawing.Regen acActiveViewport
  MsgBox "Текст центрирован"
  
  ' Теперь вправо
  textObj.Alignment = acAlignmentRight
  ThisDrawing.Regen acActiveViewport
  MsgBox "Текст выровнен по правому краю"
  
End Sub

Модификации текста

Как и любой другой объект, текст можно перемещать, вращать, стирать, копировать. Можно так же зеркально отражать, при этом если не хочется, чтобы он был вывернут наизнанку, меняем значение системной переменной MIRRTEXT на ноль. Некоторые методы текста перечисленны ниже, все остальные можно узнать из справочной системы.

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