- Код: Выделить всё
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
ComObj, Dialogs, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure CatTree(CatObj : Variant);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Catia, Products: Variant;
Level: array[1..20] of integer; //массив уровней вложенности 20 - думаю хватит, но желающие могут поставить более
CurrentLevel: Integer;
implementation
{$R *.dfm}
function Spcs(Lg: Integer): string; // функция добавляет пробелы в строку
begin
Result := '';
while Length(Result) < Lg do
Result := ' ' + Result;
end;
procedure Tform1.CatTree(CatObj : Variant);
var
i: integer;
str: string;
begin
for i:=level[CurrentLevel] to CatObj.Count do begin
str := CatObj.Item(i).ReferenceProduct.Parent.Name; // полный путь CatObj.Item(i).ReferenceProduct.Parent.FullName;
memo1.Lines.Add(Spcs(10*CurrentLevel) + str);
if pos('.CATPRODUCT',AnsiUpperCase(str)) <> 0 then begin // если сборка, то ....
level[Currentlevel] := i; //save position
inc(CurrentLevel);
CatTree(CatObj.Item(i).Products);
end;
end;
level[CurrentLevel]:= 1;
dec(CurrentLevel);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
str: string;
begin
try
// Create Word Instance
Catia := CreateOleObject('Catia.Application'); //Запускаем Катю.
except
ShowMessage('Cannot start Catia.');
Screen.Cursor := crDefault;
Exit;
end;
OpenDialog1.Filter := 'Catia product files (*.CATProduct)|*.CATProduct|All files (*.*)|*.*'; // Открываем файл сборки
if OpenDialog1.Execute then
Catia.Documents.Open(Opendialog1.FileName);
Catia.Visible := True ;
Products := CATIA.ActiveDocument.Product.Products;
CurrentLevel := 1;
for i := 1 to 20 do // Значение уровней вложенности в 1
level[i] := 1;
CatTree(Products);
end;
end.
Может немного коряво, но работает.
