Корневой объект AutoCAD ActiveX Automation Object Model — объект Application. Все остальные объекты его наследники. На верхней ступени находятся объекты:

• Preferences
• Documents
• MenuBar
• MenuGroups

В объектной модели такие объекты как слой, текстовый или размерный стиль, документ и др. собраны в т.н. коллекции. Объекты Documents, MenuBar и MenuGroups также являются коллекциями. Все коллекции имеют следующие важнейшие свойства и методы:

Рассмотрим более подробно коллекции:

• Документов
• Слоев
• Текстовых стилей
• Размерных стилей
• Типов линий

Открыть существующий документ:

var
  Doc: OleVariant;
begin
  Doc:= Acad.Documents.Open('clouds.dwg');
  ShowMessage(Format('Открыт документ "%s"', [Doc.Name]));
end;

Создать новый документ:

var
  Doc: OleVariant;
begin
  Doc:= Acad.Documents.Add('');
  ShowMessage(Format('Создан новый документ "%s"', [Doc.Name]));
end;

Получить список всех документов:

procedure EnumAcadDocuments(Items: TStrings);
var
  i, cnt: Integer;
begin
  if not VarIsClear(Acad) then
  begin
    cnt:= Acad.Documents.Count;
    with Items do
    begin
      BeginUpdate;
      try
        Clear;
        for i:= 0 to cnt - 1 do
          Add(Acad.Documents.Item(i).Name);
      finally
        EndUpdate;
      end;
    end;
  end;
end;

Зачем нужна переменная cnt? Ведь можно было сделать и так:

. . .
for i:= 0 to Acad.Documents.Count - 1 do
. . .

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

Получить текущий документ:

var
  ActiveDoc: OleVariant;
. . .
ActiveDoc:= Acad.ActiveDocument;

Получить текущий слой активного документа:

var
  ActiveLayer: OleVariant;
. . .
ActiveLayer:= Acad.ActiveDocument.ActiveLayer;

Установить текущим указанный слой активного документа:

procedure SetActiveLayer(AName: String);
var
  AcadDocument, Layer: OleVariant;
  ActiveLayerName: String;
  i, LayersCount: Integer;
begin
  if not VarIsClear(Acad) then
  begin
    AcadDocument:= Acad.ActiveDocument;
    ActiveLayerName:= AcadDocument.ActiveLayer.Name;
    if AnsiCompareText(AName, ActiveLayerName) = 0 then Exit;
    LayersCount:= AcadDocument.Layers.Count;
    for i:= 0 to LayersCount - 1 do
    begin
      Layer:= AcadDocument.Layers.Item(i);
      if AnsiCompareText(Layer.Name, AName) = 0 then Break;
    end;
    AcadDocument.ActiveLayer:= Layer;
  end;
end;

Получить список всех слоев активного документа:

type
  TLayerState = (lsLayerOn, lsFreeze, lsLock, lsPlottable);
  TLayerStates = set of TLayerState;
  
function EnumAutoCADLayers(Items: TStrings): Integer;
var
  AcadDocument, Layer: OleVariant;
  ActiveLayerName, LayerName: String;
  i, LayersCount, Tmp: Integer;
  States: TLayerStates;
begin
  Result:= -1;
  if not VarIsClear(Acad) then
  begin
    AcadDocument:= Acad.ActiveDocument;
    with Items do
    begin
      BeginUpdate;
      try
        Clear;
        ActiveLayerName:= AcadDocument.ActiveLayer.Name;
        LayersCount:= AcadDocument.Layers.Count;
        for i:= 0 to LayersCount - 1 do
        begin
          Layer:= AcadDocument.Layers.Item(i);
          States:= [];
          if Layer.LayerOn then States:= States + [lsLayerOn];
          if Layer.Freeze then States:= States + [lsFreeze];
          if Layer.Lock then States:= States + [lsLock];
          if Layer.Plottable then States:= States + [lsPlottable];
          LayerName:= Layer.Name;
          System.Move(States, Tmp, 1);
          AddObject(LayerName, TObject(Tmp));
          if AnsiCompareText(LayerName, ActiveLayerName) = 0 then
            Result:= i;
        end;
      finally
        EndUpdate;
      end;
    end;
  end;
end;

procedure TForm1.cbLayersDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Tmp: Integer;
  States: TLayerStates;
begin
  with Control as TComboBox do
  begin
    Tmp:= Integer(Items.Objects[Index]);
    Move(Tmp, States, 1);
    with cbLayers.Canvas do
    begin
      FillRect(Rect);
      if not (lsLayerOn in States) or (lsFreeze in States) or
         (lsLock in States) or not (lsPlottable in States) then Font.Color:= clGrayText;
      if Index >= 0 then
        TextOut(Rect.Left + 2, Rect.Top + 1, cbLayers.Items[Index]);
    end;
  end;
end;

Проверить существование слоя:

function LayerExist(const ALayerName: String): Boolean;
var
  AcadDocument: OleVariant;
  i, cnt: Integer;
begin
  Result:= False;
  if not VarIsClear(Acad) then
  begin
    AcadDocument:= Acad.ActiveDocument;
    cnt:= AcadDocument.Layers.Count;
    for i:= 0 to cnt - 1 do
    begin
      if AcadDocument.Layers.Item(i).Name = ALayerName then
      begin
        Result:= True;
        Break;
      end;
    end;
  end;
end;

Создать новый слой:

Acad.ActiveDocument.Layers.Add('NewLayer');

Здесь все аналогично как для слоев, поэтому остановлюсь только на отличиях. Функция получения списка всех текстовых стилей активного документа:

function EnumAutoCADTextStyles(Items: TStrings): Integer;
var
  AcadDocument: OleVariant;
  ActiveStyleName, StyleName: String;
  i, StylesCount: Integer;
begin
  Result:= -1;
  if not VarIsClear(Acad) then
  begin
    AcadDocument:= Acad.ActiveDocument;
    with Items do
    begin
      BeginUpdate;
      try
        Clear;
        ActiveStyleName:= AcadDocument.ActiveTextStyle.Name;
        StylesCount:= AcadDocument.TextStyles.Count;
        for i:= 0 to StylesCount - 1 do
        begin
          StyleName:= AcadDocument.TextStyles.Item(i).Name;
          Add(StyleName);
          if AnsiCompareText(StyleName, ActiveStyleName) = 0 then
            Result:= i;
        end;
      finally
        EndUpdate;
      end;
    end;
  end;
end;

Для добавления нового типа линии в документ не используется метод Add:

Acad.ActiveDocument.Linetypes.Add('DASHED');

Такой код просто добавит новый тип линии с шаблоном Continuous. Чтобы действительно добавить штриховую линию необходимо использовать метод Load:

procedure Load(const Name: WideString; const FileName: WideString);

Параметры: Name — имя шаблона; FileName — имя файла шаблонов линий, из которого указанный шаблон должен быть загружен. Пример использования:

Acad.ActiveDocument.Linetypes.Load('DASHED', 'acad.lin');

К статье прилагаются примеры на Delphi 7.

Внимание! Запрещается воспроизведение данной статьи или ее части без согласования с автором. Если вы желаете разместить эту статью на своем сайте или издать в печатном виде, свяжитесь с автором.
Автор статьи: Вершинин И.В.