Урок 8. Программирование на VBA

 

1.          Введение. Обзор команд. Объектная модель. 1

2.          Доступ к иерархии объектов. Коллекции, свойства и методы.. 4

3.          Управление окружением AutoCAD.. 9

4.          Создание и редактирование примитивов и наборов объектов. 19

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

6.          Работа с текстом.. 43

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

8.          Настройка меню и панелей инструментов. 56

9.          Отслеживание событий. 65

10.       Работа с трехмерными поверхностями. 70

11.       Создание сплошных 3d объектов. 74

12.       Вычерчивание и настройка разметки (layouts) 77

13.       Работа с блоками, атрибутами и внешними ссылками. 85

14.       Разработка приложений с помощью vba. 95

15.       Создание диалоговых окон в VBA.. 99

16.       Упражнение. 103

 

1.    Введение. Обзор команд. Объектная модель

 

Введение

 

Интерфейс AutoCAD ActiveX/VBA дает некотрые преимущества по сравнению с другими методами создания приложений AutoCAD:

1.      Высокая скорость выполнения процесса, так как в отличие от AutoLISP-приложений выполнение команд происходит внутри процесса;

2.      Простота использования, обусловленная простотой языка программирования;

3.      Большие возможности межпрограмного обмена, так как VBA и ActiveX разрабатывались для взаимодействия с другими Windows-приложениями.

 

Понятие внедренных и глобальных проектов vba

 

Приложение Autocad VBA представляет собой набор программных модулей, модулей классов и форм. Пороект может быть сохранен как в рисунке (внедренный), так и во внешнем файле. Внедренный проект автоматически загружается при открытии рисунка. Ограничение внедренных проектов в том, например, что они не могут закрыть рисунок, внутри которого находятся. Глобальные проекты в этом плане более гибки, при этом однако пользователь должен знать где расположен файл в котором хранятся макросы. Глобальный проект проще передавать другим пользователям и в нем удобно хранить общие макросы. В любой момент могут быть использованы оба типа проектов. На уровне двоичного кода проект Autocad VBA не совместим с проектом Visual Basic, однако обмен формами, модулями и классами можно произвоидить через экспорт- импорт. (Команды IMPORT и EXPORT VBA).

 

Загрузка существующего проекта

 

При загрузке проекта все глобальные процедуры, называемые так же макросами, становятся доступными для использования. Загрузить проект можно через VBA-менеджер или с командной строки VBALOAD. Кроме того автокад грузит автоматически проект с именем acad.dvb, который может найти в путях файлов поддержки. При загрузке проекта может появиться предупреждение, что он содержит макросы, а значит может содержать и вирусы. Выгрузка проекта командной VBAUNLOAD приводит к высвобождению памяти ранее занятой проектом. Внедрить проект в рисунок можно с помощью VBA-менеджера, он же позволяет извлечь проект из рисунка, при этом предлагая сохранить его в отдельном файле. Чтобы среда разработки VBA автоматически грузилась с автокадом, в файл acad.arx нужно внести строку acadvba.arx.

 

Определение компонентов проекта

 

Проект может состоять из различных компонентов:

·         объекты;

·         формы;

·         стандартные модули;

·         модули класса;

·         ссылки.

Добавить компонент можно через меню Insert, компоненты так же можно импортировать из файлов (.frm, .bas, .cls).

 

Обзор команд vba autocad

 

VBAIDE - открывает окно VBA IDE, позволяющее редактировать, запускать и отлаживать программы.

VBALOAD - загружает проект.

VBARUN - запускает макрос на выполнение.

VBAUNLOAD - выгружает проект, освобождая память.

VBAMAN - показывает окно менеджера VBA.

VBASTMT - позволяет выполнить команду VBA в командной строке AutoCAD.

 

Основные понятия объектной модели AutoCAD

 

Все объекты Автокад организованы в виде иерархической структуры. Корнем дерева является объект Application.

Через объект Application можно получить доступ к следующим объектам:

Preferences;

Documents;

MenuBar;

MenuGroups;

Через объект Preferences можно получить доступ к следующим объектам

PreferencesDisplay;

PreferencesDrafting;

PreferencesFiles;

PreferencesOpenSave;

PreferencesOutput;

PreferencesProfiles;

PreferencesSelection;

PreferencesSystem;

PreferencesUser.

 

Через объект Documents можно получить доступ к объекту Document а через него к большинству других объектов и коллекций:

Blocks (блоки)

Dictionaries (словари)

DimStyles (размерные стили)

Groups (группы)

Layers (слои)

Layouts ()

Linetypes (типы линий)

PlotConfigurations (настройки плоттеров)

RegisteredApplications (зарегистрированные приложения)

SelectionSets (наборы)

TextStyles (стили текста)

UserCoordinateSystems (системы координат определенные пользователем)

Views (виды)

Viewports (видовые экраны)

DatabasePreferences ()

Plot (печать)

Utility (служебные программы)

ModelSpace (пространство модели)

PaperSpace (пространство листа)

В двух последних расположены объекты AutoCAD, видимые на рисунке:

3DFace

3DPoly

3DSolid

Arc

Attribute

AttributeReference

BlockReference

Circle

Dim3PointAngular

DimAligned

DimAngular

DimDiametric

DimOrdinate

DimRadial

DimRotated

Ellipse

ExternalReference

Hatch

Leader

LWPolyline

Line

MInsertBlock

MLine

MText

Point

PolyfaceMesh

Polyline

PolygonMesh

RasterImage

Ray

Region

Shape

Solid

Spline

Text

Tolerance

Trace

Xline

 

 

2.    Доступ к иерархии объектов. Коллекции, свойства и методы

 

Связь VBA с активным чертежом обеспечивается посредством объекта ThisDrawing. С его помощью можно получить немедленный доступ ко всем свойствам и методам объекта Document а также ко всем другим объектам в иерархии.

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

 

ThisDrawing.Save 

 

Ссылка на объекты в иерархии объектов

 

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

 

Sub Test()
  Dim startPoint(0 To 2) As Double, endPoint(0 To 2) As Double
  Dim LineObj As AcadLine
  startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0
  endPoint(0) = 30: endPoint(1) = 20: endPoint(2) = 0
  Set LineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
End Sub
 

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

 

Dim moSpace As AcadModelSpace
Set moSpace = ThisDrawing.ModelSpace
 

В примере добавляем линию в пространство модели, используя эту переменную:

 

Dim startPoint(0 To 2) As Double, endPoint(0 To 2) As Double
Dim LineObj as AcadLine
startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0
endPoint(0) = 30: endPoint(1) = 20: endPoint(2) = 0
Set LineObj = moSpace.AddLine(startPoint,endPoint)

Корневой объект Application расположен в иерархии выше объекта Document. Выше показано, что объект ThisDrawing обеспечивает доступ к объекту Document. А у объекта Document есть свойство Application, которое и является ссылкой на объект Application. Пример обращения:

ThisDrawing.Application.Update

Коллекции объектов

 

Объект Collection - является предопределенным объектом содержащим все вхождения подобных объектов. Существуют следующие объекты коллекции:

·         Documents - включает все открытые в текущей сессии документы

·         ModelSpace - включает все графические объекты (entities - примитивы) пространства модели

·         PaperSpace - включает все графические объекты пространства активного листа

·         Block Object - включает все указанные определения блоков

·         Blocks - включает все блочные ссылки рисунка

·         Dictionaries - включает все словари (Dictionaries) рисунка

·         DimStyles - включает все размерные стили рисунка

·         Groups - включает все группы рисунка

·         Groups - включает все гиперссылки рисунка

·         Layers - включает все слои рисунка

·         Layouts - включает все листы рисунка

·         Linetypes - включает все типы линий рисунка

·         MenuBar - включает все отображаемые AutoCADом меню

·         MenuGroups - включает все меню и панели инструментов

·         RegisteredApplications - включает все зарегистрированные приложения

·         SelectionSets - включает все наборы рисунка

·         TextStyles - включает все стили текста рисунка

·         UCSs - включает все пользовательсткие системы координат рисунка

·         Views - включает все Виды рисунка

·         Viewports - включает все видовые экраны рисунка

 

Доступ к коллекции

 

Большинство коллекций доступны через объект Document, т.к. он содержит свойства для каждой из коллекций. Следующий код устанавливает сслыку объектной переменной на коллекцию Layers:

 

Dim layerCollection as AcadLayers
Set layerCollection = ThisDrawing.Layers

 

Коллекции Documents, MenuBar и MenuGroups доступны через объект Application. Он содержит свойства для каждой из этих коллекций. Следующий пример определяет объектную переменную и создает ссылку через нее на коллекцию:

 
Dim MenuGroupsCollection as AcadMenuGroups
Set MenuGroupsCollection = ThisDrawing.Application.MenuGroups
 

Добавление нового элемента  коллекции

 

Следующий пример создает слой и добавляет его в коллекцию:

 
Dim newLayer as AcadLayer
Set newLayer = ThisDrawing.Layers.Add("MyNewLayer")

 

Перебор членов коллекции

 

Для выбора нужного члена коллекции используется метод Item. В качестве параметра ему передается номер (Index) объекта в коллекции либо его символьный идентификатор. Пример демонстрирует перебор всех слоев с отображеним их имен

 
Sub IterateLayer()
  On Error Resume Next
  Dim I As Integer
  Dim msg As String
  msg = ""
  For I = 0 To ThisDrawing.Layers.count - 1
    msg = msg + ThisDrawing.Layers.Item(I).Name + vbCrLf
  Next
  MsgBox msg
End Sub

 

Пример поиска слоя с именем ABC:

 
Sub FindLayerABC()
  On Error Resume Next
  Dim ABCLayer As AcadLayer
  Set ABCLayer = ThisDrawing.Layers.Item("ABC")
  If Err <> 0 Then
    MsgBox "Слой 'ABC' не существует"
  End If
End Sub

 

Примечание

Не следует использовать методы редактирования примитивов (Copy, Array, Mirror и др.) на любом объекте который одновременно перебирается с помощью механизма For Each. В случае необходимости нужно закончить перебор, создать временный массив эквивалентный коллекции и в этом массиве выполнить редактирование.

 

Удаление члена коллекции

 

Пример удаления слоя:

 

Dim ABCLayer as AcadLayer
Set ABCLayer = ThisDrawing.Layers.Item("ABC")
ABCLayer.Delete

 

Удаленный объект восстановлению не подлежит.

 

Понятие свойств и методов

 

Каждый объект обладает связанными с ним свойствами и методами. Свойства описывают некоторые характеристики присущие объекту, а методы позволяют выполнять действия над объектами, в частности, менять и читать свойства. Например, объект окружность имеет свойство Центр, которое представляет трехмерную координату центра окружности. Чтобы сменить свойство достаточно задать ему другое значение. Окружность как целое имеет метод Offset, который создает новый объект на указанном смещении от существующего. Полный перечень свойств и методов есть в ActiveX and VBA Reference.

 

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

 

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

 

Библиотеки типов

 

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

 

Получение первого примитива из базы данных рисунка

 

Sub FindFirstEntity()
  On Error Resume Next
  Dim entity As AcadEntity
  If ThisDrawing.ModelSpace.count <> 0 Then
    Set entity = ThisDrawing.ModelSpace.Item(0)
    MsgBox entity.ObjectName + " первый примитив в пространстве модели."
  Else
    MsgBox "Нет ни одного объекта в пространстве модели."
  End If
End Sub

 

Применение variant в методах и свойствах

 

Для передачи массива данных AutoCAD использует тип Variant который может принимать данные любого типа за исключением строк фиксированной длины и типов данных, определяемых пользователем. Может также принимать значения Empty, Error, Nothing, NULL. Чтобы узнать какой именно тип данных хранятся в переменной типа Variant, нужно обратиться к функции VarType или TypeName.

Тип данных Variant используется для передачи массива данных из/в AutoCAD ActiveX Automation. В AutoCAD VBA-входные массивы автоматически преобразуются в тип Variant. Однако c выходными массивами все не так просто. Метод CreateTypedArray преобразует массив в Variant, содержащий «смесь» из Integer, Double и т.д. Эту «смесь» можно передать в любой метод или любое свойство AutoCAD, которые принимают массив чисел как Variant.

В примере преобразуются три массива координат сплайна с передачей их методу AddSpline.

 

Sub CreateSplineUsingTypedArray()
  Dim splineObj As AcadSpline
  Dim startTan As Variant, endTan As Variant, fitPoints As Variant
  Dim noOfPoints As Integer
  Dim utilObj As Object
  Set utilObj = ThisDrawing.Utility
  ' Определение сплайна
  utilObj.CreateTypedArray startTan, vbDouble, 0.5, 0.5, 0
  utilObj.CreateTypedArray endTan, vbDouble, 0.5, 0.5, 0
  utilObj.CreateTypedArray fitPoints, vbDouble, 0, 0, 0, 5, 5, 0, 10, 0, 0
  noOfPoints = 3
  Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
  ZoomAll
End Sub
 

Интерпретация variant-массивов

 

Передаваемая AutoCAD ActiveX Automation информация массива возвращается как тип Variant, если типы данных элементов массива известны. Иначе применяем функции VarType Typename. Для перебора элементов массива удобен метод For Each. Пример вычисления расстояния между двумя точками введенными пользователем:

 
Sub CalculateDistance()
  Dim point1 As Variant,point2 As Variant
  ' Запрос на ввод координат
  point1 = ThisDrawing.Utility.GetPoint (, vbCrLf & "1-ая точка: ")
  point2 = ThisDrawing.Utility.GetPoint (point1, vbCrLf & "2-ая: ")
  Dim x As Double, y As Double, z As Double
  Dim dist As Double
  x = point1(0) - point2(0)
  y = point1(1) - point2(1)
  z = point1(2) - point2(2)
  dist = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))
  MsgBox "Расстояние между точками: " & dist
End Sub

 

 

Использование других языков программирования

 

Чтобы использовать приведенные примеры не в VBA а в VB следует, во-первых, сослаться на библиотеку типов, во-вторых заменить все ссылки ThisDrawing Для этого определить переменную для приложения AutoCAD (myApp) и для активного документа (myDoc). Если AutoCAD запущен, метод GetObject возвращает объект AutoCAD Application. Если AutoCAD не запущен, то вызывается обработчик ошибок. Затем метод CreateObject пытается создать объект AutoCAD Application, как в следующем примере:

 
Sub ConnectToAcad()
  Dim acadApp As AcadApplication
  On Error Resume Next
  Set acadApp = GetObject(, "AutoCAD.Application")
    If Err Then
      Err.Clear
      Set acadApp = CreateObject("AutoCAD.Application")
    If Err Then
      MsgBox Err.Description
      Exit Sub
    End If
  MsgBox "Запушен " + acadApp.Name + " версии " + acadApp.Version
End Sub
' Далее установить ссылку на Document object в приложении AutoCAD
Dim acadDoc as AcadDocument
Set acadDoc = acadApp.ActiveDocument

 

Здесь уже используем acadDoc-переменную для ссылки на текущий рисунок AutoCAD. Если запущены несколько сеансов, AutoCAD-функция GetObject возвращает первое вхождение из Windows Running Object Table (ROT).

Следующий пример демонстрирует создание линии в VB и VBA

 

Sub AddLineVBA()
  Dim lineObj As AcadLine
  Dim startPoint(0 To 2) As Double,endPoint(0 To 2) As Double
  ' Определим начальные и конечные координаты линии
  startPoint(0) = 1: startPoint(1) = 1: startPoint(2) = 0
  endPoint(0) = 5: endPoint(1) = 5: endPoint(2) = 0
  Set lineObj = ThisDrawing.ModelSpace.AddLine (startPoint, endPoint)
  ZoomExtents
End Sub
 
Sub AddLineVB()
  On Error Resume Next
  ' Подключение к приложению AutoCAD
  Dim acadApp As AcadApplication
  Set acadApp = GetObject (, "AutoCAD.Application")
  If Err Then
    Err.Clear
    Set acadApp = CreateObject ("AutoCAD.Application")
  If Err Then
    MsgBox Err.Description
    Exit Sub
  End If
  ' Подключение к рисунку AutoCAD
  Dim acadDoc As AcadDocument
  Set acadDoc = acadApp.ActiveDocument
  Dim lineObj As AcadLine
  Dim startPoint(0 To 2) As Double
  Dim endPoint(0 To 2) As Double
  startPoint(0) = 1: startPoint(1) = 1: startPoint(2) = 0
  endPoint(0) = 5: endPoint(1) = 5: endPoint(2) = 0
  Set lineObj = acadDoc.ModelSpace.AddLine (startPoint, endPoint)
  ZoomExtents
End Sub
 

3.    Управление окружением AutoCAD

 

Открытие, сохранение и закрытие чертежа

 

Коллекция Documents и объект Document обеспечивают доступ к файловым функциям. Для этого следует использовать один из методов Add, Close, Save, SaveAs, Import, Export. Пример открытия рисунка:

 
Sub OpenDrawing()
  Dim dwgName As String
  dwgName = "c:\Program Files\acad2002\sample\campus.dwg"
  If Dir(dwgName) <> "" Then
     ThisDrawing.Application.Documents.Open dwgName
  Else
     MsgBox "Файл " & dwgName & " не существует."
  End If
End Sub
 

Пример создания чертежа:

 
Sub NewDrawing()
  Dim docObj As AcadDocument
  Set docObj = ThisDrawing.Application.Documents.Add
End Sub

 

Пример сохранения рисунка:

 
Sub SaveActiveDrawing()
  ' Сохранить рисунок с текущим именем
  ThisDrawing.Save
  ' А теперь с новым именем
  ThisDrawing.SaveAs "MyDrawing.dwg"
End Sub
 

Проверка были ли в рисунке какие-то изменения с момента последнего сохранения

 

Sub TestIfSaved()
  If Not (ThisDrawing.Saved) Then
     If MsgBox("Сохранить изменения?", vbYesNo) = vbYes Then ThisDrawing.Save
  End If
End Sub

 

Установка собственных предпочтений

 

Доступ к объекту Preferences

 
Dim acadPref as AcadPreferences
Set acadPref = ThisDrawing.Application.Preferences

 

После чего можно получить доступ к любому объекту Preference (предпочтений) пользуясь свойствами Display, Drafting, Files, OpenSave, Output, Profile, Selection, System, и User properties. Например, сменить размер перекрестия:

 
acadPref.Display.CursorSize = 100
 

Объект database preferences включает все настройки, которые сохраняются всместе с текущим рисунком.

 

Управление окном приложения

 

Пример смены размера и положения окна, минимизация и увеличение до максимума:

 
Sub PositionApplicationWindow()
  ThisDrawing.Application.WindowTop = 0
  ThisDrawing.Application.WindowLeft = 0
  ThisDrawing.Application.width = 400
  ThisDrawing.Application.height = 400
  ThisDrawing.Application.WindowState = acMax
  ThisDrawing.Application.WindowState = acMin
End Sub

 

Проверка состояния окна:

 
Sub CurrentWindowState()
  Dim CurrWindowState As Integer
  Dim msg As String
  CurrWindowState = ThisDrawing.Application.WindowState
  msg = Choose(CurrWindowState, "normal", "minimized", "maximized")
  MsgBox "Окно приложения" + msg
End Sub

 

Сделать окно невидимым:

 
ThisDrawing.Application.Visible = False
 

Управление окном рисунка

 

Аналогично окну приложения можно менять размеры и подчиненного окна - чертежа, как например:

 
Sub CurrentWindowState()
  Dim CurrWindowState As Integer
  Dim msg As String
  ThisDrawing.Width = 400
  ThisDrawing.Height = 400
  ThisDrawing.WindowState = acMin
  ThisDrawing.WindowState = acMax
  CurrWindowState = ThisDrawing.WindowState
  msg = Choose(CurrWindowState, "normal", "minimized", "maximized")
  MsgBox "Окно документа " + msg
End Sub
 

Использование zoom.

 

Виды — это особые комбинации расположения, масштаба и ориентации рисунка. Команда zoom не меняет размер рисунка, она влияет только на размер его отображения на экране. AutoCAD предлагает несколько путей "зуммирования" по указанному окну, вписать рисунок в окно, указать масштаб вручную. Для "зуммирования" с указанием границ используются методы ZoomWindow или ZoomPickWindow Первый из них позволяет все сделать чисто программно, второй требует ввода границ окна от пользователя. Пример:

 

Sub ZoomWindow()
  MsgBox "Увеличение в пределах:" & vbCrLf & "1.3, 7.8, 0" & vbCrLf & "13.7, -2.6, 0"
  Dim point1(0 To 2) As Double
  Dim point2(0 To 2) As Double
  point1(0) = 1.3: point1(1) = 7.8: point1(2) = 0
  point2(0) = 13.7: point2(1) = -2.6: point2(2) = 0
  ThisDrawing.Application.ZoomWindow point1, point2
  MsgBox "А теперь ZoomPickWindow"
  ThisDrawing.Application.ZoomPickWindow
End Sub

 

Масштабирование вида

 

Если нужно точно указать коэффициент увеличения или уменьшенияизображения на экране, то можно воспользоваться тремя способами:

·         Относительно границ рисунка

·         Относительно текущего вида

·         Относительно единиц вычерчивания на листе

При этом следует просто ввести значение. Например, 2 для увеличения в 2 раза и .5 для уменьшения в два раза.

Для масштабирования вида используется метод ZoomScaled, на входе он принимает два параметра масштаб и тип масштаба. Типы масштаба задаются константами: acZoomScaledAbsolute, acZoomScaledRelative, acZoomScaledRelativePSpace.

 

Sub ZoomScaled()
   MsgBox "Масштабирование:" & vbCrLf & "Тип: acZoomScaledRelative" & vbCrLf & "Фактор: 2"
   Dim scalefactor As Double
   Dim scaletype As Integer
   scalefactor = 2
   scaletype = acZoomScaledRelative
   ThisDrawing.Application.ZoomScaled scalefactor, scaletype
End Sub
 

Центрирование

 

Указанную точку рисунка можно поместить по центру экрана методом ZoomCenter как в следующем примере:

 

Sub ZoomCenter()
  MsgBox "Центрировать:" & vbCrLf & "Центр: 3,3,0" & vbCrLf &  "Увеличение: 10"
  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
End Sub
 

Показ границ (limits) и протяженности (extents) рисунка

 

Для отображения границ рисунка или границ объектов используется методы ZoomAll, ZoomExtents, ZoomPrevious. Первый из них показывает рисунок полностью. Если границы объектов выходят за пределы границ рисунка, то показывается по границам объектов и наооборот.

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

ZoomAll аналогично ZoomExtents но при этом включается еще и зона границ. Если зона границ окажется заполнена мало все окно может оказаться пустым. Наиболее удобным вариантом просмотра всего рисунка является метод ZoomExtents.

 

Sub ZoomAll()
  MsgBox "ZoomAll"
  ThisDrawing.Application.ZoomAll
  MsgBox "ZoomExtents"
  ThisDrawing.Application.ZoomExtents
End Sub
 

Использование именованных видов

 

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

 

Sub AddView()
  Dim viewObj As AcadView
  Set viewObj = ThisDrawing.Views.Add("View1")
  msgbox "А теперь удалить вид"
  ThisDrawing.Views("View1").Delete
End Sub
 

Видовой экран можно разбивать на части методами: acViewport2Horizontal, acViewport2Vertical, acViewport3Left, acViewport3Right, acViewport3Horizontal, acViewport3Vertical, acViewport3Above, acViewport3Below, acViewport4.

 

Sub SplitAViewport()
  Dim vportObj As AcadViewport
  Set vportObj = ThisDrawing.Viewports.Add("TEST_VIEWPORT")
  vportObj.Split acViewport2Horizontal
  ThisDrawing.ActiveViewport = vportObj
End Sub
 

Пример разбивки видовых экранов и перебор открытых окон:

 

Sub IteratingViewportWindows()
  Dim vportObj As AcadViewport
  Set vportObj = ThisDrawing.Viewports.Add("TEST_VIEWPORT")
  ThisDrawing.ActiveViewport = vportObj ' сделать активным
  vportObj.Split acViewport4 ' Разбить на 4 окна
  ' Перебор видовых экранов, подсвечивая каждый
  ' и показывая углы для каждого
  Dim vport As AcadViewport
  Dim LLCorner As Variant,URCorner As Variant
  For Each vport In ThisDrawing.Viewports
    ThisDrawing.ActiveViewport = vport
    LLCorner = vport.LowerLeftCorner
    URCorner = vport.UpperRightCorner
    MsgBox "Видовой экран: " & vport.Name & " активнен." & _
    vbCrLf & "Нижний левый угол: " & _
    LLCorner(0) & ", " & LLCorner(1) & _
    vbCrLf & "Верхний правый: " & URCorner(0) & ", " & URCorner(1)
  Next vport
End Sub

 

Необходимо после выполнения операций выполнять обновление содержимого экрана, так как не все методы выполняют обновление автоматически.

 

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

Переустановка активных объектов

 

Изменение большинства активных объектов (слоев, типов линий) вступает в силу немедленно, однако некоторые активные объекты требуют повторной установки. (это стили текста, видовые экраны и ПСК). Для их переустановки требуется установка свойств ActiveTextStyle, ActiveUCS, ActiveViewport.

 
Sub ResetActiveViewport()
' переключим сетку
  ThisDrawing.ActiveViewport.GridOn = Not (ThisDrawing.ActiveViewport.GridOn)
  ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
End Sub
 

Установка и считывание системных переменных

 

У объекта Document есть два метода SetVariable и GetVariable. Пример:

 

ThisDrawing.SetVariable "TEXTFILL", 1

 

Высокоточное вычерчивание

 

AutoCAD позволяет вычерчивать объекты с точно заданными характеристиками, не прибегая при этом к утомительным вычислениям. Ограничением VBA для Autocad  является то что через VBA нельзя установить изометрическую сетку и привязку, установить объектную привязку, указать измеряемые отрезки на объекте или поделить объект на сегменты.

 

Регулировка привязки и выравнивания сетки

 

Изменение угла и базовой точки. В данном примере базовая точка устанавливается равной 1,1 и угол наклона сетки 30 градусов:

 

Sub ChangeSnapBasePoint()
  ' Включим сетку
  ThisDrawing.ActiveViewport.GridOn = True
  ' Сменим базовую точку 1,1
  Dim newBasePoint(0 To 1) As Double
  newBasePoint(0) = 1: newBasePoint(1) = 1
  ThisDrawing.ActiveViewport.SnapBasePoint = newBasePoint
  ' Сменим угол для привязки на 30 градусов (.575 радиан)
  Dim rotationAngle As Double
  rotationAngle = 0.575
  ThisDrawing.ActiveViewport.SnapRotationAngle = rotationAngle
  ' переустановим видовой экран
  ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
End Sub
 

Включение режима орто (нужен для простой отрисовки перпендикуляров)

ThisDrawing.ActiveViewport.OrthoOn = True

Построение конструкционных линий (в обе стороны бесконечных)

 

Sub AddXLine()
  Dim xlineObj As AcadXline
  Dim basePoint(0 To 2) As Double
  Dim directionVec(0 To 2) As Double
  basePoint(0) = 2#: basePoint(1) = 2#: basePoint(2) = 0#
  directionVec(0) = 1#: directionVec(1) = 1#: directionVec(2) = 0#
  Set xlineObj = ThisDrawing.ModelSpace.AddXLine (basePoint, directionVec)
  ThisDrawing.Application.ZoomAll
End Sub
 

Опрос конструкционных линий

 

В примере ищется базовая точка и направляющий вектор:

 

Dim BPoint As Variant
Dim Vector As Variant
Set BPoint = xlineObj.basePoint
Set Vector = xlineObj.DirectionVector

СОЗДАНИЕ, ОПРОС И РЕДАКТИРОВАНИЕ ЛУЧЕЙ

Sub EditRay()
  Dim rayObj As AcadRay
  Dim basePoint(0 To 2) As Double,secondPoint(0 To 2) As Double
  ' Определим луч
  basePoint(0) = 3#: basePoint(1) = 3#: basePoint(2) = 0#
  secondPoint(0) = 4#: secondPoint(1) = 4#: secondPoint(2) = 0#
  ' Создадим луч в пространстве модели
  Set rayObj = ThisDrawing.ModelSpace.AddRay (basePoint, secondPoint)
  ThisDrawing.Application.ZoomAll
  ' Получим состояние луча
  MsgBox "Базовая точка луча: " & rayObj.basePoint(0) & ", " & _
  rayObj.basePoint(1) & ", " & rayObj.basePoint(2) & vbCrLf & _
  "Направляющий вектор луча: " & rayObj.DirectionVector(0) & ", " & _
  rayObj.DirectionVector(1) & ", " & rayObj.DirectionVector(2)
  ' Изменим направляющий вектор луча
  Dim newVector(0 To 2) As Double
  newVector(0) = -1 : newVector(1) = 1 : newVector(2) = 0
  rayObj.DirectionVector = newVector
  ThisDrawing.Regen False
  MsgBox "Базовая точка луча: " & rayObj.basePoint(0) & ", " & _
  rayObj.basePoint(1) & ", " & rayObj.basePoint(2) & vbCrLf & _
  "Направляющий вектор луча: " & rayObj.DirectionVector(0) & ", " & _
  rayObj.DirectionVector(1) & ", " & rayObj.DirectionVector(2)
End Sub
 

Вычисления с использованием выражений

 

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

·         Найти угол линии от оси X методом AngleFromXAxis

·         Преобразовать угол из строки в вещественное (двойной точности) методом AngleToReal

·         Преобразовать угол из вещественного (двойной точности) в строку методом AngleToString

·         Преобразовать расстояние из строки в вещественное (двойной точности) методом DistanceToReal

·         Создать переменную типа Variant, содержащую массив целых, с плавающей точкой двойной точности и т.д. методом CreateTypedArray

·         Найти точку отложенную на заданном расстоянии и под заданным углом методом PolarPoint

·         Перевести точку в другую систему координат методом TranslateCoordinates

·         Найти расстояние между двумя точками методом GetDistance

Sub GetDistanceBetweenTwoPoints()
  Dim returnDist As Double
  returnDist = ThisDrawing.Utility.GetDistance (, "Выбери 2 точки.")
  MsgBox "Расстояние между точками: " & returnDist
End Sub
 

Подсчет площадей

 

Используя значение свойства Area, определим площадь многоугольника, вершины которого указаны пользователем:

 
Sub CalculateDefinedArea()
  Dim p1 As Variant,p2 As Variant,p3 As Variant,p4 As Variant,p5 As Variant
  ' Получить точки от пользователя
  p1 = ThisDrawing.Utility.GetPoint(, vbCrLf & "1-ая точка: ")
  p2 = ThisDrawing.Utility.GetPoint(p1, vbCrLf & "2-ая точка: ")
  p3 = ThisDrawing.Utility.GetPoint(p2, vbCrLf & "3-ая точка: ")
  p4 = ThisDrawing.Utility.GetPoint(p3, vbCrLf & "4-ая точка: ")
  p5 = ThisDrawing.Utility.GetPoint(p4, vbCrLf & "5-ая точка: ")
  ' Создаем двумерную полилинию
  Dim polyObj As AcadLWPolyline
  Dim vertices(0 To 9) As Double
  vertices(0) = p1(0): vertices(1) = p1(1)
  vertices(2) = p2(0): vertices(3) = p2(1)
  vertices(4) = p3(0): vertices(5) = p3(1)
  vertices(6) = p4(0): vertices(7) = p4(1)
  vertices(8) = p5(0): vertices(9) = p5(1)
  Set polyObj = ThisDrawing.ModelSpace.AddLightWeightPolyline (vertices)
  polyObj.Closed = True
  ThisDrawing.Application.ZoomAll
  MsgBox "Площадь определенная точками " & polyObj.Area
End Sub
 

Получение ввода от пользователя

 

Объект Utility может получать ввод от пользователя данных определенного типа, например метод GetString возвращает строку, GetPoint возвращает значение типа Variant и GetInteger возвращает целое. Управление вводом пользователя можно осуществлять методом InitializeUserInput. Он позволяет проверять пустой ввод (NULL), ввод отрицательных значений. Метод GetString принимает два параметра, если первый из них равен 0, то пробел сразу завершает ввод, второй - строка подсказка.

 

Sub GetStringFromUser()
  Dim retVal As String
  retVal = ThisDrawing.Utility.GetString (1, vbCrLf & "Как вас зовут: ")
  MsgBox "Привет, " & retVal
End Sub
 

Метод GetPoint тоже принимает два параметра, необязательную первую точку и строку подсказки. Для ограничения выбора пользователя при вводе может использовать вызов метода InitializeUserInput.

 

Sub GetPointsFromUser()
  Dim startPnt As Variant,endPnt As Variant
  Dim prompt1 As String,prompt2 As String
  prompt1 = vbCrLf & "Начальная точка линии: "
  prompt2 = vbCrLf & "Конечная точка линии: "
  startPnt = ThisDrawing.Utility.GetPoint(, prompt1)
  ' Используем ранее введенную точку как базовую
  endPnt = ThisDrawing.Utility.GetPoint(startPnt, prompt2)
  ThisDrawing.ModelSpace.AddLine startPnt, endPnt
  ThisDrawing.Application.ZoomAll
End Sub
 

Метод GetKeyword принимает только один параметр, это ключевое слово Autocad и так же может использовать вызова метода InitializeUserInput.

 

Sub KeyWord()
  Dim keyWord As String
  ThisDrawing.Utility.InitializeUserInput 1, "Line Circle Arc"
  keyWord = ThisDrawing.Utility.GetKeyword (vbCrLf & "Введите (Line/Circle/Arc): ")
  MsgBox keyWord
End Sub
 

Более дружественный для пользователя вариант выбирает один из вариантов как выбор по умолчанию, осуществляющийся при нажатии Enter

 

Sub KeyWord2()
  Dim keyWord As String
  ThisDrawing.Utility.InitializeUserInput 0, "Line Circle Arc"
  keyWord = ThisDrawing.Utility.GetKeyword (vbCrLf & "Введите (Line/Circle/): ")
  If keyWord = "" Then keyWord = "Arc"
  MsgBox keyWord
End Sub
 

Управление вводом пользователя

 

Применение метода InitializeUserInput позволяет определить ключевые слова или ограничить тип вводимых значений. Данный метод может применяться совместно со следующими методами GetAngle, GetCorner, GetDistance, GetInteger, GetKeyword, GetOrientation, GetPoint, GetReal (но не с GetString, в этом случае есть метод GetInput для получения строкового значения).

Метод InitializeUserInput принимает два параметра - первый битовое значение, определяющее опции ввода, второй строковый - определяет допустимые ключевые слова.

 

Получение целого или ключевого слова путем ввода в командной строке

 

Пример ввода положительного целого

 

Sub UserInput()
  ' Первый параметр (6) ограничивает ввод положительными целыми
  ' Второй список ключевых слов
  ThisDrawing.Utility.InitializeUserInput 6, "Big Small Regular"
  Dim promptStr As String
  promptStr = vbCrLf & "Размер (Big/Small/[Regular]):"
  ' Ввод ключевого слов в метод GetInteger вызовет ошибку
  ' чтобы позволить программе выполняться дальше
  ' установим обработчик ошибок
  On Error Resume Next
  ' Получить ввод от пользователя
  Dim returnInteger As Integer
  returnInteger = ThisDrawing.Utility.GetInteger(promptStr)
  ' Проверить нет ли ошибки, затем использовать GetInput для получения
  ' строки иначе значение returnInteger.
  If Err.Description = "User input is a keyword" Then
    Dim returnString As String
    returnString = ThisDrawing.Utility.GetInput()
    Err.Clear
  Else
    If returnInteger = 0 Then ' Нажат ENTER
       returnString = "Regular" ' значение по-умолчанию
    Else
       returnString = returnInteger ' введенное значение
    End If
  End If
  MsgBox returnString, , "Пример InitializeUserInput"
End Sub
 

Доступ к командной строке autocad

 

Имитировать ввод команд в командную строку с возможностью передачи параметров команде позволяет метод SendCommand. Пробел в данной строке эквивалентен нажатию Enter. Вызов данного метода без аргументов не допускается.

Следующий пример создает окружность с центром (2,2,0) и радиусом 4.

 

Sub SendACommandToAutoCAD()
ThisDrawing.SendCommand "_Circle 2,2,0 4 "
ThisDrawing.SendCommand "_zoom a "
End Sub
 

Обратите внимание на пробел в конце каждой строки.

 

Если не открыт ни один документ

 

Несмотря на то, что Autocad всегда стартует с пустым или открытым документом существует возможность закрыть все документы, при этом главное меню сократится до 4-х пунктов (File, View, Window, Help), а также пропадет командная строка. Интерфейс ActiveX в данном случае позволяет выполнять только следующие действия

·         Открыть документ

·         Создать документ

·         Импортировать документ

·         Выйти из Autocad

Эти действия доступны для всей коллекции Documents, кроме того методы и свойства данной коллекции ограничены набором методов и свойств объекта Application. Свойство Count коллекции Documents открыт ли хоть один документ.If Documents.Count > 0 Then открыт как минимум один документ. Здесь важно также заметить, что объект ThisDrawing неопределен, если не открыт ни один документ, поэтому попытка выполнить макрос с ThisDrawing приведет к ошибке периода выполнения. Вместо этого используй функцию GetObject.

 

Импорт файлов других форматов

 

Метод Import позволяет импортировать файлы форматов DXF, SAT, BMP, PostScript. Он принимает три параметра: имя файла, точку вставки и фактор масштабирования.

 

Экспорт в другие форматы

 

Метод Export поддерживает следующие форматы: WMF, SAT, EPS, DXF, DWF, BMP. Он принимает три параметра: имя создаваемого файла, тип создаваемого файла и набор экспортируемых объектов. При экспорте в WMF, SAT или BMP должен существовать непустой набор. В EPS и DXF экспортируется весь рисунок.

Пример эскпорта-импорта в DXF

 

Sub ImportingAndExporting()
  ' Созадим окружность, чтоб было что экспортировать
  Dim circleObj As AcadCircle
  Dim centerPt(0 To 2) As Double,radius As Double
  centerPt(0) = 2: centerPt(1) = 2: centerPt(2) = 0: radius = 1
  Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)
  ThisDrawing.Application.ZoomExtents
  ' Создадим пустой набор
  Dim sset As AcadSelectionSet
  Set sset = ThisDrawing.SelectionSets.Add("NEWSSET")
  ' Экспорт в файл C:\DXFExprt, если каталог не существует - ошибка
  Dim exportFile As String
  exportFile = "C:\DXFExprt"
  ThisDrawing.Export exportFile, "DXF", sset
  ' Определим импорт
  Dim importFile As String
  Dim insertPoint(0 To 2) As Double
  Dim scalefactor As Double
  importFile = "C:\DXFExprt.dxf"
  insertPoint(0) = 0: insertPoint(1) = 0: insertPoint(2) = 0: scalefactor = 2#
  ' Импортируем файл
  ThisDrawing.Import importFile, insertPoint, scalefactor
  ThisDrawing.Application.ZoomExtents
End Sub

 

4.    Создание и редактирование примитивов и наборов объектов

 

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

 

Создание объектов

 

Несмотря, на то что Autocad может создать один и тот же объект разными путями, ActiveX автоматизация допускает только один метод на объект. Например, для создания окружности можно указать 1. центр и радиус 2. две точки, задающие диаметр, 3. три точки определяющие окружность, 4. два тангенса и радиус. Однако ActiveX позволят воспользоваться только первым из них.

Примечание: метод VB и VBA CreateObject или Dim позволяют создать только объект Autocad Application, все остальные объекты создаются методами Add и Add[Object].

 

Определение объекта-контейнера

 

Объекты создаются в коллекциях ModelSpace, PaperSpace или объекте Block. На объект можно сослаться непосредственно или через объектную переменную. Непосредственная ссылка включает всю иерархию:

 

Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint,endPoint)

 

Для ссылки на объект через объектную переменную следует создать переменную типа AcadModelSpace или AcadPaperSpace. И установить ссылку на нужное свойство активного документа. В следующем примере две объектные переменные ссылаются на Model Space и PaperSpace соответственно:

 

Dim moSpace As AcadModelSpace

Dim paSpace As AcadPaperSpace

Set moSpace = ThisDrawing.ModelSpace

Set paSpace = ThisDrawing.PaperSpace

 

'В следующей строке в пространство модели добавляется линия через объектную переменную:

Set lineObj = moSpace.AddLine(startPoint,endPoint)

 

Создание линий

 

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

·         AddLine - создает линию по двум точкам;

·         AddLightWeightPolyline - создает двумерную полилинию;

·         AddMLine - создает мультилинию;

·         AddPolyLine - создает двумерную или трехмерную полилинию.

Стандартные линии и мультилини создаются в плоскости XY полилинии создаются в Object Coordinat System. Пример создания полилини:

 
Sub AddLightWeightPolyline()
  Dim plineObj As AcadLWPolyline
  Dim points(0 To 5) As Double
  ' Вершины двумерной полилини
  points(0) = 2: points(1) = 4
  points(2) = 4: points(3) = 2
  points(4) = 6: points(5) = 4
  ' Создаем полилинию в пространстве модели
  Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
  ThisDrawing.Application.ZoomExtents
End Sub
 

Создание криволинейных объектов

 

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

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

 

Sub CreateSpline()
  Dim splineObj As AcadSpline
  Dim noOfPoints As Integer
  Dim startTan(0 To 2) As Double
  Dim endTan(0 To 2) As Double
  Dim fitPoints(0 To 8) As Double
  ' Определение переменных
  noOfPoints = 3
  startTan(0) = 0.5: startTan(1) = 0.5: startTan(2) = 0
  endTan(0) = 0.5: endTan(1) = 0.5: endTan(2) = 0
  fitPoints(0) = 1: fitPoints(1) = 1: fitPoints(2) = 0
  fitPoints(3) = 5: fitPoints(4) = 5: fitPoints(5) = 0
  fitPoints(6) = 10: fitPoints(7) = 0: fitPoints(8) = 0
  ' Собственно сплайн
  Set splineObj = ThisDrawing.ModelSpace.AddSpline (fitPoints, startTan, endTan)
  ZoomExtents
End Sub
 

Более подробная информация о сплайнах в AutoCAD ActiveX and VBA Reference.

 

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

 

Стиль создаваемой точки и ее размер можно указать в относительных единицах к размеру экрана или в абсолютных. Управление видом точек делается через системные переменные PDMODE, PDSIZE. Значения переменной PDMODE равные 0,2,3,4 представляют разные формы точки, значение равное 1 - означает невидимую точку. Добавление 32, 64 или 96 означает вокруг точки фигуру (окружность, квадрат, окружность вписанную в квадрат). Значение переменной PDSIZE равное нулю задает размер точки 5% от размера экрана, а любые положительные значения - абсолютный размер. Отрицательные же значения интерпритируются как процент от размера видового экрана. Размер всех точек пересчитывается при регенерации, т.е. изменение PDMODE, PDSIZE сразу не заметно. Для установки значений системных переменных используется метод SetVariable, ниже приведен пример его применения:

 

Sub CreatePoint()
  Dim pointObj As AcadPoint
  Dim location(0 To 2) As Double
  ' Определение положения точки
  location(0) = 5#: location(1) = 5#: location(2) = 0#
  ' Ставим точку
  Set pointObj = ThisDrawing.ModelSpace.AddPoint(location)
  ThisDrawing.SetVariable "PDMODE", 34
  ThisDrawing.SetVariable "PDSIZE", 1
  ZoomExtents
End Sub
 

Создание сплошной заливки

 

Возможно создание триугольной и прямоугольной области со сплошной заливкой. Наиболее быстрый способ — создание области при выключенной системной переменной FILLMODE и затем включение ее. Последовательность второй и четвертой точки области определяют способ заливки (слева направо и сверху вниз - если 1,2,3,4 то прямоугольная, если 1,2,4,3 то треугольная). Первые две точки задают сторону полигона. Для создания области со сплошной заливкой есть метод AddSolid. Пример объекта с заливкой.

 

Sub CreateSolid()
  Dim solidObj As AcadSolid
  Dim point1(0 To 2) As Double,point2(0 To 2) As Double
  Dim point3(0 To 2) As Double,point4(0 To 2) As Double
  ' Определение сплошной заливки
  point1(0) = 0#: point1(1) = 0#: point1(2) = 0#
  point2(0) = 5#: point2(1) = 0#: point2(2) = 0#
  point3(0) = 5#: point3(1) = 8#: point3(2) = 0#
  point4(0) = 0#: point4(1) = 8#: point4(2) = 0#
  Set solidObj = ThisDrawing.ModelSpace.AddSolid (point1, point2, point3, point4)
  ZoomExtents
End Sub
 

Создание регионов

 

Регион представляет двухмерную замкнутую фигуру, границы которой не имеют внутренних пересечений. Может состоять из комбинации линий, окружностей, дуг, эллипсов, эллиптических дуг, сплайнов и некоторых других объектов. Весь объект должен лежать в одной плоскости. Трехмерная полилиния может быть преобразована в регион путем "взрыва". К региону применима штриховка и тень, у него есть свойства - площадь и момент инерции. Создав фигуры можно выбрав их создать регион, используя метод AddRegion. AutoCAD преобразует замкнутые двумерные и трехмерные планарные полилинии в отдельные регионы, а полилинии, линии и кривые образуют замкнутые планарные петли. Если более двух кривых разделяют конечную точку результирующий регион может быть присужден. (arbitrary) используйте Variant для хранения вновь создаваемых массивов регионов. Для подсчета количества созданных объектов Region используйте UBound(objRegions) - LBound(objRegions) + 1,где objRegions переменная Variant содержащая массив возвращенный методом AddRegion.Пример простого региона из одной окружности:

 

Sub CreateRegion()
  ' Определим массив хранящий границы региона
  Dim curves(0 To 0) As AcadCircle
  ' Создаем окружность как границу региона
  Dim center(0 To 2) As Double,radius As Double
  center(0) = 2: center(1) = 2: center(2) = 0: radius = 5#
  Set curves(0) = ThisDrawing.ModelSpace.AddCircle (center, radius)
  ' Теперь сам регион
  Dim regionObj As Variant
  regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
  ZoomExtents
End Sub
 

Создание составных регионов

 

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

 

Sub CreateCompositeRegions()
  ' Создадим две окружности - одна комната, вторая ковер в ней
  Dim RoomObjects(0 To 1) As AcadCircle
  Dim center(0 To 2) As Double
  Dim radius As Double
  center(0) = 4: center(1) = 4: center(2) = 0: radius = 2#
  Set RoomObjects(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
  radius = 1#
  Set RoomObjects(1) = ThisDrawing.ModelSpace.AddCircle(center, radius)
  ' Теперь регион из двух окружностей
  Dim regions As Variant
  regions = ThisDrawing.ModelSpace.AddRegion(RoomObjects)
  ' Скопируем его в переменную для простоты использования
  Dim RoundRoomObj As AcadRegion,PillarObj As AcadRegion
  If regions(0).Area > regions(1).Area Then
    ' Первый регион - комната
    Set RoundRoomObj = regions(0)
    Set PillarObj = regions(1)
  Else
    ' Первый регион - ковер
    Set PillarObj = regions(0)
    Set RoundRoomObj = regions(1)
  End If
  ' Окрасим комнату и ковер разными цветами
  RoundRoomObj.Color = acRed
  PillarObj.Color = acCyan
  ZoomExtents
  ' Отнимем площадь ковра от площади комнаты
  RoundRoomObj.Boolean acSubtraction, PillarObj
  MsgBox "Площадь ковра: " & RoundRoomObj.Area
End Sub
 

Для объединения регионов вызывайте метод Boolean и вводите константу acUnion, для операции вместо acSubtraction, а для пересечения acIntersection.

 

Создание штриховок

 

Штриховки заполняют указанную область рисунка образцом. При ее создании сначала следует создать объект Hatch методом AddHatch. Ассоциированная штриховка привязана к определенным границам и меняется вместе с ними. Привязка может бть задана только при создании штриховки, после этого штриховку можно отвязать, но нельзя привязать снова. Чтобы сделать штриховку ассоциированной следует использовать параметр Associativity=TRUE для метода AddHatch, а для разрыва связи Associativity=FALSE.

 

Назначение имени и типа штриховке

 

В AutoCAD есть сплошная заливка и более 15 штриховок применяемых в производтстве. Штриховка подчеркивает отельную часть рисунка или области. Поддерживаются внешние библиотеки с образцами штриховок. Для указания уникального образца следует давать полное имя и тип штриховки. Тип штриховки указывает местоположение образцов штриховки. acHatchPatternTypePredefined (в acad.pat), acHatchPatternTypeUserDefined (используя текущий тип линий), acHatchPatternTypeCustomDefined (из другого pat-файла).

 

Задание границ штриховки

 

Как только создан объект Hatch можно добавлять границы штриховки. Они могут задаваться комбинацией линий, дуг, окружностей, двумерных полилиний, эллипсов, сплайнов и регионов. Первая граница должна быть внешней границей штриховки, (метод AppendOuterLoop). Внутренние границы задаются методом AppendInnerLoop. Они определяют незаштрихованные "островки" внутри штрихованной области. Пример штриховки.

 

Sub CreateHatch()
  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 outerLoop(0 To 0) As AcadEntity
  Dim center(0 To 2) As Double
  Dim radius As Double
  center(0) = 3: center(1) = 3: center(2) = 0: radius = 1
  Set outerLoop(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
  hatchObj.AppendOuterLoop (outerLoop)
  hatchObj.Evaluate
  ThisDrawing.Regen True
End Sub
 

Редактирование объектов

 

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

 

Работа с именованными объектами и их переименование

 

 

Именованные объекты это блоки, слои, группы, размерные стили и т.п. Чистка именованных объектов на которые в текущем рисунке нет ссылок осуществляется методом ThisDrawing.PurgeAll.

По мере усложнения чертежа может возникать необходимость давать объектам другие более осмысленные имена. Перименовать можно почти все, кроме, например, 0 слоя и типа линий continuose. Имя может быть длиной до 255 символов (буквы, цифры, спецсимволы кроме тех которые используются самим AutoCADом < > / \ " : ; ? * | = ' и запятая). Пример переименования

 

Sub RenamingLayer()
  Dim layerObj As AcadLayer
  Set layerObj = ThisDrawing.Layers.Add("NewLayer")
  layerObj.Name = "MyLayer"
End Sub

Выбор объектов

 

Набор представляет собой группу объектов AutoCAD указанных для обработки как одно целое. Набор может состоять из объектов разных слоев, разных цветов и т.п. Создание набора двухступенчатый процесс. Сначала создается набор и включается в коллекцию SelectionSets. Затем идет работа с объектами, входящими в набор. Для создания именованного набора используем метод Add.

 

Sub CreateSelectionSet()
  Dim selectionSet1 As AcadSelectionSet
  ' Создание набора
  Set selectionSet1 = ThisDrawing.SelectionSets.Add("NewSelectionSet")
End Sub
 

Добавление объектов в набор

 

Добавление объектов в набор может осуществляется одним из следующих методов:

Sub AddToASelectionSet()
  Dim sset As AcadSelectionSet
  Set sset = ThisDrawing.SelectionSets.Add("SS1")
  ' Запрос объектов от пользователя, Enter - конец ввода
  sset.SelectOnScreen
  ' Пройтись по набору и перекрасить его в синий
  Dim entry As AcadEntity
  For Each entry In sset
    entry.Color = acBlue
    entry.Update
  Next entry
End Sub
 

Фильтрация набора

 

Фильтрация набора объектов (например по цвету, типу объекта) осуществляется через список фильтров. При этом фильтрация по цвету различает только цвета явно назначенные объектам, но не унаследованные от слоя (!). Для применения механизма фильтрации используется тип фильтра и данные фильтра, которые сортируются. AutoCAD ActiveX автоматизация использует DXF-коды групп для указания типа фильтров. Наиболее часто используемые фильтры перечисленны ниже.

 

DXF-код

Тип фильтра

0

Тип объекта. Строка ("Line", "Circle", "Arc" и т.д.)

2

Имя объекта. Строка (табличное имя объекта)

8

Имя слоя. Строка ("Layer 0")

60

Видимость объекта 0-виден, 1-нет

62

Цвет. Числовой 0-256, где 0-по блоку, 256-по слою

67

Пространство. Число. модели (0) или листа (1)

 

Примеры различных фильтров

 
FilterType = 0
FilterData = "TEXT"
sset.SelectOnScreen FilterType, FilterData
' Только линии
FilterType = 0
FilterData = "LINE"
sset.SelectOnScreen FilterType, FilterData
' Только со слоя FLOOR9
FilterType = 8
FilterData = "FLOOR9"
sset.SelectOnScreen FilterType, FilterData
' Только синие (5)
FilterType = 62
FilterData = 5
sset.SelectOnScreen FilterType, FilterData
 

Удаление объектов из набора

 

При выборе всех объектов в набор может быть необходимость исключить объекты, это делается следующими методами:

Пример:

 

Sub AddToASelectionSet()
  Dim sset As AcadSelectionSet
  On Error GoTo ErrHandle
 
  ' создали произвольный набор, он пока пустой
  Set sset = ThisDrawing.SelectionSets.Add("SS1")
  ' Запрос объектов от пользователя, Enter - конец ввода
  sset.SelectOnScreen
  ' Пройтись по набору и перекрасить его в синий
  Dim entry As AcadEntity
  For Each entry In sset
    entry.Color = acBlue: entry.Update
  Next entry
  ThisDrawing.Application.ZoomExtents
  GoSub LISTOBJS
 
  Dim keyWord As String
  Dim gpCode(0) As Integer
  Dim dataValue(0) As Variant
  Dim groupCode As Variant, dataCode As Variant
 
  ThisDrawing.Utility.InitializeUserInput 1, "RemoveItem Clear Delete Erase Quit"
  keyWord = ThisDrawing.Utility.GetKeyword(vbCrLf & "RemoveItem/Clear/Delete/Erase/Quit")
 
  Select Case keyWord
  Case "RemoveItem"
    ' отбор по группе (62) Цвет, номер цвета (5) - синий
    gpCode(0) = 62: dataValue(0) = 5
    ' Методу будут передаваться переменные типа вариант, ссылающиеся на массивы
    groupCode = gpCode: dataCode = dataValue
    ' Собственно отбор по цвету
    sset.Select acSelectionSetAll, , , groupCode, dataCode
    GoSub LISTOBJS
    vsego = sset.Count - 1
    ' Если размер массива removeObjects задать больше чем число
    ' объектов в наборе, то метод RemoveItems выдаст ошибку, поэтому ReDim
    ReDim removeObjects(0 To vsego) As AcadEntity
    ' пройтись по SelectionSet
    For i = 0 To vsego
      Set removeObjects(i) = sset.Item(i)
      ' установить ссылки на объекты которые исключим из набора
      ' а именно те, что разукрасили синим
    Next
 
    GoSub LISTOBJS
    sset.RemoveItems removeObjects
    GoSub LISTOBJS
 
  Case "Clear": sset.Clear: GoSub LISTOBJS
 
  Case "Delete": sset.Delete: GoSub LISTOBJS
 
  Case "Erase": sset.Erase: GoSub LISTOBJS
 
  Case Else
  Exit Sub
 
  End Select
 
  sset.Delete
  Exit Sub
 
LISTOBJS:
  If sset.Count = 0 Then
     MsgBox "набор пуст"
  Else
     MsgBox "Набор содержит: " & sset.Count & " объектов"
  End If
  Return
 
ErrHandle:
  MsgBox Err.Description
End Sub
 

Копирование объектов

 

Объекты рисунка могут быть копированы, в том числе на определенное смещение от оригинала. Можно так же создать зеркальное отображение объекта относительно заданной линии. Объекты могут размножаться через прямоугольный или окурглый шаблон. Нельзя только использовть эти методы одновременно с перебором элементов коллекции, сначала следует завершить перебор. Для копирования единичного объекта метод Copy позволяет создать его дубликат по тем же координатам.

 

Копирование нескольких объектов или в другой документ

 

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

 

Sub CopyCircleObjects()
  Dim ACADApp As AcadApplication
  Dim DOC1 As AcadDocument
  Dim circleObj1 As AcadCircle,circleObj2 As AcadCircle
  Dim circleObj1Copy As AcadCircle,circleObj2Copy As AcadCircle
  Dim centerPoint(0 To 2) As Double
  Dim radius1 As Double,radius2 As Double
  Dim radius1Copy As Double,radius2Copy As Double
  Dim objCollection(0 To 1) As Object
  Dim retObjects As Variant
 
  ' Определим окружность
  centerPoint(0) = 0: centerPoint(1) = 0: centerPoint(2) = 0
  radius1 = 5#: radius2 = 7#
  radius1Copy = 1#: radius2Copy = 2#
 
  ' Получим ссылку на объект Application
  Set ACADApp = GetObject(, "AutoCAD.Application")
  ' Создадим новый рисунок
  Set DOC1 = ACADApp.Documents.Add
  ' Добавим в него пару окружностей
  Set circleObj1 = DOC1.ModelSpace.AddCircle(centerPoint, radius1)
  Set circleObj2 = DOC1.ModelSpace.AddCircle(centerPoint, radius2)
  ZoomExtents
 
  ' Поместим копируемые объекты в форму совместимую с CopyObjects
  Set objCollection(0) = circleObj1
  Set objCollection(1) = circleObj2
  ' Копируем и получаем новую коллекцию
  retObjects = DOC1.CopyObjects(objCollection)
  ' Получаем вновь созданные объекты и применяем свойства к копиям
  Set circleObj1Copy = retObjects(0)
  Set circleObj2Copy = retObjects(1)
  circleObj1Copy.Radius = radius1Copy
  circleObj1Copy.Color = acRed
  circleObj2Copy.Radius = radius2Copy
  circleObj2Copy.Color = acRed
  ZoomExtents
End Sub
 

Смещение объектов

 

Смещение объекта создает его копию на определенном растоянии от оригинала. Смещению могут подвергаться дуги, окружности, эллипсы, линии, полилинии, сплайны и некоторые другие. Метод Offset принимает единственный параметр - это дистанция на которую следует сместить объект. Если его значение отрицательное, AutoCAD пытается построить уменьшенный объект (для окружностей), если это не имеет смысла, то объект строится с координатами меньшими текущего. Для многих объектов результат операции - новая кривая, которая может не быть подобной оригиналу. Например при смещении эллипса образуется сплайн. В некоторых случаях может потребоваться чтобы смещение создало несколько кривых, поэтому метод может создавать массив объектов. Пример смещения полилини

 

Sub OffsetPolyline()
  Dim plineObj As AcadLWPolyline
  Dim points(0 To 11) As Double
  points(0) = 1: points(1) = 1
  points(2) = 1: points(3) = 2
  points(4) = 2: points(5) = 2
  points(6) = 3: points(7) = 2
  points(8) = 4: points(9) = 4
  points(10) = 4: points(11) = 1
  Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
  plineObj.Closed = True
  ZoomExtents
 
  Dim offsetObj As Variant
  offsetObj = plineObj.Offset(0.25)
  offsetObj(0).Color = acRed
  ZoomExtents
 
End Sub
 

Отражение объекта

 

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

Для управления свойствами отражения текстовых объектов используется системная переменная MIRRTEXT. Значение по-умолчанию 1, говорит о том, что текст отражается как и другие объекты, а значение 0 приводит к тому, что текст не меняется при отражении объекта его содержащего. Пример отражения полилини по оси:

 

Sub MirrorPolyline()
  Dim plineObj As AcadLWPolyline
  Dim points(0 To 11) As Double
  points(0) = 1: points(1) = 1
  points(2) = 1: points(3) = 2
  points(4) = 2: points(5) = 2
  points(6) = 3: points(7) = 2
  points(8) = 4: points(9) = 4
  points(10) = 4: points(11) = 1
  Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
  plineObj.Closed = True
  ZoomExtents
 
  ' Определим ось отражения
  Dim point1(0 To 2) As Double,point2(0 To 2) As Double
  point1(0) = 0: point1(1) = 4.25: point1(2) = 0
  point2(0) = 4: point2(1) = 4.25: point2(2) = 0
 
  ' Отразим полилинию и покажем другим цветом
  Dim mirrorObj As AcadLWPolyline
  Set mirrorObj = plineObj.Mirror(point1, point2)
  mirrorObj.Color = acRed
  ZoomExtents
End Sub
 

Создание массива объектов

 

Объект могут быть помещены в полярный или прямоугольный массив. Для полярного массива можно менять количество объектов и угол, для прямоугольного - число строк и столбцов, а так же расстояние между ними.

 

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

 

Метод ArrayPolar выбранного объекта требует количество объектов, угол и центральную точку массива. Число объектов должно быть не меньше 1, угол в радианах не равный нулю (положительный угол против часовой стрелки), центр массива - переменная типа Variant, содержащая массив координат Double. AutoCAD определяет расстояние от центральной точки массива до референс-точки исходного объекта. Референс-точка зависит от типа объекта. (Для окружности и дуги это центр, для блока - точка вставки, для текста - начальная точка и т.д) Данный метод не поддерживает вращение в процессе копирования в отличие от команды ARRAY. Пример создания полярного массива

 

Sub ArrayingACircle()
  Dim circleObj As AcadCircle
  Dim center(0 To 2) As Double, radius As Double
  center(0) = 2#: center(1) = 2#: center(2) = 0#: radius = 1
  Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
  ZoomExtents
 
  ' Задаем полярный массив
  Dim noOfObjects As Integer
  Dim angleToFill As Double
  Dim basePnt(0 To 2) As Double
  noOfObjects = 4
  angleToFill = 3.14 ' 180 градусов
  basePnt(0) = 4#: basePnt(1) = 4#: basePnt(2) = 0#
 
  ' Создаем 4 копии объекта, вращением и копированием
  ' относительно точки (3,3,0).
  Dim retObj As Variant
  retObj = circleObj.ArrayPolar(noOfObjects, angleToFill, basePnt)
  ZoomExtents
End Sub
 

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

 

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

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

 

Sub ArrayRectangularExample()
  Dim circleObj As AcadCircle
  Dim center(0 To 2) As Double, radius As Double
  center(0) = 2#: center(1) = 2#: center(2) = 0#: radius = 0.5
  Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
  ZoomExtents
 
  ' Определим прямоугольный массив
  Dim numOfRows As Long, numOfColumns As Long, numOfLevels As Long
  Dim distBwtnRows As Double, distBwtnColumns As Double, distBwtnLevels As Double
  numOfRows = 5: numOfColumns = 5: numOfLevels = 2
  distBwtnRows = 1: distBwtnColumns = 1: distBwtnLevels = 1
 
  ' Создадим массив
  Dim retObj As Variant
  retObj = circleObj.ArrayRectangular(numOfRows, numOfColumns, numOfLevels,_
  distBwtnRows, distBwtnColumns, distBwtnLevels)
  ZoomExtents
End Sub
 

Перемещение объектов

 

Объекты можно перемещать вдоль вектора без изменения размера и ориентации, а так же вращать вокруг базовой точки. Метод Move требует двух координат, задающих вектор - как далеко и в каком направлении будет движение.

 

Sub MoveCircle()
  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 = 0.5
  Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
  ZoomExtents
 
  ' Определим точки задающие вектор перемещения.
  ' (на 2 единицы вдоль оси X)
  Dim point1(0 To 2) As Double,point2(0 To 2) As Double
  point1(0) = 0: point1(1) = 0: point1(2) = 0
  point2(0) = 2: point2(1) = 0: point2(2) = 0
 
  circleObj.Move point1, point2
  circleObj.Update
End Sub
 

Вращение объектов

 

Метод Rotate требует координаты базовой точки в виде переменной типа Variant, содержащей массив из 3-х координат и угол в радианах - на какой повернуть от текущего положения. Пример вращения полилини относительно базовой точки

 

Sub RotatePolyline()
  Dim plineObj As AcadLWPolyline
  Dim points(0 To 11) As Double
  points(0) = 1: points(1) = 2: points(2) = 1: points(3) = 3
  points(4) = 2: points(5) = 3: points(6) = 3: points(7) = 3
  points(8) = 4: points(9) = 4: points(10) = 4: points(11) = 2
  Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
  plineObj.Closed = True
  ZoomExtents
 
  msgbox "А теперь на 45 градусов"
  ' Зададим угол в 45 градусов и базовую точку (4, 4.25, 0)
  Dim basePoint(0 To 2) As Double
  Dim rotationAngle As Double
  basePoint(0) = 4: basePoint(1) = 4.25: basePoint(2) = 0
  rotationAngle = 0.7853981   ' 45 градусов
 
  ' Повернем
  plineObj.Rotate basePoint, rotationAngle
  plineObj.Update
  ZoomExtents
 
End Sub
 

Удаление объектов

 

Отдельный объект можно удалить методом Delete. Нельзя удалить только объекты-коллекции ModelSpace, Layers, Dictionaries.

 

Sub DeletePolyline()
  Dim lwpolyObj As AcadLWPolyline
  Dim vertices(0 To 5) As Double
  vertices(0) = 2: vertices(1) = 4
  vertices(2) = 4: vertices(3) = 2
  vertices(4) = 6: vertices(5) = 4
  Set lwpolyObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(vertices)
  ZoomExtents
  lwpolyObj.Delete
  ThisDrawing.Regen acActiveViewport
End Sub
 

Масштабирование объектов

 

Масштабирование объектов возможно указанием базовой точки и длины которые берутся как фактор масштабирования основываясь на текущих единицах измерения. Метод ScaleEntity масштабирует объект пропорционально по всем осям. Он требует укзания базовой точки и фактора масштабирования. Базовая точка как обычно переменная типа Variant. Фактор масштабирования - величина на которую умножаются размеры объекта. Может быть от нуля до 1 (уменьшение) и больше 1 (увеличение). Пример масштабирования полилинии.

 

Sub ScalePolyline()
  Dim plineObj As AcadLWPolyline
  Dim points(0 To 11) As Double
  points(0) = 1: points(1) = 2: points(2) = 1: points(3) = 3
  points(4) = 2: points(5) = 3: points(6) = 3: points(7) = 3
  points(8) = 4: points(9) = 4: points(10) = 4: points(11) = 2
  Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
  plineObj.Closed = True
  ZoomExtents
 
  ' Зададим масштабирование
  Dim basePoint(0 To 2) As Double
  Dim scalefactor As Double
  basePoint(0) = 4: basePoint(1) = 4.25: basePoint(2) = 0: scalefactor = 0.5
  ' Масштабируем
  plineObj.ScaleEntity basePoint, scalefactor
  plineObj.Update
End Sub
 

Трансформировние объектов

 

Конфигурация матрицы трансформации

R00

R01

R02

T0

R10

R11

R12

T1

R20

R21

R22

T2

0

0

0

1

 

Перед трансформацией объекта следует заполнить матрицу трансформации. В следующем примере объект вращается на 90 градусов вокруг точки (0,0,0) используя матрицу трансформации.

 

Sub TransformBy()
  Dim lineObj As AcadLine
  Dim startPt(0 To 2) As Double, endPt(0 To 2) As Double
  startPt(0) = 2: startPt(1) = 1
  startPt(2) = 0: endPt(0) = 5
  endPt(1) = 1: endPt(2) = 0
  Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
  ZoomAll
 
  ' Заполняем матрицу
  Dim transMat(0 To 3, 0 To 3) As Double
  transMat(0, 0) = 0#: transMat(0, 1) = -1#
  transMat(0, 2) = 0#: transMat(0, 3) = 0#
  transMat(1, 0) = 1#: transMat(1, 1) = 0#
  transMat(1, 2) = 0#: transMat(1, 3) = 0#
  transMat(2, 0) = 0#: transMat(2, 1) = 0#
  transMat(2, 2) = 1#: transMat(2, 3) = 0#
  transMat(3, 0) = 0#: transMat(3, 1) = 0#
  transMat(3, 2) = 0#: transMat(3, 3) = 1#
 
  ' Трансформируем линию
  lineObj.TransformBy transMat
  lineObj.Update
  ZoomExtents
End Sub
 

Еще ряд примеров матриц трансформации:

 

1. Вращение на 45 градусов вокруг точки (5,5,0)

0.707107

-0.707107

0.0

5.0

0.707107

0.707107

0.0

-2.071068

0.0

0.0

1.0

0.0

0.0

0.0

0.0

1.0

 

2. Перемещение в точку (10,10,0)

1.0

0.0

0.0

10.0

0.0

1.0

0.0

10.0

0.0

0.0

1.0

0.0

0.0

0.0

0.0

1.0

 

3. Масштабирование в 10,10 на точке (0,0,0)

10.0

0.0

0.0

0.0

0.0

10.0

0.0

0.0

0.0

0.0

10.0

0.0

0.0

0.0

0.0

1.0

 

4. Масштабирование в 10,10 на точке (2,2,0)

10.0

0.0

0.0

-18.0

0.0

10.0

0.0

-18.0

0.0

0.0

10.0

0.0

0.0

0.0

0.0

1.0

 

Удлинение и подрезка объектов

 

Можно изменять угол дуги и длину незамкнутых линий, дуг, полилиний, сплайнов и эллиптических дуг. Удлинение и подрезка объектов выполняется изменением их соответствующих свойств. К примеру для удлинения линии просто меняются координаты в свойствах StartPoint и EndPoint, для изменения угла дуги меняются свойства StartAngle и EndAngle. Чтобы отобразить изменения есть метод Update. Пример изменения длины линии

 

Sub LengthenLine()
  Dim lineObj As AcadLine
  Dim startPoint(0 To 2) As Double,endPoint(0 To 2) As Double
  startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0
  endPoint(0) = 1: endPoint(1) = 1: endPoint(2) = 1
  Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
  lineObj.Update
 
  ' Удлиним линию сменив конечную точку в 4, 4, 4
  endPoint(0) = 4: endPoint(1) = 4: endPoint(2) = 4
  lineObj.endPoint = endPoint
  lineObj.Update
End Sub
 

Взрывание объектов

 

Взрывание составных объектов приводит к их конвертации в составляющие компоненты. К примеру, взрывание создает дуги и линии из полилиний, регионов или заменяет блочные ссылки на объекты, из которых состоял блок. Взорванный объект может выглядеть точно так, как и составной, однако цвет и тип линий может и меняться. Метод Explode при взрыве полилинии отбрасывает информацию о ее толщине, полученные линии и дуги проходят по срединной линии бывшей полилинии. Если блок состоял из полилиний, то его приходится взрывать дважды. Блоки, вставленные с неравными масштабами по осям, могут при взрывании создавать непредсказуемые объекты. Нельзя взорвать xref-ссылки. При взрывании блока с атрибутами последние пропадают, однако определения атрибутов остаются. Значения атрибутов и любые модификации теряются. Пример взрыва полилинии

 

Sub ExplodePolyline()
  Dim plineObj As AcadLWPolyline
  Dim points(0 To 11) As Double
  points(0) = 1: points(1) = 1: points(2) = 1: points(3) = 2
  points(4) = 2: points(5) = 2: points(6) = 3: points(7) = 2
  points(8) = 4: points(9) = 4: points(10) = 4: points(11) = 1
 
  ' Рисуем полилинию
  Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
 
  ' Видоизменяем один из сегментов
  plineObj.SetBulge 3, -0.5
  plineObj.Update
  ZoomExtents
  ' Взрываем
  Dim explodedObjects As Variant
  explodedObjects = plineObj.Explode
  ' Проходим по взорванному объекту, отображая
  ' тип каждого полученного объекта другим цветом
  Dim I As Integer
  For I = 0 To UBound(explodedObjects)
    explodedObjects(I).Color = acRed
    explodedObjects(I).Update
    MsgBox "Тип объекта " & I & ": " & explodedObjects(I).ObjectName
    explodedObjects(I).Color = acByLayer
    explodedObjects(I).Update
  Next
End Sub
 

Редактирование полилиний

 

Двумерные и трехмерные полилинии, прямоугольники, полигоны, являются вариантами полилинии и посему редактируются одинаково - разрывать, замыкать, добавлять, удалять вершины, утолщать отдельный сегмент, менять тип линии и т.д. возможно как для всей полилинии, так и для каждого ее сегмента. Можно присоединить линию, дугу или любую другую полилинию к незамкнутой полилинии. Если линия пересекает полилинию в форме буквы Т, то объект не может быть объединен. Если две линии встречаются с полилинией в форме буквы Y, одну из них AutoCAD может присоединить к полилинии. AutoCAD отбрасывает информацию сплайна, при присоединении его к другой полилинии. Когда объединение завершено, можно задать новый сплайн для результата.

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

Пример редактирования полилинии.

 

Sub EditPolyline()
  Dim plineObj As AcadLWPolyline
  Dim points(0 To 9) As Double
  points(0) = 1: points(1) = 1: points(2) = 1: points(3) = 2
  points(4) = 2: points(5) = 2: points(6) = 3: points(7) = 2
  points(8) = 4: points(9) = 4
  ' Create a light weight Polyline object
  Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
 
  ' задать скос для сегмента 3
  plineObj.SetBulge 3, -0.5
  ' задать новую вершину
  Dim newVertex(0 To 1) As Double
  newVertex(0) = 4: newVertex(1) = 1
  plineObj.AddVertex 5, newVertex
 
  ' задать ширину сегмента 4
  plineObj.SetWidth 4, 0.1, 0.5
 
  ' замкнуть полилинию
  plineObj.Closed = True
  plineObj.Update
  ZoomExtents
End Sub
 

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

 

Для получения более гладких сплайнов можно добавлять дополнительные точки изгиба или менять местоположение существующих. Метод SetFitPoint пригодится в последнем случае. Свойства и методы меняющие характеристи сплайна

Пример изменения контрольных точек сплайна

 

Sub ChangeSplineControlPoint()
  Dim splineObj As AcadSpline
  Dim noOfPoints As Integer
  Dim startTan(0 To 2) As Double
  Dim endTan(0 To 2) As Double
  Dim fitPoints(0 To 8) As Double
 
  noOfPoints = 3
  startTan(0) = 0.5: startTan(1) = 0.5: startTan(2) = 0
  endTan(0) = 0.5: endTan(1) = 0.5: endTan(2) = 0
  fitPoints(0) = 1: fitPoints(1) = 1: fitPoints(2) = 0
  fitPoints(3) = 5: fitPoints(4) = 5: fitPoints(5) = 0
  fitPoints(6) = 10: fitPoints(7) = 0: fitPoints(8) = 0
  Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
  splineObj.Update
  ZoomExtents
  ' Изменим координаты первой контрольной точки
  Dim controlPoint(0 To 2) As Double
  controlPoint(0) = 0: controlPoint(1) = 3: controlPoint(2) = 0
  splineObj.SetControlPoint 0, controlPoint
  splineObj.Update
End Sub
 

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

 

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

 

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

 

Можно добавлять внутренние и внешние петли штриховкам, при этом ассациативная штриховка обновляется, как только изменились ее границы, а неассациативная не обновляется. Для редактирования границ есть следующие методы:

Sub AppendInnerLoopToHatch()
  Dim hatchObj As AcadHatch
  Dim pName As String
  Dim pType As Long
  Dim bAssociativity As Boolean
 
  ' Определим и создадим штриховку
  pName = "ANSI31"
  pType = 0
  bAssociativity = True
  Set hatchObj = ThisDrawing.ModelSpace.AddHatch(pType, pName, bAssociativity)
  ' Создадим внешнюю петлю
  Dim outLoop(0 To 1) As AcadEntity
  Dim center(0 To 2) As Double
  Dim radius As Double, startAngle As Double, endAngle As Double
  center(0) = 5: center(1) = 3: center(2) = 0: radius = 3
  startAngle = 0: endAngle = 3.141592
  Set outLoop(0) = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)
  Set outLoop(1) = ThisDrawing.ModelSpace.AddLine(outLoop(0).StartPoint,outLoop(0).EndPoint)
 
  ' Добавим внешнюю петлю к штриховке
  hatchObj.AppendOuterLoop (outLoop)
 
  ' Создадим внутреннюю петлю
  Dim innerLoop(0) As AcadEntity
  center(0) = 5: center(1) = 4.5: center(2) = 0: radius = 1
  Set innerLoop(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
 
  ' Добавм окружность как внутреннюю петлю
  hatchObj.AppendInnerLoop (innerLoop)
 
  ' Перемситем и отобразим штриховку
  hatchObj.Evaluate
  ThisDrawing.Regen True
End Sub
 

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

 

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

Пример

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

 

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

 

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

 

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

 

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

 

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

 

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

 

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
 

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

 

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

 

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

 

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

 

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

 

Свойство

Умолчание

Описание

Название

STANDARD

Не больше 31 символа

Название шрифта

txt.shx

Файл связанный со шрифтом

Название большого шрифта

нет

Для не ASCII символов

Высота

0

Высота символов

Ширина

1

Раширение или сжатие

Угол

0

Наклон текста

Флаг генерации

нет, нет

перевернутый, зеркальный или оба

 

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

 

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

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

 

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. Дополнительные свойства характерные только для текстов:

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

 

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

 

Пример создает объект 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 на ноль. Некоторые методы текста перечисленны ниже, все остальные можно узнать из справочной системы.

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

 

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

 

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

 

Метод 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.

 

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

 

Размерности представляют собой геометрические характеристики объектов - расстояния углы между ними. В 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
 

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

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

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

 

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, то там должны появиться три разных стиля.

 

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

 

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

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

 

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
 

Размерности в пространстве модели и пространстве листа

 

Рисовать размерности можно как в пространстве модели, так и в пространстве листа, однако если фигуры в пространстве модели, то и размеры лучьше рисовать там же. Если же рисовать размер в пространстве листа, когда фигуры нарисованы в пространстве модели, то они не меняются автоматически, когда вы используете команды редактирования и увеличения. Если вы проставляете размеры в пространстве листа, и глобальный фактор масштабирования DIMLFAC для линейных размеров меньше нуля, измеренное расстояние умножается на абсолютное значение DIMLFAC. Если размеры в пространстве модели, то используется значение 1.0, даже если DIMLFAC меньше нуля.

 

Создание указателей и примечаний

 

Указатель - это линия соединяющая примечание с какой-либо частью рисунка. указатель связан с примечанием и меняется вместе с ним, если примечание отредактировать. Не путайте объект указатель с линией-указателем автоматически создаваемой AutoCADом как часть размерной линии. Указатель может быть в форме прямого сегмента или кривой. Цвет его зависит от цвета текущих размерных линий. Масштаб его управляется общим масштабом размерностей, установленном в активном размерном стиле. Тип и размер стрелок, если они есть, управляется первой стрелкой определенной в активном размерном стиле. Малая линия, известная как крючок, обычно присоединена к примечанию, если у указателя нет примечания, то нет и крючка. Для создания указателя используется метод AddLeader, принимающий три параметра: массив координат в форме переменной типа Variant, собственно примечание, и тип определяющий форму - прямой или кривая, а так же есть у него стрелка или нет. Следующие константы определяют тип указателя: acLineNoArrow, acLineWithArrow, acSplineNoArrow, acSplineWithArrow.

 

Sub CreateLeader()
  Dim leaderObj As AcadLeader
  Dim points(0 To 8) As Double
  Dim leaderType As Integer
  Dim annotationObject As AcadObject
  
  points(0) = 0: points(1) = 0: points(2) = 0
  points(3) = 4: points(4) = 4: points(5) = 0
  points(6) = 4: points(7) = 5: points(8) = 0
  leaderType = acLineWithArrow
  Set annotationObject = Nothing
      
  Set leaderObj = ThisDrawing.ModelSpace.AddLeader(points, annotationObject, leaderType)
  ZoomExtents
End Sub
 

Добавление примечания к указателю

 

Примечание может быть в виде объектов Tolerance, MText, BlockRef и присоединяется к указателю только при его создании.

 

Ассациативность указателей

 

Примечание связывается с соответствующим указателем и при перемещении примечания конечная точка указателя перемещается с ним. Уничтожение обоих объектов методами Erase, Add (для блоков) и WBlock. При копировании примечания и указателя одной командой они становятся ассациативными в любом случае. Если ассациативность разрывается по любой причине, например если копируется отдельно указатель или удаляется примечание, то крючок тоже удаляется.

 

Sub AddAnnotation()
  Dim leaderObj As AcadLeader
  Dim mtextObj As AcadMText
  Dim points(0 To 8) As Double
  Dim insPoint(0 To 2) As Double
  Dim width As Double
  Dim leaderType As Integer
  Dim annotObj As Object
  Dim textString As String, msg As String
  
  textString = "Hello, World."
  insPoint(0) = 5: insPoint(1) = 5: insPoint(2) = 0: width = 2
  Set mtextObj = ThisDrawing.ModelSpace.AddMText(insPoint, width, textString)
  ' данные для указателя
  points(0) = 0: points(1) = 0: points(2) = 0
  points(3) = 4: points(4) = 4: points(5) = 0
  points(6) = 4: points(7) = 5: points(8) = 0
  leaderType = acLineWithArrow
     
  ' Создаем указатель и связываем с ним объект MText
  Set annotObj = mtextObj
  Set leaderObj = ThisDrawing.ModelSpace.AddLeader(points, annotObj, leaderType)
  ZoomExtents
End Sub
 

Редактирования ассациативности указателя

 

Исключая случая ассациативности указатель и его примечание являются отдельными объектами. Хотя текстовые примечания создаются с использованием системных переменных DIMCLRT, DIMTXT, DIMTXSTY определяющих их цвет, высоту и стиль они не могут быть изменены через эти переменные, т.к. на самом деле не являются объектами Размеры. Редактировать их следует теми же методами, что и обычный мультитекст. Метод Evalute обновляет размеры указателя при изменении примечания, если это необходимо.

 

Редактирование указателей

 

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

 

Создание геометрических допусков

 

Геометрические допуски показвают возможные отклонения форм, профилей и т.д. Для их создания есть метод AddTolerance, требующий три параметра - текстовая строка, расположение и направляющий вектор. Можно так же копировать, стирать, вращать, масштабировать допуски. Пример создания:

 

Sub CreateTolerance()
  Dim toleranceObj As AcadTolerance
  Dim textString As String
  Dim insPoint(0 To 2) As Double
  Dim direction(0 To 2) As Double
  
  ' Define the tolerance object
  textString = "Here is the Feature Control Frame"
  insPoint(0) = 5: insPoint(1) = 5: insPoint(2) = 0
  direction(0) = 1: direction(1) = 1: direction(2) = 0
  ' Create the tolerance object in model space
  Set toleranceObj = ThisDrawing.ModelSpace.AddTolerance(textString, insPoint, direction)
  ZoomExtents
End Sub
 

Редактирование допусков

 

Допуски подвержены влиянию нескольких системных переменных: DIMCLRD, DIMCLRT, DIMGAP, DIMTXT, DIMTXTSTY

 

8.    Настройка меню и панелей инструментов

 

Две наиболее важных коллекции, касающиеся меню MenuBar, MenuGroups. Первая содержит все отображаемые меню, вторая группы меню, часть из которых может не отражаться на экране. Группы меню могут содержать панели инструментов.

 

Исследование коллекции menugroups

 

Каждая группа меню содержит коллекции PopupMenus и Toolbars. Схема такова MenuBar-PopupMenu.MenuGroups-MenuGroup.В составе MenuGroup - PopupMenus и Toolbars.PopupMenus-PopupMenu-PopupMenuItem, Toolbars-Toolbar-ToolbarItem.

 

Загрузка групп меню

 

Выполняется методом Load, если параметр BaseMenu установлен=True, загружается новая группа меню, как основное меню аналогично команде MENU. Если этот параметр не указать, то загружается частичное меню, аналогично тому как это делает команда MENULOAD. Сразу после загрузки частичное меню может быть вставлено в панель меню методом InsertMenuInMenuBar или InsertInMenuBar. Так же становятся доступны все меню и панели инструментов входящие в меню. Далее можно;

·         добавлять меню к панели меню;

·         удалять меню из панели;

·         переупорядочивать;

·         добавлять новый пункт в меню или панель инструментов;

·         удалять пункт из меню или панели инструментов;

·         создавать меню и панель инструментов;

·         делать меню плавающим или пристыкованным;

·         делать доступным и недоступным пункт меню и панели инструментов;

·         делать выбранным или неактивным;

·         менять название, тэг и строку подсказки;

·         переназначать связанный макрос.

Пример загрузки группы меню:

ThisDrawing.Application.MenuGroups.Load "acad.mnc"

Создание новой группы меню

 

AutoCAD ActiveX не позволяет создавать пустую группу меню, однако можно загрузить существующую и сохранить с новым именем и в новом файле. После чего его можно отредактировать по своему желанию. Приимущество данного подхода в том, что оказываются уже созданными базовые меню Файл, Окно и Помощь. Пример сохранения группы меню в новом файле:

ThisDrawing.Application.MenuGroups.Item(0).SaveAs "MyMenu.mnc", acMenuFileCompiled

Изменение панели меню

 

Основное меню может быть полностью замещено загружаемым, если оно загружается как основное меню. Кроме того могут быть модифицированы и отдельные меню. Оба метода InsertMenuInMenuBar и InsertInMenuBar преследуют одну цель. Различие между ними в объекте из которого они вызываются. Первый вызывается из коллекции PopupMenus, требует имя меню и точку вставки. Второй вызывается непосредственно из объекта PopupMenu и требует только указания точки вставки. Вам решать какой метод избрать. Пример вставки меню:

 

Sub InsertMenu()
  ' Определим переменную для группы меню
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
 
  ' Создадим меню
  Dim newMenu As AcadPopupMenu
  Set newMenu = currMenuGroup.Menus.Add("TestMenu")
 
  ' Определим переменную для пункта меню
  Dim newMenuItem As AcadPopupMenuItem
  Dim openMacro As String
 
  ' Назначим макрос аналог "ESC ESC _open " и создадим пункт меню
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
  Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "Open", openMacro)
 
  ' Отобразим меню
  currMenuGroup.Menus.InsertMenuInMenuBar "TestMenu", ""
End Sub
 

Удаление меню из панели меню

 

Для данной цели используйте один из следующих методов RemoveMenuFromMenuBar или RemoveFromMenuBar. Различия между ними те же что и для вышеописанных методов добавления меню. Пример удаления: currMenuGroup.Menus.RemoveMenuFromMenuBar ("TestMenu") В результате меню становятся невидимым, но физически не удаляется. Пример переупорядочивания меню (первый пункт переносится в конец):

 

Sub MoveMenu()
  ' Определим переменную содержащую меню
  Dim moveMenu As AcadPopupMenu
  Dim MyMenuBar As AcadMenuBar
  Set MyMenuBar = ThisDrawing.Application.menuBar
 
  ' установим moveMenu равным первому
  Set moveMenu = MyMenuBar.Item(0)
 
  ' уберем с первой позиции
  MyMenuBar.Item(0).RemoveFromMenuBar
 
  ' вставим в последнюю
  moveMenu.InsertInMenuBar (MyMenuBar.count)
End Sub
 

В результате меню File должно переехать в последнюю позицию.

 

Создание и редактирование выпадающих и всплывающих меню

 

Оба типа меню отображаются как каскадные меню. Последние, например, позволяют включать-включать объектную привязку. Выпадающие меню могут содержать до 999 пунктов. А всплывающие только до 499. Оба предела включют все меню в иерархии. Если меню не умещается на экране, то оно грубо обрезается. Всплывающие меню появляются обычно рядом с перекрестием. Если свойство ShortcutMenu=TRUE значит, это оно и есть.

 

Создание меню

 

Методом Add можно добавить объект PopupMenu в коллекцию PopupMenus. Для создания нового всплывающего старое следует сначала удалить. Может быть только одно такое меню на группу. Если таких меню нет, то можно создать его с именем "POP0". После чего по этому имени можно обращаться к меню в коллекции. Меню может включать и некторые специальные символы. Пример создания выпадающего меню:

 

Sub CreateMenu()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
  Dim newMenu As AcadPopupMenu
  Set newMenu = currMenuGroup.Menus.Add("TestMenu")
End Sub
 

Добавление пункта к меню

 

Метод AddMenuItem добавляет пункт в выпадающее меню, принимает четыре параметра - Index, Label, Tag, Macro. Index начинается с нуля, для добавления в конец установи индекс = значению свойства Count. Label - строка, определяющая содержание и формат пункта меню. (может содержать DEISEL выражение и специальные коды). Текст пункта меню еще называют Caption. Тэг - строка символов, включая подчеркивание идентифицирующая пункт меню. Макро - набор команд, выполняющихся при выборе пункта меню. Может быть как простым макросом вызывающим команду так и сложным набором команд. Пример добавления пункта меню:

 

Sub AddAMenuItem()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
  Dim newMenu As AcadPopupMenu
  Set newMenu = currMenuGroup.Menus.Add("TestMenu")
 
  ' добавим пункт
  Dim newMenuItem As AcadPopupMenuItem
  Dim openMacro As String
  ' назначим макрос эквивалентный "ESC ESC _open "
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
 
  Set newMenuItem = newMenu.AddMenuItem(newMenu.count + 1, "Open", openMacro)
 
  ' Отобразим
  newMenu.InsertInMenuBar(ThisDrawing.Application.menuBar.count + 1)
End Sub
 

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

 

Доступ к горячим клавишам

 

Для назначения горячей клавиши используйте символ & непосредственно перед буквой, которая и будет горячей. Пример:

 

Sub AddAMenuItem()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
  Dim newMenu As AcadPopupMenu
  Set newMenu = currMenuGroup.Menus.Add("Te" + Chr(Asc("&")) + "stMenu")
 
  Dim newMenuItem As AcadPopupMenuItem
  Dim openMacro As String
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
  Set newMenuItem = newMenu.AddMenuItem(newMenu.count + 1, Chr(Asc("&")) _
      + "Open", openMacro)
 
  newMenu.InsertInMenuBar(ThisDrawing.Application.menuBar.count + 1)
End Sub
 

Создание каскадных подменю

 

Для этой цели используйте метод AddSubmenu который создает новый объект PopupMenu и добавляет его в меню. Принимает три параметра - Index, Label и Tag. Данный метод не возвращает объект PopupMenu вместо этого он возвращает новое меню на которое указывает подменю, это меню следует добавить в существующее. Пример:

 

Sub AddASubMenu()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
 
  Dim newMenu As AcadPopupMenu
  Set newMenu = currMenuGroup.Menus.Add("TestMenu")
 
  ' Добавим подменю
  Dim FileSubMenu As AcadPopupMenu
  Set FileSubMenu = newMenu.AddSubMenu("", "OpenFile")
 
  ' Добавим пункт в подменю
  Dim newMenuItem As AcadPopupMenuItem
  Dim openMacro As String
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
  Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.count + 1, "Open", openMacro)
 
  ' Отобразим
  newMenu.InsertInMenuBar(ThisDrawing.Application.menuBar.count + 1)
End Sub
 

Удаление пункта из меню

 

Sub DeleteMenuItem()
  Dim LastMenu As AcadPopupMenu
  Set LastMenu = ThisDrawing.Application.menuBar. _
              Item(ThisDrawing.Application.menuBar.count - 1)
 
  ' Добавим пункт меню
  Dim newMenuItem As AcadPopupMenuItem
  Dim openMacro As String
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
  Set newMenuItem = LastMenu.AddMenuItem(LastMenu.count + 1, "Open", openMacro)
 
  ' Удалим пункт меню
  newMenuItem.Delete
End Sub
 

Исследование свойств пункта меню

 

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

Tag - уникальный идентификатор,

Label - строка, определяющая содержание и форматирование,

Caption - тот текст пункта меню, который видит пользователь,

Macro - простой макрос или набор команд,

Help String - быстрая подсказка в строке состояния,

Enable - доступно или нет для выбора,

Check - выбрано или нет, Index - номер пункта, начиная с нуля,

Type - acMenuItem или acMenuSeparator или acSubMenu,

Parent - меню к которому принадлежид данное меню. Пример включение/ отключения доступности:

 

Sub DisableMenuItem()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
 
  Dim newMenu As AcadPopupMenu
  Set newMenu = currMenuGroup.Menus.Add("TestMenu")
 
  ' Добавим два пункта и разделитель
  Dim MenuEnable As AcadPopupMenuItem
  Dim MenuDisable As AcadPopupMenuItem
  Dim MenuSeparator As AcadPopupMenuItem
  Dim openMacro As String
 
  ' Назначим макрос
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
  Set MenuEnable = newMenu.AddMenuItem(newMenu.count + 1, "OpenEnabled", openMacro)
  Set MenuSeparator = newMenu.AddSeparator("")
  Set MenuDisable = newMenu.AddMenuItem(newMenu.count + 1, "OpenDisabled", openMacro)
 
  ' Запретим второй пункт
  MenuDisable.Enable = False
 
  ' Отобразим
  newMenu.InsertInMenuBar(ThisDrawing.Application.menuBar.count + 1)
End Sub
 

Создание и редактирование панелей инструментов

 

Добавить кнопку на панель можно методом AddToolbarButton который принимает 5 параметров: Index, Name, HelpString, Macro, FlyoutButton (определяет будет ли панель выпадающая). Пример:

 

Sub AddButton()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
 
  ' Создаем сначала панель
  Dim newToolbar As AcadToolbar
  Set newToolbar = currMenuGroup.Toolbars.Add("TestToolbar")
 
  ' Добавляем кнопку
  Dim newButton As AcadToolbarItem
  Dim openMacro As String
 
  ' Назначим макрос
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
  Set newButton = newToolbar.AddToolbarButton("", "NewButton", "Open a file.", openMacro)
End Sub
 

Добавление разделителя — использовать метод AddSeparator.

 

Назначение значка для кнопки

 

Для этого есть методы SetBitmap и GetBitmap, первый принимает два параметра SmallIconName (bmp-файл 15х16) и LargeIconName (bmp-файл 24х22). Пример опроса существующей панели на предмет наличия иконок у кнопок.

 

Sub GetButtonImages()
  Dim Button As AcadToolbarItem
  Dim Toolbar0 As AcadToolbar
  Dim MenuGroup0 As AcadMenuGroup
  Dim SmallButtonName As String,LargeButtonName As String
  Dim msg As String
  Dim ButtonType As String
 
  ' Первая панель в первой группе меню
  Set MenuGroup0 = ThisDrawing.Application.MenuGroups.Item(0)
  Set Toolbar0 = MenuGroup0.Toolbars.Item(0)
 
  SmallButtonName = "": LargeButtonName = ""
 
  msg = "Панель: " + Toolbar0.Name + vbCrLf
  Toolbar0.Visible = True
 
  ' Пройдем по коллекции, отображая имена иконок кнопок
  For Each Button In Toolbar0
      ButtonType = Choose(Button.Type + 1, "Button", "Separator", "Control", "Flyout")
      msg = msg & ButtonType & ":   "
      If Button.Type = acToolbarButton Or Button.Type = acToolbarFlyout Then
          Button.GetBitmaps SmallButtonName, LargeButtonName
          msg = msg + SmallButtonName + ", " + LargeButtonName
      End If
      msg = msg + vbCrLf
  Next Button
 
  MsgBox msg
End Sub
 

Создание выпадающей панели

 

Sub AddFlyoutButton()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
 
  ' Создадим панель
  Dim FirstToolbar As AcadToolbar
  Set FirstToolbar = currMenuGroup.Toolbars.Add("FirstToolbar")
  ' Добавим кнопку для выпадающей панели
  Dim FlyoutButton As AcadToolbarItem
  Set FlyoutButton = FirstToolbar.AddToolbarButton _
          ("", "Flyout", "Пример выпадающей панели","OPEN", True)
 
  ' Создадим вторую панель и привяжем ее к кнопе первой панели
  Dim SecondToolbar As AcadToolbar
  Set SecondToolbar = currMenuGroup.Toolbars.Add("SecondToolbar")
 
  ' Добавим кнопку на вторую панель
  Dim newButton As AcadToolbarItem
  Dim openMacro As String
 
  ' Назначим макрос
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
  Set newButton = SecondToolbar.AddToolbarButton _
          ("", "NewButton", "Open a file.", openMacro)
 
  ' Присоединим вторую панель к кнопке первой
  FlyoutButton.AttachToolbarToFlyout currMenuGroup.Name,SecondToolbar.Name
 
  ' Отобразим первую панель, скрыв вторую
  FirstToolbar.Visible = True
  SecondToolbar.Visible = False
End Sub
 

Плавающая и пристыкованная панели

 

Чтобы сделать панель плавающей следует использовать метод Float, принимающий три параметра: top, left и NumberFloatRows. Для создания пристыкованной панели используйте метод Dock, принимающий три параметра: Side, Row, Column. Пример создания такой панели:

 

Sub DockToolbar()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
 
  ' Создадим панель
  Dim newToolbar As AcadToolbar
  Set newToolbar = currMenuGroup.Toolbars.Add("TestToolbar")
 
  ' Добавим кнопки с одним и тем же макросом для простоты
  Dim newButton1 As AcadToolbarItem
  Dim newButton2 As AcadToolbarItem
  Dim newButton3 As AcadToolbarItem
  Dim openMacro As String
 
  ' Назначим макрос
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
 
  Set newButton1 = newToolbar.AddToolbarButton("", "NewButton1", "Open a file.", openMacro)
  Set newButton2 = newToolbar.AddToolbarButton("", "NewButton2", "Open a file.", openMacro)
  Set newButton3 = newToolbar.AddToolbarButton("", "NewButton3", "Open a file.", openMacro)
 
  ' Отобразим панель
  newToolbar.Visible = True
 
  ' Пристыкуем к левому краю экрана
  newToolbar.Dock acToolbarDockLeft
End Sub

 

Для удаления кнопки из панели используется метод Remove когда панель инструментов видима.

 

Свойства элементов панели инструментов

 

Tag, Name, Macro, HelpString, Index, Type (acButton, acToolButtonSeparator, acControl), Flyout, Parent, и другие - задающие пристыковку, видимость и т.д.

 

Создание макросов

 

Макросы представляют собой серию команд, выполняющих определенные действия. Если команда, вызываемая макросом, принимает параметры, то нужно знать в какой последовательности. Каждый символ имеет значение — и даже пробел. Последовательность параметров может меняться от версии к версии AutoCAD. Когда команда вводится из пункта меню, значения системных переменных PICKADD и PICKAUTO равны 1 и 0 соответственно для совместимости с предыдущими версиями AutoCAD.

 

Таблица соответствия комбинация клавиш ascii-символам

 

Символ

ASCII-эквивалент

Описание

;

chr(59)

Enter

^M

chr(97)+chr(77)

Enter

^I

chr(94) + chr(124)

TAB

пробел

chr(32)

пробел

\

chr(92)

Ожидание ввода от пользователя

-

chr(95)

Перевод команд и ключевых слов

+

chr(43)

Продолжение макроса на другой строке

=*

chr(61) + chr(42)

Отображает меню

*^C^C

chr(42)+chr(94)+chr(67)+chr(94)+chr(67)

Повторять команду

$

chr(36)

Загрузка секции меню или начало DIESEL-выражения

^B

chr(94)+chr(66)

Включить-выключить привязку

^C

chr(94)+chr(67)

Отмена команды

ESC

chr(3)

Отмена команды

^D

chr(94)+chr(68)

Включить-выключить координаты

^E

chr(94)+chr(69)

Установить следующую изометрическую плоскость

^G

chr(94)+chr(71)

Включить-выключить сетку

^H

chr(94)+chr(72)

BackSpace

^O

chr(94)+chr(79)

Включить-выключить Орто

^P

chr(94)+chr(80)

Включить-выключить MENUECHO

^Q

chr(94)+chr(81)

Эхо на принтер

^T

chr(94)+chr(84)

Включить-выключить Tablet

^V

chr(94)+chr(86)

Сменить видовой экран

^Z

chr(94)+chr(90)

Подавить автоматическое добавление пробела в конце

 

При выполнении макросов AutoCAD помещает пробел в конец, перед выполнением последовательности команд. Когда это не желательно (например, для команд TEXT или DIM) команда может завершаться Enter, а не пробелом. Также иногда требуется более одного пробела или Enter, но некторые текстовые редакторы не позволяют создавать строки с концевыми пробелами. Для избежания этой проблемы используются два специальных соглашения:

·         когда в макросе встречается точка с запятой AutoCAD заменяет ее на Enter,

·         если строка заканчивается управляющим символом (обратный слэш, плюс или точкаСзапятой) AutoCAD не добавляет пробел.

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

select \change previous ;properties color red ;

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

·         если ожидается ввод точки режим объектной привязки может предварять ввод актуального значения;

·         если используется фильтр XYZ макрос приостанавливается до тех пор, пока не будет накоплена точка;

·         если вызывается команда SELECT;

·         если пользователь вводит прозрачную команду;

·         если пользователь запускает другой макрос.

Перед началом выполнения макроса рекомендуется использовать последовательность ^C^C, чтобы отменить выполнение предыдущей команды. Для выполнения макроса в цикле используется *^C^C (при этом в самом макросе уже нельзя использовать ^C, т.к. это приведет к его прерыванию). Пример: *^C^CMOVE Single.

 

Добавление пунктов во всплывающее меню

 

Такие меню появляются когда пользователь нажимает правую кнопку мыши, удерживая при этом Shift. AutoCAD ищет высплывающее меню в группе меню по установленному значению свойства ShortcutMenu=TRUE. Добавление пункта во всплывающее меню

 

Sub AddMenuItemToshortcutMenu()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
  
  ' ищем всплывающее меню и назначаем ему переменную
  Dim scMenu As AcadPopupMenu
  Dim entry As AcadPopupMenu
  For Each entry In currMenuGroup.Menus
      If entry.shortcutMenu = True Then
          Set scMenu = entry
      End If
  Next entry
      
  ' добавим новый пункт меню
  Dim newMenuItem As AcadPopupMenuItem
  Dim openMacro As String
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
  
  Set newMenuItem = scMenu.AddMenuItem ("", Chr(Asc("&")) + "OpenDWG", openMacro)
End Sub

 

9.    Отслеживание событий

 

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

 

Написание обработчиков событий

 

События дают информацию о состоянии или активности. Хотя обработчики событий написаны специально для того, чтобы отвечать на собыьия, AutoCAD часто вмешивается в обработку событий. Следовательно, обработчики событий имеют ограничения для выполнения безопасных операций в союзе с AutoCAD и его базой данных. Не стоит надеяться на последовательность событий, т.к. они могут случиться в любом порядке, что следует учитывать в обработчике. К примеру, при вызове команды Open происходят события BeginCommand, BeginOpen, EndOpen и EndCommand, но случиться они могут в любом порядке, кроме пожалуй только события начала и события завершения. Не надейтесь также на последовательность операций (например, при удалении двух объектов не обязательно, что событие удаления объекта 1 будет после 2). Не пытайтесь применять в обработчиках любые интерактивные функции, например ввод от пользователя. Не запускайте диалоговые окна, можно только окна сообщений. Писать данные можно в любой объект базы чертежа, кроме того, который вызвал событие. Любой объект, вызвавший событие, остается открытым для AutoCADа, но запись в него может быть фатальной, читать же можно без ограничений. Не выполняйте в обработчике событий действий, которые вызывают подобный обработчик. (например открытие документа из обработчика события BeginOpen.

 

Обработчики событий уровня приложения

 

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

·         AppActivate — происходит сразу перед активацией главного окна приложения;

·         AppDeactivate — происходит сразу перед деактивацией главного окна приложения;

·         ARXLoaded — происходит при загрузке ARX-приложения;

·         ARXUnLoaded — происходит при выгрузке ARX-приложения;

·         BeginCommand — происходит как только начала выполняться команда, но еще не завершена;

·         BeginFileDrop — происходит когда файл "сброшен" в главное окно приложения;

·         BeginLISP — происходит когда AutoCAD получает запрос на выполнение выражения LISP;

·         BeginModal — происходит сразу перед появлением модального окна;

·         BeginOpen — происходит сразу после того как AutoCAD получает запрос на открытие файла;

·         BeginPlot — происходит сразу после того как AutoCAD получает запрос на печать;

·         BeginQuit — происходит сразу перед тем как завершается сессия;

·         BeginSave — происходит сразу после получения AutoCADом запроса на сохранение;

·         EndCommand — происходит сразу при завершении команды;

·         EndLISP — происходит сразу при завершении вычисления выражения LISP;

·         EndModal — происходит сразу после закрытия модального окна диалога;

·         EndOpen — происходит сразу после окончания процесса открытия чертежа;

·         EndPlot — происходит сразу после завершения отправки на принтер;

·         EndSave — происходит сразу по завершении сохранения;

·         LISPCancelled — происходит при отмене выражения LISP;

·         NewDrawing — происходит сразу перед созданием чертежа;

·         SysVarChanged — происходит когда меняется значение системной переменной;

·         WindowChanged — происходит при изменении окна приложения;

·         WindowMovedOrResized — происходит при перемещении или изменении размера окна приложения.

 

Как разрешить события уровня приложения

 

Перед тем как начать использовать события уровня приложения следует создать новый модуль класса и объявить объект типа AcadApplication с применением ключевого слова WithEvents. Порядок работы следующий:

1. В VBA IDE вставить модуль класса

2. Выбрать новый модуль класса в окне проекта

3. Изменить имя на EventClassModule

4. В окне кода для класса добавить строку:

Public WithEvents App As AcadApplication

После того как новый объект объявлен с событиями он появится в окне списка объектов в модуле класса и можно выбирать процедуры событий для вновь созданного объекта из выпадающего списка. Однако перед тем как запустить процедуру нужно соединить объявленный объект с объектом Application, делается это с помощью такого кода в окне основного модуля:

 

Dim X As New EventClassModule
 
Sub InitializeEvents()
    Set X.App = ThisDrawing.Application
End Sub
' далее в коде основного модуля
Call InitializeEvents
 

После того как выполнится процедура InitializeEvents объект App модуля класса будет указывать на объект Приложение (Application) Пример перехвата процесса загрузки, когда файл методом Drag-And-Drop перенесен в окно AutoCAD, выводящее окно сообщения с именем файла

 

' * * * В модуле класса * * *
Option Explicit
Public WithEvents App As AcadApplication
Sub Example_AcadApplication_Events()
  ' Инициализируем глобальную переменную App
  ' которая будет использоваться для перехвата событий AcadApplication
  ' Обязательно запустить ее в начале
  Set App = GetObject(, "AutoCAD.Application")
End Sub
 
Private Sub App_BeginFileDrop(ByVal FileName As String, Cancel As Boolean)
 ' Пример перехвата события BeginFileDrop, каркас данной процедуры
 ' получен выбором из списка методов объекта App модуля класса в окне кода.
 ' Событие возникает как только файл перетащен в окно AutoCAD.
 '
 If MsgBox("AutoCAD загружает " & FileName & vbCrLf _
          & "продолжить загрузку?", vbYesNoCancel + vbQuestion) <> vbYes Then
     Cancel = True
 End If
End Sub
 
' * * * В основной процедуре * * *
Option Explicit
Dim X As New EventClassModule
Sub InitializeEvents()
    Set X.App = ThisDrawing.Application
End Sub
 
Sub main()
Call InitializeEvents
End Sub
 

Обработка событий уровня документа

 

События уровня документа постоянно происходят в процессе работы AutoCADа. Это значит, что они автоматически делаются доступными при загрузке проекта VBA, однако не доступны, например, для VB. То есть для других ActiveX Automation приложений их надо разрешать вручную. Доступны следующие события:

·         Activate - происходит в момент активации документа;

·         BeginClose - происходит перед закрытием документа;

·         BeginCommand - происходит сразу после начала выполнения команды, но до ее завершения;

·         BeginDoubleClick - происходит в момент двойного щелчка мышью;

·         BeginLISP - происходит сразу после получения AutoCADом запроса на вычисление выражения LISP;

·         BeginPlot - происходит сразу после получения AutoCADом запроса на печать документа;

·         BeginRightClick - происходит после "правого щелчка" мышью в окне документа;

·         BeginSave - происходит сразу после получения AutoCADом запроса на сохранение документа;

·         BeginShortcutMenuCommand - происходит после "правого щелчка" мышью, но до появления всплывающего меню в режиме команд;

·         BeginShortcutMenuDefault - происходит после "правого щелчка" мышью, но до появления всплывающего меню в режиме по-умолчанию;

·         BeginShortcutMenuEdit - происходит после "правого щелчка" мышью, но до появления всплывающего меню в режиме редактирования;

·         BeginShortcutMenuGrip - происходит после "правого щелчка" мышью, но до появления всплывающего меню в режиме "ручки";

·         BeginShortcutMenuOsnap - происходит после "правого щелчка" мышью, но до появления всплывающего меню в режиме объектной привязки;

·         Deactivate - происходит при деактивации окна документа;

·         EndCommand - происходит сразу после завершения команды;

·         EndLISP - происходит при завершении вычисления выражения LISP;

·         EndPlot - происходит после отправки документа на печать;

·         EndSave - происходит когда окончено сохранение документа;

·         EndShortcutMenu - происходит после появления всплывающего меню;

·         LayoutSwitched - происходит после переключения на другой Layout;

·         LISPCancelled - происходит когда прервано вычисление выражения LISP;

·         ObjectAdded - происходит когда добавлен объект;

·         ObjectErased - происходит когда удален объект;

·         ObjectModified - происходит когда изменен объект;

·         SelectionChanged - присходит когда изменен выбор;

·         WindowChanged - происходит когда изменено окно документа;

·         WindowMovedOrResized - происходит сразу после изменения размера или перемещения окна документа.

 

Пример кодирования обработчиков событий уровня документа

 

Для этого нужно просто выбрать объект AutocadDocument из выпадающего меню в окне кода среды VBA IDE. Доступные события появятся в окне процедур, после выбора любой из них будет вставлен каркас процедуры обработки события. Данные процедуры будут касаться только активного документа. Пример обновления всплывающего меню при возникновении событий BeginShortcutMenuDefault и EndShortcutMenu путем добавления к нему пункта. Изменение не затрагивает файлы меню.

 

' это в модуле класса
Option Explicit
Public WithEvents mydoc As AcadDocument
 
Private Sub mydoc_BeginShortcutMenuDefault(ShortcutMenu As IAcadPopupMenu)
  On Error Resume Next
  ' Добавим пункт меню
  Dim newMenuItem As AcadPopupMenuItem
  Dim openMacro As String
  openMacro = Chr(27) + Chr(27) + Chr(95) + "open" + Chr(32)
  Set newMenuItem = ShortcutMenu.AddMenuItem(0, Chr(Asc("&")) + "OpenDWG", openMacro)
End Sub
 
Private Sub mydoc_EndShortcutMenu(ShortcutMenu As IAcadPopupMenu)
  On Error Resume Next
  ShortcutMenu.Item("OpenDWG").Delete
End Sub
 
' это в основном модуле
Option Explicit
Dim X As New EventClass
Sub InitializeEvents()
    Set X.mydoc = ThisDrawing
End Sub
Sub main()
  Call InitializeEvents
End Sub
 

Обработка событий уровня объекта

 

События уровня объекта не доступны на момент загрузки VBA. После того как они сделаны доступны становится доступно событие Modified. Следующий пример создает полилинию с обработчиком события, который показывает новую площадь при изменении полилинии.

 

' в модуле класса с именем EventClass
Option Explicit
Public WithEvents Object As AcadCircle
 
Private Sub Object_Modified(ByVal pObject As IAcadObject)
On Error GoTo errmsg
MsgBox "Площадь " & pObject.ObjectName & " " & pObject.Area
Exit Sub
errmsg:
MsgBox Err.Description
End Sub
 
' В основой программе
Dim X As New EventClass
Sub main()
Call InitializeEvents
End Sub
 
Sub InitializeEvents()
   Dim MyCircle As AcadCircle
   Dim centerPoint(0 To 2) As Double
   Dim radius As Double
   centerPoint(0) = 0#: centerPoint(1) = 0#: centerPoint(2) = 0#: radius = 5#
   Set MyCircle = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
   Set X.Object = MyCircle
   ZoomExtents
End Sub

 

10. Работа с трехмерными поверхностями

 

Для указания трехмерных координат кроме координат по осям X и Y вводится еще и координата по оси Z в мировой или заданной пользоавтелем системе координат. Положение оси Z определяется правилом правой руки. Пример вычерчивания в 3D.

 

Sub Polyline_2D_3D()
  Dim pline2DObj As AcadLWPolyline
  Dim pline3DObj As AcadPolyline
 
  Dim points2D(0 To 5) As Double
  Dim points3D(0 To 8) As Double
 
' Зададим три точки 2D-полилинии
  points2D(0) = 1: points2D(1) = 1
  points2D(2) = 1: points2D(3) = 2
  points2D(4) = 2: points2D(5) = 2
 
' Зададим три точки 3D-полилинии
  points3D(0) = 1: points3D(1) = 1: points3D(2) = 0
  points3D(3) = 2: points3D(4) = 1: points3D(5) = 0
  points3D(6) = 2: points3D(7) = 2: points3D(8) = 0
 
Set pline2DObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points2D)
pline2DObj.Color = acRed
pline2DObj.Update
 
Set pline3DObj = ThisDrawing.ModelSpace.AddPolyline(points3D)
pline3DObj.Color = acBlue
pline3DObj.Update
 
' Прочитаем координаты полилиний
Dim get2Dpts As Variant,get3Dpts As Variant
get2Dpts = pline2DObj.Coordinates
get3Dpts = pline3DObj.Coordinates
 
MsgBox ("2D полилиния (красная): " & vbCrLf & _
   get2Dpts(0) & ", " & get2Dpts(1) & vbCrLf & _
   get2Dpts(2) & ", " & get2Dpts(3) & vbCrLf & _
   get2Dpts(4) & ", " & get2Dpts(5))
 
MsgBox ("3D полилиния (синяя): " & vbCrLf & _
   get3Dpts(0) & ", " & get3Dpts(1) & ", " & _
   get3Dpts(2) & vbCrLf & _
   get3Dpts(3) & ", " & get3Dpts(4) & ", " & _
   get3Dpts(5) & vbCrLf & _
   get3Dpts(6) & ", " & get3Dpts(7) & ", " & _
   get3Dpts(8))
End Sub
 

Определение пользовательской системы координат

 

Часто бывает нужно сменить положение начальной точки отсчета системы координат и ориентацию осей, особенно при работе с трехмерными моделями. При этом системы координат пространства листа ограничены плоскостью. Метод Add, позволяющий создать новую систему координат требует на входе четыре параметра: координаты начала, координаты осей X Y и название ПСК. (пользоавтельской системы координат). Все координаты вводятся в мировой системе. Метод GetUCSMatrix используется для преобразования систем координат. Чтобы сделать систему координат активной используется свойство объекта Document.ActiveUCS. Если изменения делаются в активной системе координат, то требуется повторная установка свойства ActiveUCS. Пример создания системы координат, установки ее активной и трансляции координат точек в новую систему координат.

 

Sub NewUCS()
  Dim ucsObj As AcadUCS
  Dim origin(0 To 2) As Double
  Dim xAxisPnt(0 To 2) As Double
  Dim yAxisPnt(0 To 2) As Double
  ' Зададим точки ПСК
  origin(0) = 4: origin(1) = 5: origin(2) = 3
  xAxisPnt(0) = 5: xAxisPnt(1) = 5: xAxisPnt(2) = 3
  yAxisPnt(0) = 4: yAxisPnt(1) = 6: yAxisPnt(2) = 3
 
  ' Добавим в ПСК в коллекцию UserCoordinatesSystems
  Set ucsObj = ThisDrawing.UserCoordinateSystems. _
           Add(origin, xAxisPnt, yAxisPnt, "New_UCS")
  ' Отобразим значек ПСК
  ThisDrawing.ActiveViewport.UCSIconAtOrigin = True
  ThisDrawing.ActiveViewport.UCSIconOn = True
 
  ' Сделаем активной
  ThisDrawing.ActiveUCS = ucsObj
  MsgBox "Текущая ПСК : " & ThisDrawing.ActiveUCS.Name & vbCrLf & " Выбери точку."
 
  ' Найти ПСК и МСК - координаты точки
  Dim WCSPnt As Variant,UCSPnt As Variant
 
  WCSPnt = ThisDrawing.Utility.GetPoint(, "Введи точку: ")
  UCSPnt = ThisDrawing.Utility.TranslateCoordinates(WCSPnt, acWorld, acUCS, False)
 
  MsgBox "Коорд. МСК: " & WCSPnt(0) & ", " & WCSPnt(1) & ", " & WCSPnt(2) & vbCrLf & _
        "Коорд. ПСК: " & UCSPnt(0) & ", " & UCSPnt(1) & ", " & UCSPnt(2)
End Sub
 

Преобразования координат

 

Метод TranslateCoordinates преобразует координаты точек из одной системы в другую. Параметр OriginalPoint может рассматриваться как 3D точка так и 3D вектор. Этот аргумент различается в зависимости от значения аргумента Disp, если последний равен TRUE, значит OriginalPoint рассматривается как вектор. Еще два аргумента определяют из какой системы в какую преобразовывать. В качестве их значений могут быть WCS - мировая система (все остальные задаются относительно нее), UCS - рабочая система (все координаты задаются относительно нее), OCS - система координат объекта, DCS - система координат дисплея, PSDCS - система координат пространства листа. Пример преобразования OCS в WCS

 

Sub TranslateCoordinates()
  Dim plineObj As AcadPolyline
  Dim points(0 To 14) As Double
 
  points(0) = 1: points(1) = 1: points(2) = 0
  points(3) = 1: points(4) = 2: points(5) = 0
  points(6) = 2: points(7) = 2: points(8) = 0
  points(9) = 3: points(10) = 2: points(11) = 0
  points(12) = 4: points(13) = 4: points(14) = 0
 
  Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
 
  ' Найдем X и Y координаты первой вершины полилинии
  Dim firstVertex As Variant
  firstVertex = plineObj.Coordinate(0)
 
  ' Найдем Z-координату полилинии, через свойство elevation
  firstVertex(2) = plineObj.Elevation
 
  Dim plineNormal(0 To 2) As Double
  plineNormal(0) = 0#: plineNormal(1) = 1#: plineNormal(2) = 2#
  plineObj.Normal = plineNormal
 
  ' Переведем из OCS в WCS
  Dim coordinateWCS As Variant
  coordinateWCS = ThisDrawing.Utility.TranslateCoordinates _
        (firstVertex, acOCS, acWorld, False, plineNormal)
 
  MsgBox "Координаты первой вершины полилинии:" _
         & vbCrLf & "OCS: " & firstVertex(0) & ", " & _
         firstVertex(1) & ", " & firstVertex(2) & vbCrLf & _
         "WCS: " & coordinateWCS(0) & ", " & _
         coordinateWCS(1) & ", " & coordinateWCS(2)
End Sub
 

Создание 3-мерных объектов

 

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

 

Создание каркасных рамок

 

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

 

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

 

Сетки можно создавать как в 2D так и в 3D, но используются они приимущественно в трехмерных построениях. Нужны в тех случаях когда нет необходимости детального просмотра объекта, бывают разомкнутыми и замкнутыми. Создаются с использованием метода Add3DMesh, который на входе требует три параметра: Число вершин в направлении M, число вершин в направлении N, и массив типа Variant с координатами всех вершин. Как только создана PolygonMesh через свойства MClose и NClose можно делать сетку замкнутой. Пример создания сетки 4х4

 

Sub Create3DMesh()
  Dim meshObj As AcadPolygonMesh
  Dim mSize, nSize, Count As Integer
  Dim points(0 To 47) As Double
 
  ' координаты вершин сетки
  points(0) = 0: points(1) = 0: points(2) = 0
  points(3) = 2: points(4) = 0: points(5) = 1
  points(6) = 4: points(7) = 0: points(8) = 0
  points(9) = 6: points(10) = 0: points(11) = 1
  points(12) = 0: points(13) = 2: points(14) = 0
  points(15) = 2: points(16) = 2: points(17) = 1
  points(18) = 4: points(19) = 2: points(20) = 0
  points(21) = 6: points(22) = 2: points(23) = 1
  points(24) = 0: points(25) = 4: points(26) = 0
  points(27) = 2: points(28) = 4: points(29) = 1
  points(30) = 4: points(31) = 4: points(32) = 0
  points(33) = 6: points(34) = 4: points(35) = 0
  points(36) = 0: points(37) = 6: points(38) = 0
  points(39) = 2: points(40) = 6: points(41) = 1
  points(42) = 4: points(43) = 6: points(44) = 0
  points(45) = 6: points(46) = 6: points(47) = 0
 
  mSize = 4: nSize = 4
 
  Set meshObj = ThisDrawing.ModelSpace.Add3DMesh(mSize, nSize, points)
 
  ' Изменим направление взгляда, чтоб лучше видеть
  Dim NewDirection(0 To 2) As Double
  NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
  ThisDrawing.ActiveViewport.direction = NewDirection
  ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
  ZoomAll
End Sub
 

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

 

Используя метод AddPolyfaceMesh можно создавать сетку каждая грань которой может состоять из нескольких вершин. Каждой грани можно назначить свой цвет или сделать ее невидимой, если задать отрицательное значение номеров вершин. Пример создания:

 

Sub CreatePolyfaceMesh()
  Dim vertex(0 To 17) As Double
  vertex(0) = 4: vertex(1) = 7: vertex(2) = 0
  vertex(3) = 5: vertex(4) = 7: vertex(5) = 0
  vertex(6) = 6: vertex(7) = 7: vertex(8) = 0
  vertex(9) = 4: vertex(10) = 6: vertex(11) = 0
  vertex(12) = 5: vertex(13) = 6: vertex(14) = 0
  vertex(15) = 6: vertex(16) = 6: vertex(17) = 1
 
  Dim FaceList(0 To 7) As Integer
  FaceList(0) = 1: FaceList(1) = 2
  FaceList(2) = 5: FaceList(3) = 4
  FaceList(4) = 2: FaceList(5) = 3
  FaceList(6) = 6: FaceList(7) = 5
 
  Dim polyfaceMeshObj As AcadPolyfaceMesh
  Set polyfaceMeshObj = ThisDrawing.ModelSpace.AddPolyfaceMesh(vertex, FaceList)
  ' Чтоб лучше было видно сменим обзор
  Dim NewDirection(0 To 2) As Double
  NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
  ThisDrawing.ActiveViewport.direction = NewDirection
  ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
  ZoomAll
End Sub
 

11. Создание сплошных 3d объектов

 

Сплошные трехмерные объекты AutoCAD дают наиболее полное предстваление о реальном объекте. Для их создания используются следующие методы: AddBox, AddCone, AddCylinder, AddEllipticalCone, AddEllipticalCylinder, AddExtrudedSolid, AddExtrudedSolidAlongPath, AddRevolvedSolid, AddSolid, AddSphere, AddTorus, AddWedge.

Пример:

 

Sub CreateWedge()
  Dim wedgeObj As Acad3DSolid
  Dim center(0 To 2) As Double
  Dim length As Double
  Dim width As Double
  Dim height As Double
 
  center(0) = 5#: center(1) = 5#: center(2) = 0
  length = 10#: width = 15#: height = 20#
 
  Set wedgeObj = ThisDrawing.ModelSpace.AddWedge(center, length, width, height)
 
  Dim NewDirection(0 To 2) As Double
  NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
  ThisDrawing.ActiveViewport.direction = NewDirection
  ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
  ZoomAll
End Sub
 

Редактирование в трех измерениях

 

Для вращения трехмерных объектов используется метод Rotate или Rotate3D. Пример:

 

Sub Rotate_3DBox()
  Dim boxObj As Acad3DSolid
  Dim length As Double
  Dim width As Double
  Dim height As Double
  Dim center(0 To 2) As Double
 
  center(0) = 5: center(1) = 5: center(2) = 0
  length = 5: width = 7: height = 10
  Set boxObj = ThisDrawing.ModelSpace.AddBox(center, length, width, height)
 
  ' Определим оси вращения по двум точкам
  Dim rotatePt1(0 To 2) As Double,rotatePt2(0 To 2) As Double
  Dim rotateAngle As Double
  rotatePt1(0) = -3: rotatePt1(1) = 4: rotatePt1(2) = 0
  rotatePt2(0) = -3: rotatePt2(1) = -4: rotatePt2(2) = 0
  rotateAngle = 30
  rotateAngle = rotateAngle * 3.141592 / 180#
  ' Собственно вращение
  boxObj.Rotate3D rotatePt1, rotatePt2, rotateAngle
  ZoomAll
End Sub
 

Массивы трехмерных объектов

 

Используя метод ArrayRectangular можно задавать массивы трехмерных объектов с распространением их в любом направлении, то есть не только по числу строк и стролбцов, но и по числу уровней (ось Z). Пример:

 

Sub CreateRectangularArray()
  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 = 0.5
  Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
 
  ' зададим прямоугольный массив
  Dim numberOfRows As Long,numberOfColumns As Long,numberOfLevels As Long
  Dim distBwtnRows As Double,distBwtnColumns As Double,distBwtnLevels As Double
  numberOfRows = 4: numberOfColumns = 4: numberOfLevels = 3
  distBwtnRows = 1: distBwtnColumns = 1: distBwtnLevels = 4
 
  ' создадим маасив объектов
  Dim retObj As Variant
  retObj = circleObj.ArrayRectangular _
      (numberOfRows, numberOfColumns, _
       numberOfLevels, distBwtnRows, _
       distBwtnColumns, distBwtnLevels)
  ZoomAll
End Sub
 

Отражение в 3d

 

Sub MirrorABox3D()
  ' создадим коробок
  Dim boxObj As Acad3DSolid
  Dim length As Double,width As Double,height As Double
  Dim center(0 To 2) As Double
  center(0) = 5#: center(1) = 5#: center(2) = 0
  length = 5#: width = 7: height = 10#
 
  Set boxObj = ThisDrawing.ModelSpace.AddBox(center, length, width, height)
 
  ' Определим плоскость отражения тремя точками
  Dim mirrPt1(0 To 2) As Double,mirrPt2(0 To 2) As Double,mirrPt3(0 To 2) As Double
 
  mirrPt1(0) = 1.25: mirrPt1(1) = 0: mirrPt1(2) = 0
  mirrPt2(0) = 1.25: mirrPt2(1) = 2: mirrPt2(2) = 0
  mirrPt3(0) = 1.25: mirrPt3(1) = 2: mirrPt3(2) = 2
 
  ' отразим
  Dim mirrorBoxObj As Acad3DSolid
  Set mirrorBoxObj = boxObj.Mirror3D(mirrPt1, mirrPt2, mirrPt3)
  mirrorBoxObj.Color = acRed
  ZoomAll
End Sub
 

Редактирование трехмерных тел

 

Пример построения коробки и цилиндра для которых находится пересечение и на основании последнего строится новая фигура. Для большей наглядности все объекты рисуются разным цветом.

 

Sub FindInterferenceBetweenSolids()
  Dim boxObj As Acad3DSolid
  Dim length As Double,width As Double,height As Double
  Dim center(0 To 2) As Double
  center(0) = 5: center(1) = 5: center(2) = 0
  length = 5: width = 7: height = 10
 
  Set boxObj = ThisDrawing.ModelSpace.AddBox(center, length, width, height)
  boxObj.Color = acWhite
 
  ' теперь цилиндр
  Dim CylObj As Acad3DSolid
  Dim CylRadius As Double
  Dim CylHeight As Double
  center(0) = 0: center(1) = 0: center(2) = 0
  CylRadius = 5: CylHeight = 20
 
  Set CylObj = ThisDrawing.ModelSpace.AddCylinder(center, CylRadius, CylHeight)
  CylObj.Color = acCyan
 
  ' Найдем пересечение
  Dim solidObj As Acad3DSolid
  Set solidObj = boxObj.CheckInterference(CylObj, True)
  solidObj.Color = acRed
  ZoomExtents
End Sub

Использование метода SectionSolid помогает найти пересечение двух сплошных тел, а метод SliceSolid разрезать тело на два новых. Пример такой нарезки:

 

Sub SliceABox()
  Dim boxObj As Acad3DSolid
  Dim length As Double,width As Double,height As Double
  Dim center(0 To 2) As Double
  center(0) = 5#: center(1) = 5#: center(2) = 0
  length = 5#: width = 7: height = 10#
 
  Set boxObj = ThisDrawing.ModelSpace.AddBox(center, length, width, height)
  boxObj.Color = acWhite
 
  ' Зададим секущую плоскость тремя точками
  Dim slicePt1(0 To 2) As Double
  Dim slicePt2(0 To 2) As Double
  Dim slicePt3(0 To 2) As Double
 
  slicePt1(0) = 1.5: slicePt1(1) = 7.5: slicePt1(2) = 0
  slicePt2(0) = 1.5: slicePt2(1) = 7.5: slicePt2(2) = 10
  slicePt3(0) = 8.5: slicePt3(1) = 2.5: slicePt3(2) = 10
 
  ' рассечем коробочку плоскотью и закрасим другим цветом
  Dim sliceObj As Acad3DSolid
  Set sliceObj = boxObj.SliceSolid(slicePt1, slicePt2, slicePt3, True)
  sliceObj.Color = acRed
  ZoomExtents
End Sub
 

Подобно сеткам сплошные тела отображаются как каркасная рамка, до тех пор пока их не скроешь, затенишь или отрендеришь. Кроме того сплошные тела можно анализировать на предмет объема, момента инерции, центра тяжести и т.д. Для чего используются следующие свойства MomentOfInertia, PrincipalDirections, PrincipalMoments, ProductOfInertia, RadiiOfGyration, и Volume. Свойство ContourlinesPerSurface управляет числом линий используемых для отображения каркасной рамки. Свойство RenderSmoothness регулирует плавность прорисовки фигуры.

 

12. Вычерчивание и настройка разметки (layouts)

 

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

Вся геометрия рисунка содержится в макетах. Геометрия пространства модели содержится на на одном макете называемом Model. Его нельзя переименовать, но можно создать еще один. В одном рисунке может быть только одно пространство модели.Геометрия пространства листа также содержится на макетах. Может быть много различных макетов пространства листа, каждый из которых представляет свою конфигурацию для печати. В ActiveX-автоматизации объект ModelSpace содержит всю геометрию макета пространства модели. А т.к. пространств листов много, то объект PaperSpace указывает на последний активный.

Содержимое любого макета распределено между двумя различными объектами ActiveX Layout и Block. Объект Layout содержит настройки печати и визуальные свойства появляющиеся в интерфейсе пользователя. Объект Block содержит геометрию макета. Каждый объект Layout ассоциируется только с одним объектом Block. Для доступа к объекту используется свойство Block, а для доступа из блока к Layout используется соответствующее свойство блока. Объект PlotConfiguration подобен объекту Layout отличаясь тем, что не имеет связи с конкретным объектом Block, а является именованной коллекцией настроек плоттера.

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

Для выбора размера бумаги и единиц следует обращаться к каноническому имени принтера, можно также указать единицы используя свойство PaperUnits, которое принимает одно из трех значений: acInches, acMillimeters, acPixels. Для установки начала координат плоттера есть свойство CenterPlot, (по умолчанию оно равно FALSE)

Чтобы задать область вычерчивания есть свойство PlotType, которое может принимать одно из следующих значений: acDisplay - печатать все содержимое пространства модели (недоступно при печати из пространства листа), acExtents - печатать все что находится внутри границ, acLimits - печатать все внутри пределов, acView - печатать видовой экран заданный ViewToPlot, acWindow - печатать содержимое выбранного методом SetWindowToPlot окна, acLayout - печатать содержимое в границах пространства листа (недоступно при печати из пространства модели).

Чтобы задать масштаб вычерчивания есть два метода - стандартный масштаб установив свойство UseStandardScale в значение TRUE, после чего задать значение свойства StandardScale. Более гибкий метод - ввод пользовательского масштаба через UseStandardScale = FALSE и далее методом SetCustomScale указываем нужный масштаб. Можно также использовать значение acScaleToFit свойства StandardScale для подгонки изображения под размер листа. Для управления масштабированием веса линий свойство ScaleLineweights следует установить = TRUE.

Имя устройства печати задается свойством ConfigName, если его не трогать то печать будет идти на устройство по-умолчанию.

 

Видовые экраны

 

Для одновременного отображения нескольких частей рисунка, в т.ч. в разных масштабах существуют видовые экраны (ViewPorts). Они могут быть как "впритык" друг к другу, так и плавающими. Рисовать примечания можно непосредственно в пространстве листа не затрагивая пространства модели. Нельзя редактировать модель из пространства листа. Для доступа к модели в объекте PViewport следует переключиться из пространства листа в пространство модели через свойство ActiveSpace. При работе в PViewport объекте возможности редактирования почти такие же как и в Viewport, однако, в первом случае более удобна работа с отдельными видами. К примеру, можно заморозить или отключить слои на некоторых видовых экранах, не затрагивая остальные. Можно включить и выключить весь видовой экран. Можно так же выравнивать виды по видовым экранам. При работе с объектом ViewPort свойство ActiveSpace должно быть установлено в acModelSpace. При работе с объектом PViewport свойство ActiveSpace можно установить как в значение acModelSpace так и в acPaperSpace, то есть переключаться по мере необходимости.

Тип видового экрана

Состояние

Применение

PViewport

ActiveSpace = acPaperspace

Упорядочивание лэйаутов созданием плавающих видовых экранов, редактирование не затрагивает модель

PViewport

ActiveSpace = acModelspace

Работа с плавающими видовыми экранами для редактирования модели

Viewport

ActiveSpace = acModelspace

Разбивка экрана на пристыкованные блоки и редактирование модели

 

Свойство ActiveSpace меняет значение системной переменной TILEMODE.Установка ThisDrawing.ActiveSpace = acModelSpace эквивалентна TILEMODE = on, и установка ThisDrawing.ActiveSpace = acPaperSpace эквивалентна TILEMODE = off.Так же свойство MSpace является эквивалентом команд MSpace и PSpace. Установка ThisDrawing.MSpace = TRUE — то же самое, что использование команды MSPACE, а установка ThisDrawing.MSpace = FALSE эквивалентна команде PSPACE то есть переключает в пространство листа. В дополнение к сказанному требуется использование метода Display перед установкой свойства MSpace = TRUE, т.к. он инициализирует определенные графические установки, которые должны быть установлены перед переключением в пространство модели. Однако в ActiveX автоматизации установку этих настроек возлагают на программиста. Запомните: следует включить display методом Display по крайней мере для одного объекта PViewport перед тем как устанавливать свойств MSpace = TRUE

 

Переключение в лэйауты пространства листа

 

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

ThisDrawing.ActiveSpace = acPaperSpace2. ThisDrawing.MSpace = FALSE.

Когда вы находитесь в пространстве листа AutoCAD отображает иконку ПСК в нижнем левом углу графической области. Перекрестие указывает, что область пространства листа может быть редактирована. (не виды в видовых экранах)

 

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

 

Из пространства листа можно переключаться в плавающие или закрепленные стык в стык видовые экраны пространства модели. Для переключения в плавающий видовой экран инициализируем дисплей ThisDrawing.ActivePViewport.Display=TRUE и переключаемся ThisDrawing.MSpace = TRUE. Для переключения к состыкованным видовым экранам нужно выполнить дополнительный шаг ThisDrawing.MSpace = TRUE

 

Создание видовых экранов пространства листа

 

Видовые экраны пространства листа создаются методом AddPViewport. Метод требует указания центральной точки, а также ширины и высоты. Перед применением метода следует установить пространство листа текущим, обычно TILEMODE = 0. После создания объекта PViewport можно устанавливать свойства Direction, LensLength, GridOn, Layer, Linetype, LinetypeScale. Пример переключений между пространствами и создания плавающего видового экрана:

 
Sub SwitchToPaperSpace()
    ' Установка активным пространства листа
    ThisDrawing.ActiveSpace = acPaperSpace
 
    ' Создание видового экрана листа
    Dim newVport As AcadPViewport
    Dim center(0 To 2) As Double
    center(0) = 3.25 : center(1) = 3 : center(2) = 0
    Set newVport = ThisDrawing.PaperSpace.AddPViewport(center, 6, 5)
 
    ' Изменим направление вида
    Dim viewDir(0 To 2) As Double
    viewDir(0) = 1 : viewDir(1) = 1 : viewDir(2) = 1
    newVport.direction = viewDir
 
    ' Включим видовой экран
    newVport.Display True
 
    ' Обратно в пространство модели
    ThisDrawing.MSpace = True
 
    ' Сделаем вид активным
    ' (не всегда нужно, но неплохая идея)
    ThisDrawing.ActivePViewport = newVport
 
    ZoomExtents
 
    ' Отключим редактирование
    ThisDrawing.MSpace = False
 
    ' ZoomExtents в пространстве листа
    ZoomExtents
End Sub
 

Порядок шагов в вышеприведенном коде очень важен! Для того чтобы менять значения свойств объекта Viewport метод Display должен ьыть отключен, а перед тем как делать видовой экран текущим, метод Display нужно включить. Пример создания плавающего видового экрана использует предыдущий пример и устанавливает для четырех видовых экранов вид сверху, спереди, справа и изометрический соответствующим образом. Чтобы увидеть результаты следует создать сферу 3DSolid.

 
Sub FourPViewports()
    Dim topVport, frontVport As AcadPViewport
    Dim rightVport, isoVport As AcadPViewport
    Dim pt(0 To 2) As Double
    Dim viewDir(0 To 2) As Double
    ThisDrawing.ActiveSpace = acPaperSpace
    ThisDrawing.MSpace = True
' Возьмем существующий PViewport и сделаем его topVport
    pt(0) = 2.5: pt(1) = 5.5: pt(2) = 0
    Set topVport = ThisDrawing.ActivePViewport
' Нет необходимости указывать направление для вида с верху
    topVport.center = pt
    topVport.width = 2.5
    topVport.height = 2.5
    topVport.Display True
    ThisDrawing.MSpace = True
    ThisDrawing.ActivePViewport = topVport
    ZoomExtents
    ZoomScaled 0.5, acZoomScaledRelativePSpace
' Создадим и настроим фронтальный вид frontVport
    pt(0) = 2.5: pt(1) = 2.5: pt(2) = 0
    Set frontVport = ThisDrawing.PaperSpace.AddPViewport(pt, 2.5, 2.5)
    viewDir(0) = 0: viewDir(1) = 1: viewDir(2) = 0
    frontVport.direction = viewDir
    frontVport.Display acOn
    ThisDrawing.MSpace = True
    ThisDrawing.ActivePViewport = frontVport
    ZoomExtents
    ZoomScaled 0.5, acZoomScaledRelativePSpace
' А теперь вид с права rightVport
    pt(0) = 5.5: pt(1) = 5.5: pt(2) = 0
    Set rightVport = ThisDrawing.PaperSpace.AddPViewport(pt, 2.5, 2.5)
    viewDir(0) = 1: viewDir(1) = 0: viewDir(2) = 0
    rightVport.direction = viewDir
    rightVport.Display acOn
    ThisDrawing.MSpace = True
    ThisDrawing.ActivePViewport = rightVport
    ZoomExtents
    ZoomScaled 0.5, acZoomScaledRelativePSpace
' И наконец изометрический isoVport
    pt(0) = 5.5: pt(1) = 2.5: pt(2) = 0
    Set isoVport = ThisDrawing.PaperSpace.AddPViewport(pt, 2.5, 2.5)
    viewDir(0) = 1: viewDir(1) = 1: viewDir(2) = 1
    isoVport.direction = viewDir
    isoVport.Display acOn
    ThisDrawing.MSpace = True
    ThisDrawing.ActivePViewport = isoVport
    ZoomExtents
    ZoomScaled 0.5, acZoomScaledRelativePSpace
    ThisDrawing.Regen True
End Sub
 

Изменение вида и содержимого видовых экранов

 

Чтобы изменить вид объекта ViewPort надо находиться в пространстве модели и видовой экран должен быть активен. Для редактирования в плавающем видовом экране в пространстве модели сделайте видовой экран активным установкой свойства ActiveViewport следующим образом Thisdrawing.ActiveViewport = MyViewportObject и редактируйте. Можно также создавать объекты такие как примечания, размерности и др. в пространстве листа. Однако для этого следует установить ActiveSpace в состояние FALSE и включить пространство листа через свойство MSpace. Объекты, создаваемые в пространстве листа, только там и видны.

 

Масштабирование видов относительно пространства листа.

 

Перед печатью можно подобрать точный масштаб для каждой секции чертежа, (видового экрана). Масштабирование видов относительно пространства листа основывается на последовательном изменении масштаба каждого видового экрана. При работе в пространстве листа масштаб представляет собой отношение размера листа к реальному размеру вычерчиваемого объекта, отображаемого в видовых экранах. Метод ZoomScaled, масштабирует видовые экраны относительно пространства листа. Он принимает три параметра: видовой экран, фактор масштабирования, и тип масштабирования. Третий параметр необязателен, он позволяет выбрать масштабирование относительно границ рисунка, относительно текущего вида, относительно единиц пространства листа (acZoomScaledRelativePSpace). Дробные значения фактора масштаба уменьшают изображение.

 

Масштабирование образцов типов линий в пространстве листа

 

В пространстве листа любой тип линий может масштабироваться двумя путями:

·         основываясь на единицах вычерчивания пространства, в котором объект создавался

·         в универсальной форме основываясь на единицах пространства листа.

Системная переменная PSLTSCALE позволяет содержать различные масштабы типов линий для объектов отображаемых в различных масштабах и в разных видовых экранах. Это так же затрагивает линии в 3D-видах.

 

Скрытие линий в видовых экранах

 

Если чертеж содежит трехмерные объекты, то можно убрать скрытые линии с заданного видового экрана перед тем как выводить на печать. Для этого используется свойство RemoveHiddenLines для заданного видового экрана, которое принимает значение TRUE или FALSE. Для отмены вывода на печать скрытых линий видовых экранов пространства модели есть свойство PlotHidden объекта Layout.

 

Печать чертежей

 

Печатать чертеж можно в том виде, в котором он представлен в пространстве модели или в виде, подготовленном для печати через пространство листа. Печать из пространства модели часто предпочтительна, когда нужно распечатать черновик для предварительного просмотра-проверки. Когда же модель готова можно печатать из пространства листа. Печать задействует два объекта ActiveX Layout и Plot. Первый содержит настройки печати для данного лэйаута, второй методы и свойства для запуска и отслеживания процесса печати.

 

Выполнение базовых операций

 

Объектом Plot обладает следующими свойствами и методами: PlotToFile, PlotToDevice, DisplayPlotPreview, SetLayoutsToPlot, StartBatchMode, QuietErrorMode, NumberOfCopies, BatchPlotProgress (получить состояние или прервать печать). Метод SetLayoutsToPlot, следует вызывать перед каждым методом PlotToDevice и PlotToFile. В противном случае будет печататься активный лэйаут. Если свойство NumberOfCopies не переустановлено, то будет использовано значение от предыдущего задания. Перед началом пакетной печати установите QuietErrorMode=TRUE, чтобы печать шла непрерывно. Далее метод StartBatchMode начинает печать.

 

Печать из пространства модели

 

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

 
Sub PrintModelSpace()
    ' Проверим что активно пространство модели
    If ThisDrawing.ActiveSpace = acPaperSpace Then
        ThisDrawing.MSpace = True
        ThisDrawing.ActiveSpace = acModelSpace
    End If
    
    ' Зададим границы и масштаб печатаемой области.
    ThisDrawing.ModelSpace.Layout.PlotType = acExtents
    ThisDrawing.ModelSpace.Layout.StandardScale = acScaleToFit
    
    ' И число копий
    ThisDrawing.Plot.NumberOfCopies = 1
    
    ' Запустим печать
    ThisDrawing.Plot.PlotToDevice
End Sub
 

Имя устройства печати задается с помощью ConfigName, но может быть переопределено методом PlotToDevice с указанием файла PC3.

 

Печать из пространства листа

 

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

 
Sub PrintPaperSpace()
    ' Установим лэйауты пространства листа которые будем печатать
    Dim strLayouts(0 To 1) As String
    Dim varLayouts As Variant
    strLayouts(0) = "Layout1"
    strLayouts(1) = "Layout2"
    varLayouts = strLayouts
    ThisDrawing.Plot.SetLayoutsToPlot varLayouts
    ' Число копий
    ThisDrawing.Plot.NumberOfCopies = 1
    ' Печать
    ThisDrawing.Plot.PlotToDevice
End Sub

 

Продвинутые приемы вычерчивания. Работа с растровыми изображениями

 

Есть достаточно причин для того чтобы комбинировать растровые и векторные изображения в одном рисунке, это могут быть космические снимки, отсканированные чертежи и т.д. Растровые изображения можно представить в виде решетки, каждый элемент которой называют пискелем. Растры могут быть скопированы, перемещены, обрезаны по прямоугольнику или полигону. Некотрые из поддерживаемых форматов могут отображать прозрачные пиксели. Растры могут быть монохромными, 8-бит градации серого, 8-бит цветные и 24-бит цветные. Тип файла Autocad определяет не по его расширению, а по содержимому.

 
Тип растрового изображения       расширение
 
BMP      Windows и OS/2         обычно .bmp, .dib, .rle
CALS-I   Mil-R-Raster I         .gp4, .mil, .rst, .cg4, .cal
GeoSPOT  GeoSPOT                .bil
IG4      Image System Group 4   .ig4
IGS      Image System Grayscal  .igs
JPEG     Joint Photogr. Expert  .jpg
FLIC     FLIC Autodesk Animator .flc, .fli
PCX      Picture PC Paintbrush  .pcx
PICT     Picture Macintosh      .pct
PNG      Portable Network Grapf .png
RLC      Run Length Compresson  .rlc
TARGA    True Vision Raster     .tga
TIF      Tagged Image Format    .tif
 

Присоединение и масштабирование растрового изображения

 

Растры вставленные в рисунок Autocadа на самом деле не являются его частью, а только ссылкой, и не сильно увеличивают размер файла. Добавление растра выполняется методом AddRaster который на входе принимает 4 параметра: имя растра, точку вставки, фактор масштабирования и вращения. После присоединения растра его можно в любое время отсоединить. Каждый из них обладает собственной границей обрезки, яркостью, контрастностью и прозрачностью. Фактор масштабирования можно задать при создании растрового объекта, чтобы его единицы измерения совпадали с остальными. Если вставлять растр, то его фактор масштабирования по-умолчанию = 1 в единицах вычерчивания. Чтоб задать реальный масштаб, нужно знать размеры изображения, при этом очень удобно, когда в самой картинке хранятся данные о числе точек (пикселей) на дюйм DPI и размеры в пикселях. Если это так, например, картинка сканировалась в 1 дюйме 50 футов, то есть 1:600, и единицы вычерчивания в Autocad дюймы, то фактор масштабирования будет 600. Пример вставки растра:

 
Sub AttachingARaster()
    Dim insertionPoint(0 To 2) As Double
    Dim scalefactor As Double
    Dim rotationAngle As Double
    Dim imageName As String
    Dim rasterObj As AcadRasterImage
    imageName = "C:/Acad2000/sample/watch.jpg"
    insertionPoint(0) = 5: insertionPoint(1) = 5: insertionPoint(2) = 0
    scalefactor = 2: rotationAngle = 0
 
    On Error GoTo ERRORHANDLER
    ' Вставить растр в пространство модели
    Set rasterObj = ThisDrawing.ModelSpace.AddRaster(imageName, _
        insertionPoint, scalefactor, rotationAngle)
    ZoomExtents
    Exit Sub
ERRORHANDLER:
    MsgBox Err.Description
End Sub
 

Управление растровыми изображениями

 

Для того чтобы сменить путь к файлу изображения достаточно изменить значение свойства ImageFile, если Autocad не может найти растр, то он вырезает из имени растра путь (как абсолютный так и относительный) и продолжает поиск по пути указанному в методе SetProjectFilePath для объекта Preferences. При вставке растра Autocad присваивает ему имя основываясь на имени файла, без указания пути и расширения, его можно менять не боясь, что изменится и значение пути к файлу.

 

Модификация изображений и границ

 

Все растры имеют границы. Границы можно отобразить (скрыть), изменить цвет и тип линий, слой, переместить, масштабировать и вращать, делать растр невидимым и прозрачным, менять яркость, контрастность и т.д. Скрытие границ изображения позволяет избежать его случайного смещения и затрагивает все изображения. Чтобы изменить слой, цвет и тип линий границ - меняй значения свойств Layer, Color, LineType. Для изменения фактора масштабирования, вращения, положения, ширины и высоты есть следующие методы и свойства: ScaleEntity, Rotate, Origin, Width (в пикселях), Height (в пикселях), ImageWidth (в единицах вычерчивания), ImageHeight (в единицах вычерчивания), ShowRotation. Для изменения видимости изображения установи значение ImageVisibility=FALSE, это ускорит регенерацию. Для изменения прозрачности и цвета двуцветных (чернобелых) растров есть свойства Color и Transparency. Для регулировки Яркости, Контрастности и Затенения есть следующие свойства Brightness, Contrast, Fade. Подрезку изображений с помощью прямоугольных и полигональных границ можно выполнять независимо для каждой вставки одного и того же изображения. Для подрезки сначала следует включить ClippingEnabled=TRUE, затем методом ClipBoundary принимающим массив границ выполняем подрезку. Для изменения существующих границ подрезки нужно просто повторить то что сказано выше, при этом старые границы пропадут. Чтобы отобразить (скрыть) границу подрезки (вернуть оригинальные границы) используй свойство ClippingEnabled. Пример подрезки растрового изображения:

 
Sub ClippingRasterBoundary()
    Dim insertionPoint(0 To 2) As Double
    Dim scalefactor As Double
    Dim rotationAngle As Double
    Dim imageName As String
    Dim rasterObj As AcadRasterImage
 
    imageName = "C:\AutoCAD\sample\downtown.jpg"
    insertionPoint(0) = 5: insertionPoint(1) = 5: insertionPoint(2) = 0
    scalefactor = 2: rotationAngle = 0
 
    On Error GoTo ERRORHANDLER
    ' Вставить растр в пространство модели
    Set rasterObj = ThisDrawing.ModelSpace.AddRaster(imageName, insertionPoint, _
                     scalefactor, rotationAngle)
    ZoomExtents
 
    ' Задать границы подрезки в виде массива точек
    Dim clipPoints(0 To 9) As Double
    clipPoints(0) = 6: clipPoints(1) = 6.75
    clipPoints(2) = 7: clipPoints(3) = 6
    clipPoints(4) = 6: clipPoints(5) = 5
    clipPoints(6) = 5: clipPoints(7) = 6
    clipPoints(8) = 6: clipPoints(9) = 6.75
 
    ' Подрезать
    rasterObj.ClipBoundary clipPoints
 
    ' Разрешить отображение подрезки
    rasterObj.ClippingEnabled = True
    ThisDrawing.Regen acActiveViewport
    Exit Sub
 
ERRORHANDLER:
    MsgBox Err.Description
End Sub
 

13. Работа с блоками, атрибутами и внешними ссылками

 

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

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

Блоки могут наследовать цвета и типы линий от того слоя в котором расположены элементы их составляющие. При каждой вставке они создают соответствующие слои и типы линий. Блочная ссылка, состоящая из объектов, нарисованных на слое 0, с цветом и типом линий "по слою", помещенная на текущий слой наследует цвет и тип линий у слоя. Свойства текущего слоя заменяют свойства цвета и типа линий явно заданные блочной ссылке.

Блочная ссылка, состоящая из объектов, у которых цвет и тип линий заданы "по блоку" позволяет назначать их вставленной блочной ссылке, т.е. если сменить цвет блока на красный, то изменится цвет всех элементов. Блоки могут быть вложенными, единственное ограничение в том, что блок не может ссылаться сам на себя. Для создания нового блока используется метод Add, который требует два параметра - место размещения блока и имя блока. После создания к блоку можно добавлять любые геометрические объекты или другие блоки, после чего можно вставлять в рисунок вхождения блока. Можно также создать блок методом Wblock, группируя объекты во внешний файл. Autocad рассматривает любой чертеж, вставленный в текущий, как блок. Метод InsertBlock используется для вставки блочной ссылки в рисунок, он принимает шесть параметров: точка вставки, имя вставляемого блока, масштабы по осям координат (три параметра), и угол поворота.

Если после вставки блока из внешнего файла во внешнем файле произошли изменения, то это не отражается на вставленном блоке, если необходимо видеть изменения, то блок следует вставить повторно методом InsertBlock. При вставке рисунка в качестве блока имя блока присваивается по имени вставленного файла. Изменить имя блока можно, сменив значение свойства Name. По умолчанию для вставки Autocad использует координаты (0,0,0) как координаты базовой точки. Изменить координаты базовой точки можно методом SetVariable для переменной INSBASE. При следующей вставке будет использоваться новая базовая точка. Если вставленный рисунок содержит объекты пространства листа, они не будут включены в текущее определение блока. Для использования объектов пространства листа в другом рисунке откройте исходный рисунок и используйте метод Add чтобы определить объект пространства листа как блок. Вставлять рисунок можно как в пространство модели, так и в пространство листа. Составляющие блок объекты не могут быть перечисленны, однако возможно перечисление оригинального определения блока, можно так же взорвать блок для этой цели. Вставлять блок можно также методом AddMInsertBlock, который вставляет массив блоков. Пример определения и вставки блока:

 
Sub InsertingABlock()
    ' Определим блок
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0: insertionPnt(1) = 0: insertionPnt(2) = 0
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "CircleBlock")
 
    ' Добавим в блок окружность
    Dim circleObj As AcadCircle
    Dim center(0 To 2) As Double
    Dim radius As Double
    center(0) = 0: center(1) = 0: center(2) = 0: radius = 1
    Set circleObj = blockObj.AddCircle(center, radius)
 
    ' Вставим блок
    Dim blockRefObj As AcadBlockReference
    insertionPnt(0) = 2: insertionPnt(1) = 2: insertionPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _
               (insertionPnt, "CircleBlock", 1#, 1#, 1#, 0)
    ZoomExtents
    MsgBox "Окружность стала блоком " & blockRefObj.ObjectName
End Sub
 

Примечание: после вставки внешнего файла WCS выравнивается параллельно плоскости XY, UCS текущего рисунка. Метод Explode позволяет разбить блок на составляющие, после чего удалить или отредактировать и переопределить блок. Следующий пример создает блок, затем его взрывает и показывает составляющие.

 
Sub ExplodingABlock()
    ' Определим блок
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0: insertionPnt(1) = 0: insertionPnt(2) = 0
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "CircleBlock")
 
    ' Добавим окружность
    Dim circleObj As AcadCircle
    Dim center(0 To 2) As Double
    Dim radius As Double
    center(0) = 0: center(1) = 0: center(2) = 0: radius = 1
    Set circleObj = blockObj.AddCircle(center, radius)
 
    ' Вставим блок
    Dim blockRefObj As AcadBlockReference
    insertionPnt(0) = 2: insertionPnt(1) = 2: insertionPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _
               (insertionPnt, "CircleBlock", 1#, 1#, 1#, 0)
    ZoomExtents
    MsgBox "Окружность стала " & blockRefObj.ObjectName
 
    ' Взорвем блочную ссылку
    Dim explodedObjects As Variant
    explodedObjects = blockRefObj.Explode
 
    ' Перечислим полученные обломки
    Dim I As Integer
    For I = 0 To UBound(explodedObjects)
        explodedObjects(I).Color = acRed
        explodedObjects(I).Update
        MsgBox "Обломок " & I & ": " & explodedObjects(I).ObjectName
        explodedObjects(I).Color = acByLayer
        explodedObjects(I).Update
    Next
End Sub
 

Переопределение блока

 

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

 
Sub RedefiningABlock()
    ' Определим блок
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0: insertionPnt(1) = 0: insertionPnt(2) = 0
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "CircleBlock")
 
    ' Добавим окружность
    Dim circleObj As AcadCircle
    Dim center(0 To 2) As Double
    Dim radius As Double
    center(0) = 0: center(1) = 0: center(2) = 0: radius = 1
    Set circleObj = blockObj.AddCircle(center, radius)
 
    ' Вставим блок
    Dim blockRefObj As AcadBlockReference
    insertionPnt(0) = 2: insertionPnt(1) = 2: insertionPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _
               (insertionPnt, "CircleBlock", 1#, 1#, 1#, 0)
    ZoomExtents
 
    ' Переопределим блок
    circleObj.radius = 3
    blockRefObj.Update
End Sub
 

Работа с атрибутами

 

Атрибуты позволяют присоединить к блоку текст комментария. Атрибуты можно извлекать и помещать в базу данных или электронную таблицу. С блоком может быть связано более одного атрибута. Можно определять постоянные атрибуты, которые при вставке блока не требуют ввода значения. Атрибуты могут быть невидимыми. Чтобы создать атрибутную ссылку сначала следует определить атрибут методом AddAttribute который требует шесть параметров: высота текста, режим, строка подсказки, точка вставки, строка - имя атрибута, значение атрибута по-умолчанию. Режим указывать не обязательно. Возможны следующие варианты acAttributeModeNormal, acAttributeModeInvisible, acAttributeModeConstant, acAttributeModeVerify, acAttributeModePreset. Если нужно указать несколько атрибутов, то следует просто сложить константы им соответствующие, например acAttributeModeInvisible + acAttributeModeConstant.

Строка подсказки появляется при вставке блока с атрибутами, по-умолчанию ее значение равно имени (тэгу) атрибута. При acAttributeModeConstant подсказка не выводится. В качестве тэгов можно использовать любые символы кроме пробелов и восклицательных знаков, символы нижнего регистра преобразуются в верхний. После того как атрибут определен при вставке блока можно указать другое значение атрибута. Атрибуты связаны с блоком, в котором они создавались. Атрибуты, созданные в пространстве модели или листа, рассматриваются как не принадлежащие к блокам. Пример определения атрибутов:

 
Sub CreatingAnAttribute()
    ' Определим блок
    Dim blockObj As AcadBlock
    Dim insPnt(0 To 2) As Double
    insPnt(0) = 0: insPnt(1) = 0: insPnt(2) = 0
    Set blockObj = ThisDrawing.Blocks.Add(insPnt, "BlkWithAttr")
 
    ' Добавим к нему атрибут
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim insPoint(0 To 2) As Double
    Dim tag As String
    Dim value As String
    height = 1
    mode = acAttributeModeVerify
    prompt = "New Prompt"
    insPoint(0) = 5: insPoint(1) = 5: insPoint(2) = 0
    tag = "New Tag": value = "New Value"
    Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insPoint, tag, value)
    ' Вставим блок, создадим блочную ссылку и атрибутную ссылку
    Dim blockRefObj As AcadBlockReference
    insPnt(0) = 2: insPnt(1) = 2: insPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insPnt, "BlkWithAttr", 1#, 1#, 1#, 0)
End Sub
 

Редактирование определения атрибутов

 

Свойства:

·         Alignment - задает горизонтальное и вертикальное выравнивание;

·         Backward - задает направление текста;

·         FieldLength - задает ширину поля;

·         Height - задает высоту атрибута;

·         InsertionPoint - задает точку вставки;

·         Mode - один из режимов;

·         PromptString - строка подсказки;

·         Rotation – вращение;

·         ScaleFactor - фактор масштабирования;

·         TagString - имя атрибута;

Методы:

·         ArrayPolar - создать полярный массив;

·         ArrayRectangular - создать прямоугольный массив;

·         Copy - копировать атрибут;

·         Erase - удалить атрибут;

·         Mirror - зеркально отразить;

·         Move – передвинуть;

·         Rotate – вращать;

·         ScaleEntity – масштабировать.

 

Переопределение атрибутов

 
Sub RedefiningAnAttribute()
    ' Определим блок
    Dim blockObj As AcadBlock
    Dim insPnt(0 To 2) As Double
    insPnt(0) = 0: insPnt(1) = 0: insPnt(2) = 0
    Set blockObj = ThisDrawing.Blocks.Add(insPnt, "BlkWithAttr")
 
    ' Добавим атрибут
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim insPoint(0 To 2) As Double
    Dim tag As String
    Dim value As String
    height = 1
    mode = acAttributeModeVerify
    prompt = "New Prompt"
    insPoint(0) = 5: insPoint(1) = 5: insPoint(2) = 0
    tag = "New Tag": value = "New Value"
    Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insPoint, tag, value)
    ' Вставим блок, создадим блочную и атрибутную ссылки
    Dim blockRefObj As AcadBlockReference
    insPnt(0) = 2: insPnt(1) = 2: insPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insPnt, "BlkWithAttr", 1#, 1#, 1#, 0)
 
    ' Переопределим направление текста
    attributeObj.Backward = True
    attributeObj.Update
End Sub
 

Извлечение информации из атрибутов

 

Для извлечения атрибутов есть два метода GetAttributes и GetConstantAttributes. Первый из них возвращает массив атрибутных ссылок присоединенных к блоку. Второй метод возвращает массив постоянных атрибутов (не ссылок). По полученному массиву можно пройти, просматривая свойства TagString и TextString для получения информации о каждом атрибуте. Пример извлечения атрибутов:

 
Sub GettingAttributes()
    ' Создаем блок
    Dim blockObj As AcadBlock
    Dim insPnt(0 To 2) As Double
    insPnt(0) = 0: insPnt(1) = 0: insPnt(2) = 0
    Set blockObj = ThisDrawing.Blocks.Add(insPnt, "TESTBLOCK")
    
    ' определим атрибуты
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim insPoint(0 To 2) As Double
    Dim tag As String
    Dim value As String
    height = 1#
    mode = acAttributeModeVerify
    prompt = "Attribute Prompt"
    insPoint(0) = 5: insPoint(1) = 5:insPoint(2) = 0
    tag = "Attr Tag"
    value = "Attr Value"
    ' Создаем определение атрибута в блоке
    Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insPoint, tag, value)
 
    ' Вставим блок
    Dim blockRefObj As AcadBlockReference
    insPnt(0) = 2: insPnt(1) = 2: insPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insPnt, "TESTBLOCK", 1, 1, 1, 0)
    ZoomAll
    
    ' Получить атрибуты для блочной ссылки
    Dim varAttributes As Variant
    varAttributes = blockRefObj.GetAttributes
    
    ' Поместим Тэг и содержимое текстовой части
    ' атрибута в Msgbox
    Dim strAttributes As String
    strAttributes = ""
    Dim I As Integer
    For I = LBound(varAttributes) To UBound(varAttributes)
        strAttributes = strAttributes + "  Tag: " + _
        varAttributes(I).TagString + vbCrLf + _
        "   Value: " + varAttributes(I).textString
    Next
    MsgBox "Атрибуты для блочной ссылки " + _
                   blockRefObj.Name & " : " & vbCrLf & strAttributes
    
   ' Изменим значение атрибута
   ' Не SetAttributes. Если есть массив то он является объектом.
   ' Изменение его изменияе объекты чертежа.
    varAttributes(0).textString = "NEW VALUE!"
    
    ' Снова получим атрибуты
    Dim newvarAttributes As Variant
    newvarAttributes = blockRefObj.GetAttributes
    
    ' Снова отобразим
    strAttributes = ""
    For I = LBound(varAttributes) To UBound(varAttributes)
        strAttributes = strAttributes + "  Tag: " + _
        newvarAttributes(I).TagString + vbCrLf + _
        "   Value: " + newvarAttributes(I).textString