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

Previous  Top  Next

    
 

 

Code:

{ **** UBPFD *********** by kladovka.net.ru ****

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

 

Функция импортирует активного чертёж из 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;

 

 

 

 

Пример использования:

Code:

if not GetAcadDXFText(Memo1.Lines) then

ShowMessage('Невозможно получить данные от AutoCAD');

 

 

©Drkb::04479