• Alexys
  • Восстановленный участник
  • На форуме с 11 августа 2006г.
  • Сообщений: 63
  • Спасибо: 0

Тема: Как понять какие примитивы на листе ?

Как провести сканирование листа на предмет нахождения примитивов определенных типов ?

  • Виктор
  • Восстановленный участник
  • На форуме с 11 октября 2006г.
  • Сообщений: 16
  • Спасибо: 0

Re: Как понять какие примитивы на листе ?

Пример модуля, который ищет в открытом документе на листе или в модели примитив типа БЛОК по имени "ОсновнойШтамт", и получает координаты точки вставки этого блока.

unit UnitToACAD;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComObj, StdCtrls, ExtCtrls, ComCtrls;
type
  TFormToACAD = class(TForm)
    Label2: TLabel;
    Label1: TLabel;
    Button1: TButton;
    ProgressBar1: TProgressBar;
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  FormToACAD: TFormToACAD;
implementation
uses UnitDM;
{$R *.DFM}
const
{ AcWindowState }
  acNorm = 1;
  acMin = 2;
  acMax = 3;
{ AcActiveSpace }
  acPaperSpace = 0;
  acModelSpace = 1;
var
  Acad, Document, Model, P2, RefVal : OLEVariant;
  ShapName, Sh  : string;
  Baza : TPoint;
procedure TFormToACAD.FormActivate(Sender: TObject);
var i : integer;
begin
  Button1.Hide;
  P2 := VarArrayCreate([0,2], varDouble);
  try
    Acad := GetActiveOleObject('Autocad.Application');
    Acad.WindowState := acMin;
    Document := Acad.ActiveDocument;
    Document.Activate;
    if Document.ActiveSpace = acModelSpace then
      Model := Document.ModelSpace
    else
      Model := Document.PaperSpace;
    i:=Model.Count-1;
    Sh := '';
    ProgressBar1.Max := i;
    ProgressBar1.Position := i;
    Label1.Caption := 'Просмотр чертежа '+intToStr(ProgressBar1.Max) + ' объектов.';
    Update;
    ProgressBar1.Show;
    repeat
      RefVal := Model.Item(i);
[b]
// Получаем имя типа примитива !
      ShapName := RefVal.ObjectName;[/b]
      if (ShapName = 'AcDbBlockReference') then
      begin
        Sh := RefVal.EffectiveName;
        if (Sh = 'ОсновнойШтамп') then
        begin
          P2 := RefVal.InsertionPoint;
          Baza.x := P2[0];
          Baza.y := P2[1];
        end;
      end;
      Dec(i);
      ProgressBar1.Position := i;
    until (Sh = 'ОсновнойШтамп')or(i=-1);
    ProgressBar1.Hide;
    if Sh = 'ОсновнойШтамп' then
    begin
      // Делаю что мне нужно...
    end
    else
      Label1.Caption:='Блок "ОсновнойШтам" не найден!';
    Acad.Visible := true;
    Acad.ZoomAll;
    Acad.Update;
    Acad.WindowState := acMax;
    Application.MessageBox(PChar('Готово !'), PChar(''), mb_Ok + mb_SystemModal);
    Button1.Show;
  except
  end;
end;
procedure TFormToACAD.Button1Click(Sender: TObject);
begin
  Close;
end;
end.