ПРОДВИНУТЫЕ ПРИЕМЫ ВЫЧЕРЧИВАНИЯ

РАБОТА С РАСТРОВЫМИ ИЗОБРАЖЕНИЯМИ

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

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

Для извлечения атрибутов есть два метода 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
    Next
    MsgBox "Атрибуты для блочной ссылки " & _
                  blockRefObj.Name & " : " & vbCrLf & strAttributes
End Sub    

ИСПОЛЬЗОВАНИЕ ВНЕШНИХ ССЫЛОК

Внешняя ссылка связывает другой рисунок с текущим. При вставке другого рисунка как блока информация о его геометрии сохраняется в базе рисунка. Она не обновляется если исходный рисунок изменился. Однако если вставлять как внешнюю ссылку, все изменения сразу отображаются. Подобно блочной ссылке внешняя ссылка отображается в рисунке единым объектом, однако вненяя ссылка не может быть "взорвана", как и с блоками можно создавать вложения внешних ссылок.
При открытии или печати рисунка Autocad перезагружает каждую внешнюю ссылку, чтобы отобразить ее в "свежайшем" виде. В отличие от блока при вставке внешней ссылки в чертеж вставляется только определение, а не сам файл. Если файл внешней ссылки отсутствует или поврежден, то Autocad его просто не отображает. Если значение системной переменной VISRETAIN=On Autocad сохраняет любую информацию о зависимых от внешней ссылки слоях в базе данных чертежа и она используется при следующем открытии. Можно вставлять неограниченное (?) число внешних ссылок. Можно также управлять слоями и типами линий внешней ссылки. Для добавления внешней ссылки используй метод AttachExternalReference он требует путь и имя вставляемого файла, имя ссылки, точку вставки, масштаб и угол вращения и возвращает объект ExternalReference. Пример:

Sub AttachingExternalReference()
    On Error GoTo ERRORHANDLER
    Dim InsPoint(0 To 2) As Double
    Dim insertedBlock As AcadExternalReference
    Dim tempBlock As AcadBlock
    Dim msg As String, PathName As String
    
    ' определим внешнюю ссылку
    InsPoint(0) = 1: InsPoint(1) = 1: InsPoint(2) = 0
    PathName = "c:/acad2002/sample/db_samp.dwg"
    
    ' Отобразим информацию о блоках
    GoSub ListBlocks
    
    ' Добавим внешнюю ссылку
    Set insertedBlock = ThisDrawing.ModelSpace. _
    AttachExternalReference(PathName, "XREF_IMAGE", InsPoint, 1, 1, 1, 0, False)
    ZoomExtents
    
    ' Отобразим информацию о блоках
    GoSub ListBlocks
    Exit Sub
ListBlocks:
    msg = vbCrLf
    For Each tempBlock In ThisDrawing.Blocks
        msg = msg & tempBlock.Name & vbCrLf
    Next
    MsgBox "Блоки в чертеже: " & msg
    Return
    
ERRORHANDLER:
    MsgBox Err.Description
End Sub

Наложение внешних ссылок подобно присоединению, отличие только в том как обрабатываются вложенные ссылки. В случае наложения - вложенные ссылки просто не отображаются. Наложение удобно использовать толгда когда конечному потребителю по-барабану дополнительные детали созданного вами чертежа, который используется в качестве внешней ссылки. То есть этот тип ссылок предназначен для совместного использования данных, кроме того он позволяет избежать цикличесских ссылок. Чтобы ссылка была наложением измени параметр метода AttachExternalReference на bOverlay=TRUE. Для исключения ссылки из рисунка нужно его оттсоединить, можно также стереть конкретное вхождение ссылки. Ссылка самоуничтожается при следующем открытии чертежа, если уже нет ни одного ее вхождения. Для отсоединения ссылки используй метод Detach. Нельзя, однако отсоединить вложенную ссылку. Пример отсоединения ссылки:

Sub DetachingExternalReference()
    On Error GoTo ERRORHANDLER
                          
    ' Определим внешнюю ссылку
    Dim xrefHome As AcadBlock
    Dim xrefInserted As AcadExternalReference
    Dim insertionPnt(0 To 2) As Double
    Dim PathName As String
    insPnt(0) = 1: insPnt(1) = 1: insPnt(2) = 0
    PathName = "c:/acad2002/sample/db_samp.dwg"
    
    ' Добавим внешнюю ссылку
    Set xrefInserted = ThisDrawing.ModelSpace. _
        AttachExternalReference(PathName, "XREF_IMAGE", insPnt, 1, 1, 1, 0, False)
    ZoomExtents
    MsgBox "Внешняя ссылка присоединена."
    
    ' Остосединим внешнюю ссылку
    Dim name As String
    name = xrefInserted.name
    ThisDrawing.Blocks.Item(name).Detach
    MsgBox "Внешняя ссылка отсоединена."
    Exit Sub
ERRORHANDLER:
    MsgBox Err.Description
End Sub

Выгрузка внешних ссылок

Для ускорения работы часть (или все) внешних ссылок можно выгрузить методом Unload. Пример:

Sub UnloadingExternalReference()
    On Error GoTo ERRORHANDLER
                          
    ' Определим внешнюю ссылку
    Dim xrefHome As AcadBlock
    Dim xrefInserted As AcadExternalReference
    Dim insPnt(0 To 2) As Double
    Dim PathName As String
    insPnt(0) = 1: insPnt(1) = 1: insPnt(2) = 0
    PathName = "c:/AutoCAD/sample/db_samp.dwg"
    
    ' Добавим внешнюю ссылку
    Set xrefInserted = ThisDrawing.ModelSpace. _
        AttachExternalReference(PathName, "XREF_IMAGE", insPnt, 1, 1, 1, 0, False)
    ZoomExtents
    MsgBox "Добавлена внешняя ссылка."
    
    ' Выгрузим определение внешней ссылки
    ThisDrawing.Blocks.Item(xrefInserted.name).Unload
    MsgBox "Внешняя ссылка выгружена."
    Exit Sub
ERRORHANDLER:
    MsgBox Err.Description
End Sub

Привязка внешней ссылки

Привязка внешней ссылки делает ее постояннной частью рисунка, а не внешней ссылкой. То есть она становится блоком, отсюда следует что при изменении чертежа внешней ссылки в основном чертеже никаких изменений не получим. После привязки любые именованные объекты (блоки, размерные стили, слои, типы линий и стили текста) могут использоваться в основном рисунке. Метод Bind требует только один параметр bPrefixName, если он равен TRUE, то символьные имена получают префикс по имени блока + цифровой идентификатор. В противном случае символьные имена сливаются с уже существующими и при наличии совпадаений оставляются уже определенные в основном рисунке. Если не уверен, будут ли в связываемой внешней ссылке дублироваться имена используй TRUE. Пример связывания:

Sub BindingExternalReference()
    On Error GoTo ERRORHANDLER
                          
    ' Определим внешнюю ссылку
    Dim xrefHome As AcadBlock
    Dim xrefInserted As AcadExternalReference
    Dim insPnt(0 To 2) As Double
    Dim PathName As String
    insPnt(0) = 1: insPnt(1) = 1: insPnt(2) = 0
    PathName = "c:/AutoCAD/sample/db_samp.dwg"
    
    ' Добавим внешнюю ссылку
    Set xrefInserted = ThisDrawing.ModelSpace. _
        AttachExternalReference(PathName, "XREF_IMAGE", insPnt, 1, 1, 1, 0, False)
    ZoomExtents
    MsgBox "Внешняя ссылка присоединена."
    
    ' Привяжем определение внешней ссылки
    ThisDrawing.Blocks.Item(xrefInserted.name).Bind False
    MsgBox "Внешняя ссылка связана."
    Exit Sub
ERRORHANDLER:
    MsgBox Err.Description
End Sub

Не существует метода для обрезки блока или внешней ссылки в ActiveX, поэтому если очень нужно используй метод SendCommand вызывая команду XCLIP.

Загрузка по требованию и повышение производительности внешних ссылок

Комбинируя загрузку по требованию и сохранение рисунка с индексами можно увеличить скорость работы рисунков с внешними сслыками. Загрузка по требованию работает совместно с системными переменными XLOADCTL и INDEXCTL. Когда включена загрузка по требованию (при условии что были сохранены индексы в подчиненных рисунках) Autocad загружает в память только данные которые нужны для регенирации текущего рисунка. Наиболее заметен выигрыш в производительности при использовании загрузки по требованию когда внешняя ссылка подрезана и пространственный индекс сохранен во внешнем рисунке, а также в случае заморозки некоторых слоев внешней ссылки и рисунок-внешняя ссылка сохранен с индексом слоя. Чтобы включить загрузку по требованию есть свойство XRefDemandLoad если оно включено с параметром acDemandLoadEnabledWithCopy Autocad создает временную копию файла внешней ссылки и загружает по требованию временный файл, при этом исходный файл внешней ссылки можно в этот момент редактировать. А когда загрузка по требованию отменена Autocad загружает весь файл внешней ссылки, не обращая внимание на видимость слоев или обрезку. Для включения слоев и пространственных индексов установи значение переменной INDEXCTL таким образом - (0 - не создавать индексы, 1 - создать индекс слоев, 2 - создать пространственный индекс, 3 - создать оба индекса).
Пространственный индекс - список примитивов и данных их положения в трехмерном пространстве (используется при частичном открытии файла).
Индекс слоев - список слоев с перечнем объектов на них. По умолчанию файлы создаются без индексов (!)

НАЗНАЧЕНИЕ И ЧТЕНИЕ РАСШИРЕННЫХ ДАННЫХ

Объектам могут назначаться расширенные данные (дополнительная информация). Примеры установки и чтения:

Sub AttachXDataToSelectionSetObjects()
    ' Создаем набор
    Dim sset As Object
    Set sset = ThisDrawing.SelectionSets.Add("SS1")
    
    ' Предложим пользователю выбрать объекты
    sset.SelectOnScreen
    
    ' Определим расширенные данные
    Dim appName As String, xdataStr As String
    appName = "MY_APP"
    xdataStr = "Пример xdata (дополнительных данных)"
    Dim xdataType(0 To 1) As Integer
    Dim xdata(0 To 1) As Variant
    
    ' Зададим значения для каждого массива
    ' 1001 = appName
    xdataType(0) = 1001
    xdata(0) = appName
    ' 1000 отображает строковое значение
    xdataType(1) = 1000
    xdata(1) = xdataStr
    
    ' Проходим по элементам набора и устанавливаем
    ' каждому расширенные данные
    Dim ent As Object
    For Each ent In sset
        ent.SetXData xdataType, xdata
    Next ent
End Sub

Sub ViewXData()
    ' Ищем набор, созданный в предыдущем примере
    Dim sset As Object
    Set sset = ThisDrawing.SelectionSets.Item("SS1")
    
    ' Создаем переменные для хранения расширенных данных
    Dim xdataType As Variant
    Dim xdata As Variant
    Dim xd As Variant
    
    Dim xdi As Integer
    xdi = 0
    
    ' Проходим по всем объектам набора, читая расширенные данные
    Dim msgstr As String
    Dim appName As String
    Dim ent As AcadEntity
    appName = "MY_APP"
    For Each ent In sset
        msgstr = ""
        xdi = 0
        
        ' Имя приложения (appName) xdata Тип и Значение
        ent.GetXData appName, xdataType, xdata
        
        ' Если переменная xdataType не инициализирована, не
        ' будет appName xdata
        If VarType(xdataType) <> vbEmpty Then
            For Each xd In xdata
                msgstr = msgstr & vbCrLf & xdataType(xdi) & ": " & xd
                xdi = xdi + 1
            Next xd
        End If
        
        ' Если полученная строка пуста (NULL), нет расширенных данных
        If msgstr = "" Then msgstr = vbCrLf & "NONE"
        MsgBox appName & " xdata " & ent.ObjectName & ":" & vbCrLf & msgstr
    Next ent
End Sub

Читать дальше - В начало - На главную