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

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

{ **** UBPFD *********** by kladovka.net.ru ****
>>
Функция импортирует активного чертёж из AutoCAD в формате DXF и записывает полученные данные в список List. В случае успешного завершения функция возвращает True. В случае ошибки (AutoCAD не загружен, cбой OLE и проч.) функция возвращает False не внося изменений в список строк
Зависимости: Windows, SysUtils, ComObj, ActiveX
Автор: Dimka Maslov, <a href="mailto:mainbox@endimus.ru">mainbox@endimus.ru</a>, 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');

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...