Получение текущего чертежа из AutoCAD в формате DXF

Delphi , Графика и Игры , Картография

Автор: Dimka Maslov
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> 
Функция импортирует активного чертёж из AutoCAD в формате DXF
и записывает полученные данные в список List. В случае успешного
завершения функция возвращает True. В случае ошибки (AutoCAD не
загружен, cбой OLE и проч.) функция возвращает False не внося
изменений в список строк

Зависимости: Windows, SysUtils, ComObj, ActiveX
Автор:       Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright:   Dimka Maslov
Дата:        22 ноября 2002 г.
***************************************************** }

function GetAcadDXFText(List: TStrings): Boolean;
var
  TempDir, FileName: string;
  ClassID: TGUID;
  Unknown: IUnknown;
  Dispatch: IDispatch;
  App, Doc, Sel: Variant;
  TempList: TStringList;
const
  Ext = 'dxf';
  DotExt = '.' + Ext;
begin
  SetLength(TempDir, MAX_PATH);
  GetTempPath(MAX_PATH, PChar(TempDir));
  SetLength(TempDir, StrLen(@TempDir[1]));
  TempDir := IncludeTrailingBackslash(TempDir);
  repeat
    FileName := TempDir + IntToHex(LoWord(GetTickCount), 4) + DotExt;
  until not FileExists(FileName);
  SetLength(FileName, Length(FileName) - Length(DotExt));
  Result := True;
  try
    ClassID := ProgIDToClassID('AutoCAD.Application');
    if not Succeeded(GetActiveObject(ClassID, nil, Unknown)) then
      Abort;
    Unknown.QueryInterface(IDispatch, Dispatch);
    App := Dispatch;
    try
      Doc := App.ActiveDocument;
      try
        Sel := Doc.SelectionSets.Add('TEMP');
        try
          Doc.Export(FileName, Ext, Sel);
        finally
          Sel := Unassigned;
        end;
      finally
        Doc := Unassigned;
      end;
    finally
      App := Unassigned;
    end;
    FileName := FileName + DotExt;
    TempList := TStringList.Create;
    try
      TempList.LoadFromFile(FileName);
      List.Assign(TempList);
    finally
      TempList.Free;
    end;
  except
    Result := False;
  end;
  if FileExists(FileName) then
    DeleteFile(FileName);
end;

// Пример использования:
if not GetAcadDXFText(Memo1.Lines) then
  ShowMessage('Невозможно получить данные от AutoCAD');

Эта функция Delphi импортирует текущее рисунок из AutoCAD в формате DXF и хранит его в TStringList. Функция использует COM-объекты для взаимодействия с AutoCAD.

Вот шаг за шагом, что код делает:

1. Он генерирует временное имя файла и директории с помощью GetTempPath и IntToHex.
2. Он настраивает COM-объекты для AutoCAD, получая экземпляр приложения и его активного документа.
3. Он выбирает все сущности в рисунке с помощью SelectionSets.Add, а затем экспортирует выбранные сущности в файл DXF с помощью Export.
4. Функция читает экспортированный файл DXF в TStringList с помощью LoadFromFile.
5. Если операция выполнена успешно, функция присваивает TStringList параметру List.
6. Если возникает ошибка при любом из этих шагов, функция возвращает False.

Пример использования показывает, как вызывать эту функцию и отображать сообщение об ошибке, если она fails.

Некоторые примечания к коду:

• Функция ProgIDToClassID не является стандартной функцией Delphi, поэтому вам нужно реализовать или использовать третьепартийную библиотеку, которая предоставляет эту функциональность.
• Функция GetActiveObject возвращает COM-объект, представляющий собой текущее активное приложение AutoCAD. Если такого приложения не существует, она вернет ошибку.
• Метод QueryInterface используется для преобразования интерфейса IUnknown в интерфейс IDispatch, который можно использовать для вызова методов на объекте AutoCAD.

В целом, этот код предоставляет удобный способ извлечь данные из рисунка AutoCAD в формате DXF с помощью Delphi.

Получение текущего чертежа из AutoCAD в формате DXF - функция импортирует активный чертёж из AutoCAD и записывает полученные данные в список List.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Картография ::