Проблема с работой в потоке при обращении к элементу другой программы (АвтоКАДа)

[Ship_1]

Здравствуйте!
Пытаюсь сделать в Дельфи (D7) программу, которая в потоке будет менять цвет объекта из АвтоКАДа (мигать).
Проблема возникла вот какая: почему-то функция смены цвета работает в Create потока, а в Execute любое обращение к АвтоКАДу вызывает проблемы (всё зависает разными способами).
Перепробовал несколько разных вариантов, остановился на этой реализации:

type
  TACTF = record
    excolot: Integer;  // цвет объекта
    Ent: IAcadEntity;  // объекта в АвтоКАДе (интерфейс)
    Handl: string;  // Хендл (идентификатор) объекта в АвтоКАДе
  end;
  TOneMoreThread=class(TThread)
  private
    AcadApp: IAcadApplication;  // Интерфейс самого АвтоКАДа
  protected
    procedure execute; override;
  public
    ArrObj: array of TACTF;
    constructor Create(HandStr:TStringList);
    destructor Destroy; override;
  end;
  ...
  TForm1
    ...  
  private
    OneMoreThread:TOneMoreThread;
    HandStrs: TStringList;   // Список хендлов объектов, забираемых из StringGrid

    ...
  
 Procedure SetEntColor(HandNom: integer; Col: integer);
var
  Ent: IAcadEntity;
begin
  Ent:=(Form1.AcadApp.ActiveDocument.HandleToObject(Form1.HandStrs[HandNom]) as IAcadEntity);
  Ent.color:=Col;
  Ent.Update;
end;

procedure TOneMoreThread.execute;
var
  i, Nom:Integer;
begin
  inherited;
  Nom:=0;
//  While not terminated do
//  begin
    inc(Nom);
    Form1.Caption:=IntToStr(Nom)+' st'+ArrObj[0].Handl;
    SetEntColor(0,acRed);  //  даже такая реализация не работает: глюков не происходил, но до Form1.Caption:=IntToStr(Nom)+' ch' так и не доходит
    For i:=0 to Length(ArrObj)-1 do
    begin
//      ArrObj[i].Ent.color:=acRed;  
//      ArrObj[i].Ent.Highlight(True);
    end;
    Form1.Caption:=IntToStr(Nom)+' ch';
    Sleep(1000);
    Form1.Caption:=IntToStr(Nom)+' sch';
//    SetEntColor(ArrObj[0].Ent,ArrObj[i].excolot);
    For i:=0 to Length(ArrObj)-1 do
    begin
//      ArrObj[i].Ent.color:=ArrObj[i].excolot;
//      ArrObj[i].Ent.Highlight(False);
    end;
    Form1.Caption:=IntToStr(Nom)+' en'+ArrObj[1].Handl;
    Sleep(2000);
//  end;
end;

constructor TOneMoreThread.Create(HandStr:TStringList);
var
  i: integer;
begin
  inherited Create(True); (*Поток создаем в состоянии «Приостановлен»*)
  AcadApp:= GetAcadApplication(true);
  SetLength(ArrObj,HandStr.Count);
  If HandStr.Count>0 then
  begin
    for i:=0 to Length(ArrObj)-1 do
    begin
      ArrObj[i].Ent:=(AcadApp.ActiveDocument.HandleToObject(HandStr[i]) as IAcadEntity);
//      SetEntColor(ArrObj[i].Ent,acRed);   // <------------  В этом месте изменение цвета работает!
//      ArrObj[i].Ent.Update;

      ArrObj[i].excolot:=ArrObj[i].Ent.color;
      ArrObj[i].Handl:=ArrObj[i].Ent.Handle;
    end;
  end;
  FreeOnTerminate := True; (* Поток освободит ресурсы при окончании работы*)
  Self.Priority := tpNormal;
  resume;
end;

destructor TOneMoreThread.Destroy;
begin
  AcadApp:= nil;
  SetLength(ArrObj,0);
  inherited Destroy;
end;


procedure TForm1.Button15Click(Sender: TObject);
var
  NCol,i:Integer;
begin
  NCol:=StringGrid1.Selection.Left;
  If NCol=1 then NCol:=2; If NCol=3 then NCol:=4; If NCol=5 then NCol:=6;
  HandStrs:=TStringList.Create;
  For i:=StringGrid1.Selection.Top to StringGrid1.Selection.Bottom do
    if StringGrid1.Cells[NCol,i]<>'' then
      HandStrs.Add(StringGrid1.Cells[NCol,i]);
  OneMoreThread:=TOneMoreThread.Create(HandStrs);
end;

procedure TForm1.Button16Click(Sender: TObject);
begin
  OneMoreThread.Terminate;
  HandStrs.Free;
end;

[evg_m]

1. Execute и Create работают с РАЗНЫМИ объектами Acad-a.
Create устанавливает свое

  AcadApp:= GetAcadApplication(true);

а Execute зачем-то работает через форму

SetEntColor(0,acRed); // даже такая реализация не работает: глюков не происходил, но до Form1.Caption:=IntToStr(Nom)+' ch' так и не доходит

Ent:=(Form1.AcadApp.ActiveDocument.HandleToObj ect(Form1.HandStrs[HandNom]) as IAcadEntity);

А давно и много раз повторено работа c VCL в потоках должна быть в обертке Synchonize!!!
форма это VCL объект.

и ничего не известно про

Form1.AcadApp

в приведенном коде НЕТ его задания.
А это совсем ДРУГАЯ переменная(и объект) нежели поле потока

TOneMoreThread=class(TThread)
private
AcadApp: IAcadApplication; // Интерфейс самого АвтоКАДа

которым ты пользуешься в Create.

[Ship_1]

Сообщение от evg_m

1. Execute и Create работают с РАЗНЫМИ объектами Acad-a.
Create устанавливает свое

  AcadApp:= GetAcadApplication(true);

а Execute зачем-то работает через форму

Сообщение от evg_m

А давно и много раз повторено работа c VCL в потоках должна быть в обертке Synchonize!!!

А с интерфейсами? Обращение к форме было последней попыткой хоть как-то заставить работать Execute. До этого пытался всё обращение к AcadApp делать внутри потока. Но даже перенеся в Execute

AcadApp:= GetAcadApplication(true);

получил только глюк: ещё до первого изменения заголовка формы произошло что-то, напоминающее разворачивание прозрачной формы на весь экран, и всё на экране стало недоступным (как будто форма развернула прозрачное стекло на весь экран).

AcadApp формы работает без перебоев, определяется так же, как и в потоке, но при нажатии отдельной кнопки.

[Ship_1]

Что-то никто как-то ничего... Ну я пока покопался немного и всё-таки добился мигания. Сейчас у меня это выглядит так:

type
  TACTF = record
    excolot: Integer;
    Ent: IAcadEntity;
    Handl: string;
  end;
  TOneMoreThread=class(TThread)
  private
    AcadApp: IAcadApplication;
    procedure Colorized;
    Procedure SetEntColor(HandNom: integer; Col: integer);
  protected
    procedure execute; override;
  public
    ArrObj: array of TACTF;
    constructor Create(HandStr:TStringList);
    destructor Destroy; override;
  end;
...
...
Procedure TOneMoreThread.SetEntColor(HandNom: integer; Col: integer);
var
  Ent: IAcadEntity;
begin
  Ent:=(AcadApp.ActiveDocument.HandleToObject(ArrObj[HandNom].Handl) as IAcadEntity);
  Ent.color:=Col;
  Ent.Update;
end;

procedure TOneMoreThread.Colorized;
var
  i, Nom:Integer;
begin
  Nom:=0;
  While not terminated do
  begin
    inc(Nom);
    For i:=0 to Length(ArrObj)-1 do
    begin
      SetEntColor(i,acRed);
    end;
    Sleep(50);
    For i:=0 to Length(ArrObj)-1 do
    begin
      SetEntColor(i,ArrObj[i].excolot);
    end;
    Sleep(1000);
  end;
end;

procedure TOneMoreThread.execute;
begin
  inherited;
  synchronize(Colorized);
end;

constructor TOneMoreThread.Create(HandStr:TStringList);
var
  i: integer;
begin
  inherited Create(True); (*Поток создаём в состоянии "Приостановлен"*)
  AcadApp:= GetAcadApplication(true);
  SetLength(ArrObj,HandStr.Count);
  If HandStr.Count>0 then
  begin
    for i:=0 to Length(ArrObj)-1 do
    begin
      ArrObj[i].Ent:=(AcadApp.ActiveDocument.HandleToObject(HandStr[i]) as IAcadEntity);
      ArrObj[i].excolot:=ArrObj[i].Ent.color;
      ArrObj[i].Handl:=ArrObj[i].Ent.Handle;
    end;
  end;
  FreeOnTerminate := True; (* Поток освободит ресурсы при окончании работы *)
  Self.Priority := tpNormal;
  resume;
end;

destructor TOneMoreThread.Destroy;
begin
  AcadApp:= nil;
  SetLength(ArrObj,0);
  inherited Destroy;
end;


procedure TForm1.Button15Click(Sender: TObject);
var
  NCol,i:Integer;
begin
  NCol:=StringGrid1.Selection.Left;
  If NCol=1 then NCol:=2; If NCol=3 then NCol:=4; If NCol=5 then NCol:=6;
  HandStrs:=TStringList.Create;
  For i:=StringGrid1.Selection.Top to StringGrid1.Selection.Bottom do
    if StringGrid1.Cells[NCol,i]<>'' then
      HandStrs.Add(StringGrid1.Cells[NCol,i]);
  OneMoreThread:=TOneMoreThread.Create(HandStrs);
end;


procedure TForm1.Button16Click(Sender: TObject);
begin
  OneMoreThread.Terminate;
  HandStrs.Free;
end;

Но проблема вот в чём: форма зависает и больше ничего сделать не даёт (в т.ч. закончить поток через Button16Click). Не пойму почему: вроде, все связи с формой убрал из потока...

[evg_m]

 synchronize(Colorized);

все что вы пытаетесь делать в потоке, на самом вы делаете в ОСНОВНОМ потоке.
synchronize это приостановка потока И ПЕРЕХОД в основной.
вот и получается

форма зависает и больше ничего сделать не даёт

её ресурсы забрал себе поток.

Я же делаю Sleep.
Sleep поскольку он внутри colorized и значит внутри synchronize ТОЖЕ относится к основному потоку.

как минимум надо

while not terminated do begin
   synchronize(... ); // что-то делаем 
   sleep(...); // остановка потока ВНЕ synchronize
end;

или же ПЕРЕНЕСТИ synchronize внутрь colorized и по крайней мере Sleep высвободить из-под synchronize.

[Ship_1]

Получилось вот так:

Procedure TOneMoreThread.SetColorBlock;
var
  i:Integer;
begin
    For i:=0 to Length(ArrObj)-1 do
    begin
      SetEntColor(i,acRed);
    end;
end;

Procedure TOneMoreThread.ClearColorBlock;
var
  i:Integer;
begin
    For i:=0 to Length(ArrObj)-1 do
    begin
      SetEntColor(i,ArrObj[i].excolot);
    end;
end;

procedure TOneMoreThread.Colorized;
var
  Nom:Integer;
begin
  Nom:=0;
  While not terminated do
  begin
    inc(Nom);
    synchronize(SetColorBlock);
    Sleep(50);
    synchronize(ClearColorBlock);
    Sleep(1000);
  end;
end;

procedure TOneMoreThread.execute;
begin
  inherited;
  Colorized;
end;

Получается, что нельзя для синхронизации делать процедуры с параметрами? Попытался сделать SetColorBlock(color: integer), компилятор мне сказал что-то про то, что это не оверлоад.
И ещё вот такой вопрос: если synchronize использует основной поток, то чьими переменными он пользуется? У меня AcadApp есть и в основном потоке, и в этом. SetEntColor чей AcadApp использует? В предыдущем варианте, когда всё было внутри synchronize, программа не зависала, но и смены цвета не происходило.

[evg_m]

если synchronize использует основной поток, то чьими переменными он пользуется?

всеми которые доступны с т.з. компилятора. (переменная это понятия компилятора, не программы).

правило разрешения имен. Какая "переменная" c таким именем будет использована.
1. локальные имена (в т.ч. параметры процедур).

procedure One;
var
  x: integer;
begin

2.внутренние поля объекта(для процедур-методов)

TmyClass 
  x: string;
  ...
end;

procedure TMyclass.OneX;
begin

3. имена объявленные в ТОМ же unit

var
  x: TDateTime;

procedure Two; 
begin

4. имена объявленные в ДРУГИХ unit подключенных с использованием uses в порядке их перечисления.
в некоторых случаях при наличии одинаковых имен это приводит к проблемам.


все нарушения(коррекции) порядка использования лечатся использованием составных имен
1. добавлением имени модуля

unit5.x :=strtount( unit6.x );

2. добавлением имени объекта

var
  obj1: TmyClass;

procedure XX;
var
  x: integer;
begin
  x:=strtoint(obj1.x);