Получение текущего чертежа из AutoCAD в формате DXF
Falk0ner, вс, 06/07/2008 - 15:35.
Получение текущего чертежа из 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;
>>
Функция импортирует активного чертёж из 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');
ShowMessage('Невозможно получить данные от AutoCAD');
Отправить комментарий