API программа для извлечение параметров

[yoda8989]

Уважаемые! Имеется программа, написанная на Delphi6, которая извлекает и изменяет внешние параметры. Подобные коды программы здесь встречал, но... моя программа написана под тела вращения(в данном случае под вал), а мне нужно её переделать под другую деталь(вилка двойного действия). Заранее буду благодарен. P.S. Чтобы программа извлекла внешние параметры деталь нужно перенести в сборку. Использую версию КОМПАС-3D V10. Деталь не поместилась во вложениях, поэтому кинул её на бесплатный файл-обменник:   http://www65.zippyshare.com/v/57538736/file.html
Извините, если нарушил какие-нибудь правила форума.

Код Выделить Развернуть

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ksTLB, StdCtrls, ComObj, ComCtrls, Grids, Buttons;

const
MasReal: array [0..10] of char = ('0','1','2','3','4','5','6','7','8','9','.');

type
  TVal = class(TForm)
    OpenDialog1: TOpenDialog;
    StringGrid1: TStringGrid;
    BitBtn1: TBitBtn;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    LError: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    Label21: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    Label25: TLabel;
    Label26: TLabel;
    Label27: TLabel;
    Button1: TButton;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure StringGrid1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    AllOk: byte;
    CheckArray: array of byte;
    { Private declarations }
    function CheckReal(str: string): boolean;
  public
    { Public declarations }
  end;

TPartVar=RECORD
  VarName:STRING; // имя переменной
  VarValue:REAL; // значение переменной
  VarNote:STRING; // комментарий к переменной
END;
  TPartVars=ARRAY OF TPartVar;

var
  Val: TVal;
  kompas:KompasObject; // ссылка на API-объект КОМПАС
  Doc:ksDocument3D; // ссылка на текущий документ КОМПАСа
  KompasHandle:THandle; // ссылка на окно программы КОМПАСа
  mas: TPartVars;
  s: TStringList;

implementation

{$R *.dfm}

function GetPartVars(partname:STRING):TPartVars;
var vr:ksVariableCollection;
parts:ksPartCollection;
part:ksPart;
univar:ksVariable;
top,cur,vrr:TTreeNode;
j, numpart:WORD;
begin
parts:=ksPartCollection(doc.PartCollection(true));
// ссылка на деталь с именем partname
part:=ksPart(parts.GetByName(partname,True,True));
// ссылка на список переменных детали
vr:=ksVariableCollection(part.VariableCollection);
// цикл по переменным детали
numpart:=vr.GetCount;
SetLength(result,numpart);

for j:=0 to numpart-1 do
begin
// ссылка на отдельную переменную
univar:=ksVariable(vr.GetByIndex(j));
with result[j] do
begin
VarName:=univar.name;
VarNote:=univar.note;
VarValue:=univar.value
end
end
end;

function StartKompas(filename:string):boolean;
const ka='Kompas.Application.5';
begin
// подключение к КОМПАС 3D
Result:=true;
try
  kompas:=KompasObject(GetActiveOleObject(ka)); // если уже запущен
except
  try
   kompas:=KompasObject(CreateOleObject(ka)); // если не запущен
  except
   result:=false;
   exit;
  end;
end;
// получение ссылки на окно КОМПАС
KompasHandle := kompas.ksGetHWindow;
// делаем окно КОМПАСа видимым
kompas.Visible:=true;
// получение ссылки на текущий документ КОМПАСа
Doc := ksDocument3D(kompas.ActiveDocument3D);
// если такой документ есть...
if Assigned(Doc) then
// то закрываем его
Doc.close;
// создаем новый документ...
Doc := ksDocument3D(kompas.Document3D);
// и загружаем в него сборку с именем filename
Doc.Open(Trim(filename), False);
// активируем API
kompas.ActivateControllerAPI();
end;

procedure ReadParts(s:TStringList);
var i:word;
parts:ksPartCollection;
part:ksPart;
num: integer;
begin
// получение ссылки на список деталей
parts:=ksPartCollection(doc.PartCollection(true));
// число деталей
num:=parts.GetCount;
s.Clear;
// деталь с номером -1 есть сама сборка
s.Add(ksPart(doc.GetPart(-1)).name);
// цикл по деталям
for i := 0 to num-1 do
begin
// получение ссылки на деталь номер i
part:=ksPart(parts.GetByIndex(i));
// помещаем имя детали в список
s.Add(part.name);
end;
end;

PROCEDURE ChangeVar(partname, varname: STRING; value_:REAL);
VAR vr:ksVariableCollection;
parts:ksPartCollection;
part:ksPart;
vvv:ksVariable;
BEGIN
// Список деталей
parts:=ksPartCollection(doc.PartCollection(true));
// Ищем деталь по имени
part:=kspart(parts.GetByName(partname,true,true));
// Список переменных детали
vr:=ksVariableCollection(part.VariableCollection);
// Ищем переменную по имени
vvv:=ksVariable(vr.GetByName(varname,true,true));
// Начинаем редактировать деталь
part.BeginEdit;
// Меняем значение переменной
vvv.value:=value_;
// Обновляем модель
part.Update;
part.RebuildModel;
// Завершаем редактирование детали с сохранением изменений
part.EndEdit(true);
// Обновляем сборку
parts.refresh
END;

procedure TVal.BitBtn1Click(Sender: TObject);
var i: integer;
    part: string;
begin
for i := 0 to StringGrid1.RowCount-1 do
begin
  if (StringGrid1.Cells[1, i] = '') then part := StringGrid1.Cells[0, i] else
   ChangeVar(part, StringGrid1.Cells[0, i], StrToFloat(StringGrid1.Cells[1, i]));
end;
Doc.Save;
s.Free;
end;

function TVal.CheckReal(str: string): boolean;
var i, j: integer;
    z: byte;
begin
Result := TRUE;
for i := 1 to Length(str) do
begin
  z := 1;
  for j := 0 to 10 do
   // proverka, 4to v stroke 4islo
   if (str[i] = MasReal[j]) then
   begin
    z := 0;
    break;
   end;
   // proverka, 4to posle zapyatoj ne bolee 1 znaka
   if (str[i] = '.') then
    if (((Length(str)-i)>1)or(str[i+1] = '.')) then z := 1;
   if (z = 1) then
   begin
    Result := FALSE;
    break;
   end;
  end;
end;

procedure TVal.FormShow(Sender: TObject);
var i,j: integer;
    c: integer;
begin
c := 1;
StringGrid1.RowCount := c;

if (OpenDialog1.Execute) then
  if (FileExists(OpenDialog1.FileName)) then

StartKompas({HAPBAHIE FIJLA}{'C:\Temp\Вал пуансон\Пуансон.a3d'}OpenDialog1.FileName)
  else Application.Terminate;
s := TStringList.Create();
ReadParts(s);
FOR i:=1 TO s.Count-1 DO
begin
  StringGrid1.Cells[0, c-1] := s[i];
  StringGrid1.Cells[1, c-1] := '';
  mas := GetPartVars(s[i]);
  for j := 0 to Length(mas)-1 do
  begin
   inc(c);
   StringGrid1.RowCount := c;
   StringGrid1.Cells[0, c-1] := mas[j].varname;
   StringGrid1.Cells[1, c-1] := FloatToStr(mas[j].varvalue);
//   StringGrid1.Cells[2, c-1] := mas[j].VarNote;
  end;
end;

SetLength(CheckArray, StringGrid1.RowCount);
for i := 0 to Length(CheckArray)-1 do
  CheckArray[i] := 0;
// s.Free;
end;

procedure TVal.FormCreate(Sender: TObject);
begin
AllOk := 0;
end;

procedure TVal.StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String);
begin
if (ACol = 1) then
if not(CheckReal(StringGrid1.Cells[ACol, ARow])) then
begin
  AllOk := 1;
  CheckArray[ARow] := 1;
end else
begin
  AllOk := 0;
  CheckArray[ARow] := 0;
end;
end;

procedure TVal.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
if (ACol = 1) then
if (CheckArray[ARow] = 1) then
with StringGrid1.Canvas do
begin
  Font.Color:= clRed ;
  FillRect(Rect);
  TextOut(Rect.Left, Rect.Top, StringGrid1.Cells[ACol, ARow]);
end else
with StringGrid1.Canvas do
begin
  Font.Color:= clWindowText;
  FillRect(Rect);
  TextOut(Rect.Left, Rect.Top, StringGrid1.Cells[ACol, ARow]);
end;
end;

procedure TVal.StringGrid1Click(Sender: TObject);
var i: integer;
    z: byte;
begin
try
// priem proverki opredelennoj (1) ja4ejki
if ((StrToFloat(StringGrid1.Cells[1,2]))<(StrToFloat(StringGrid1.Cells[1,1])))
  then CheckArray[2] := 1;
except
end;

  // proverka dopyspimosti raboti
  z := 0;
  for i := 0 to Length(CheckArray) 1 do
   if (CheckArray[i] = 1) then
   begin
    z := 1;
    break;
   end;
if (z = 0) then
begin
  BitBtn1.Enabled := TRUE;
  LError.Visible := FALSE;
end else
begin
  BitBtn1.Enabled := FALSE;
  LError.Visible := TRUE;
end;

end;

procedure TVal.Button1Click(Sender: TObject);
begin
Close;
end;

end.

[chelkar]

Не совсем понятен вопрос.
Ваш код читает сборку, находит в ней детальки, в них находит переменные и присваивает им значения.
Ни какой разницы "вал" это или "вилка двойного действия" тут нет.
Главное чтобы тот кто задает значнеия переменных понимал что задавать.
Где-то здесь:
...
// Список переменных детали
vr:=ksVariableCollection(part.VariableCollection);
// Ищем переменную по имени
vvv:=ksVariable(vr.GetByName(varname,true,true));
// Начинаем редактировать деталь
part.BeginEdit;
// Меняем значение переменной
vvv.value:=value_;
// Обновляем модель
part.Update;
part.RebuildModel;
// Завершаем редактирование детали с сохранением изменений
part.EndEdit(true);
// Обновляем сборку
parts.refresh

Попутно.
При изменеии переменных у Part не обязательно делать part.BeginEdit и потом EndEdit.
Теряете время на вход в режим редактирования на месте.
По Update переменные и так поменяются, а RebuildModel перестроит сборку.

[Alexey001]

Здравствуйте. У меня на строке vvv.value:=(D_s-D2)/2; выдает ошибку. В чем проблема?