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

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

Есть достаточно причин для того чтобы комбинировать растровые и векторные изображения в одном рисунке, это могут быть космические снимки, отсканированные чертежи и т.д. Растровые изображения можно представить в виде решетки, каждый элемент которой называют пискелем. Растры могут быть скопированы, перемещены, обрезаны по прямоугольнику или полигону. Некотрые из поддерживаемых форматов могут отображать прозрачные пиксели. Растры могут быть монохромными, 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

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

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

Блок представляет собой набор объектов, который может быть собран в один объект или блочную ссылку. Полученный блок можно вращать, масштабировать, вставлять многократно как единое целое, но можно также "взорвать" на исходные составляющие, чтобы переопределить. 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