Отрисовка мышью

[grigorij_evd]

Здравствуйте!
Возможности компонента CadImportVcl очень обширны (фактически Autocad), меня интересует возможность отрисовки примитивов в векторе, посмотрев демо проекты и на форуме я ненашёл примера отрисовки с помощью мыши например полилинии.
Сама процедура есть:

procedure TForm1.AddPolyline;
var
vDXFPolyline: TsgDXFPolyline;
Vertex1, Vertex2, Vertex3,
Vertex4,Vertex5: TsgDXFVertex;
begin
vDXFPolyline := TsgDXFPolyline.Create;
Vertex1 := TsgDXFVertex.Create;
Vertex1.Point := MakeFPoint(2557.2986,7634.2927, 0);
Vertex2 := TsgDXFVertex.Create;
Vertex2.Point := MakeFPoint(3494.3864,5601.7834, 0);
Vertex3 := TsgDXFVertex.Create;
Vertex3.Point := MakeFPoint(3878.8370,4762.6997, 0);
Vertex4 := TsgDXFVertex.Create;
Vertex4.Point := MakeFPoint(4156.7637,4156.2417, 0);
Vertex5 := TsgDXFVertex.Create;
Vertex5.Point := MakeFPoint(4266.1282,4204.5740, 0);
vDXFPolyline.AddEntity(Vertex1);
vDXFPolyline.AddEntity(Vertex2);
vDXFPolyline.AddEntity(Vertex3);
vDXFPolyline.AddEntity(Vertex4);
vDXFPolyline.Color := clBlue;
vDXFPolyline.SetLWeight(100);
Img := TsgCADImage(DNavigator.Picture.Graphic);
Img.Create;
Img.Converter.OnCreate(vDXFPolyline);
Img.Converter.Loads(vDXFPolyline);
Img.CurrentLayout.AddEntity(vDXFPolyline);
FLastAdded := vDXFPolyline;
Img.RefreshCurrentLayout;
Img.GetExtents;
end;
Но в этой процедуре определённое количество вершин, а есть ли возможность динамического создания вершины по клику мыши (например запись в массив X и Y в Stringgrid) и по нажатию правой кнопки мыши отрисовка полилинии (или иного примитива)?
Например:
procedure TForm1.DNAvigatorMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
X1,Y1,vUnits: string;
X2,Y2,R:Extended;

begin

if Button=MbLeft then
begin
vPt := DNavigator.GetDrawingCoords(X, Y, vUnits);
StringGrid1.RowCount:=StringGrid1.RowCount+1;

StringGrid1.Rows[StringGrid1.RowCount-2].Strings[0]:=FloatToStr(vPt.X);
StringGrid1.Rows[StringGrid1.RowCount-2].Strings[1]:=FloatToStr(vPt.Y);
end;


if Button=MbRight then
begin
I:=StringGrid1.RowCount-1;//количество вершин полилинии
//addpolyline отрисовка

end;
Приведите пожалуйста пример на основе моего кода, если это возможно.
Григорий.

[Mikhail Zhilin]

Здравствуйте, Григорий!

Вот пример кода, демонстрирующий динамическое создание вершин полилинии по клику мыши и отрисовку по нажатию правой кнопки мыши:

Code: Select all

type
  TForm1 = class(TForm)
    ...
  private
    FDNavigator: TsgDrawingNavigator;
    procedure DNavigatorMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    ...
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Img: TsgCADImage;
  AddEntity: Boolean;
  vDXFPolyline: TsgDXFPolyline;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  AddEntity := False;
  StringGrid1.Cells[0,0] := 'X';
  StringGrid1.Cells[1,0] := 'Y';
  ...
  FDNavigator.OnMouseDown := DNavigatorMouseDown;
end;

...

procedure TForm1.DNavigatorMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  I: Integer;
  Vertex: TsgDXFVertex;
  vPt: TFPoint;
  vUnits: string;
begin
  if (FDNavigator.Picture.Graphic = nil) then
    Exit;
  if AddEntity then
  begin
    if Button = mbLeft then
    begin
      vPt := FDNavigator.GetDrawingCoords(X, Y, vUnits);
      Vertex := TsgDXFVertex.Create;
      Vertex.Point := vPt;
      vDXFPolyline.AddEntity(Vertex);
      StringGrid1.RowCount := StringGrid1.RowCount + 1;
      StringGrid1.Rows[StringGrid1.RowCount-2].Strings[0]:=FloatToStr(vPt.X);
      StringGrid1.Rows[StringGrid1.RowCount-2].Strings[1]:=FloatToStr(vPt.Y);
    end;

    if Button = mbRight then
    begin
      vDXFPolyline.Color := clBlue;
      vDXFPolyline.SetLWeight(100);
      Img := TsgCADImage(FDNavigator.Picture.Graphic);
      Img.Converter.OnCreate(vDXFPolyline);
      Img.Converter.Loads(vDXFPolyline);
      Img.CurrentLayout.AddEntity(vDXFPolyline);
      Img.RefreshCurrentLayout;
      Img.GetExtents;
      AddEntity := False;
      StringGrid1.RowCount := 2;
      For I := 1 to StringGrid1.RowCount - 1 do
        StringGrid1.Rows[I].Clear;
    end;
  end
  else
    AddEntity := False;
end;

...

// Вызов команды добавления полилинии из меню
procedure TForm1.miPolylineClick(Sender: TObject);
begin
  AddEntity := True；
  vDXFPolyline := TsgDXFPolyline.Create;
end;

Михаил.

[grigorij_evd]

Благодарю Вас за исчерпывающий ответ!
Но появился основной вопрос.
Есть ли возможность сохранения нанесённого примитива в файл dwg-dxf в процессе работы, интересует сама реализация и его "сложность" или "простота" (на примере приведённого вами кода по отрисовке полилинии).
И нужен ли компонент CADExportVCL_demo, (если он необходим для решения данной задачи).
Если необходим вышлите пожалуйста демонстрационную версию для делфи 7 и приведите пожалуйста пример кода по вышеуказанному вопросу.
С Уважением Григорий.

[support]

Здравствуйте Григорий.
CAD Import VCL не позволяет выполнять экспорт в векторные форматы. Для этого может быть использована библиотека CAD Export VCL. Проект CADExportDemo показывает возможности библиотеки для создания и сохранения чертежа. Кроме того проект Viewer также задействует компонент экспорта. Код для экспорта довольно простой:

Code: Select all

    vExpCADfile := TsgCADtoDXF.Create(Img);
    vExpCADfile.SaveToFile(FileName);
    vExpCADfile.Free;

В последней релиз версии библиотеки отсутствует возможность экспорта в DWG. Однако мы выполнили разработку данного функционала. В настоящее время экспорт в DWG есть в бета версии библиотеки. Планируется выпуск в версии 9.1. Пожалуйста сообщите нам если вам нужна бета версия.

Александр.

[grigorij_evd]

Если есть возможность, вышлите бета версию, и вопрос:
вставка блока из файла dxf/dwg в чертёж dwg или dxf, как в автокаде из внешнего файла и его реализация на примере.
Григорий.

[support]

Здравствуйте Григорий.
Бета версию вышлем в ближайшее время.
CAD Import VCL позволяет добавлять на чертёж внешние ссылки (XREF). Для этого может быть использована функция TsgCADImage.AddScaledDXF либо TsgCADImage.AddScaledDXFEx. Пример использования функции есть в демо проекте "TextChange_Color2LineWeight_MergeFiles".
Пожалуйста обратите внимание, CAD Import VCL позволяет добавлять внешние ссылки DWG и DXF файлов, однако в Автокаде поддерживаются только внешние ссылки DWG.

Александр.

[grigorij_evd]

Хочу попробовать функцию выделение объекта(ов). При загрузке файла ошибка, вот код:

private
FManager: TsgSelectionManager;
public
FBlockLibrary:TsgBlockLibrary;
procedure OnSelectionChange;

procedure TForm1.OnSelectionChange;
begin
MessageBox(Self.Handle, 'Selection is changed!!!', 'Information', 0);
end;

procedure TForm1.FMSChange(var Message: TMessage);
begin
OnSelectionChange;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.WindowState:= wsMaximized;
DNavigator := TsgDrawingNavigator.Create(Self);
DNavigator.Parent := ScrollBox1;
DNavigator.AutoFocus := True;
DNavigator.RectZooming := True;
DNavigator.OnMouseMove := DNavigatorMouseMove;
DNavigator.Color:=clWhite;

DNavigator.OnMouseDown:=DNavigatorMouseDown;
DNavigator.DoubleBuffered:=True;
//
FManager := TsgSelectionManager.Create;
FBlockLibrary := TsgBlocklibrary.Create;
FManager.Mode := mmSelect;

end;

procedure TForm1.LoadPlata;
var
Plata:String;
vScale:Double;
begin
FManager.DeselectAll;
Plata:=ExtractFileDir(Application.ExeName)+'plata.dxf';
DNavigator.Picture.Graphic := nil;
DNavigator.BeginUpdate;
DNavigator.LoadFromFile(Plata);// загружает нормально

FManager.DNavigator := DNavigator;// ошибка тут!!!!!!!!!!!!!!
FBlockLibrary.DNavigator := DNavigator;

выскакивает исключение, причём код брал из Editor (8 версии), но самое главное не сохраняет в dwg вот код:

procedure TForm1.Button1Click(Sender: TObject);
var
vExp: TsgCADExport;
Cad:TsgCADtoDWG;
begin
Img:= TsgCADImage.Create;
Cad:=TsgCADtoDWG.Create(Img);
Cad.SaveToFile('c:\plata.dwg');// здесь ошибка, хотя компилируется и запускается
Cad.Free;
end;
Григорий

[support]

Здравствуйте Григорий.
Из приведённого вами кода причина проблемы не ясна. Возможно ошибка связана с определением DNavigator на форме, которого вы не привели. В демо примере Editor используется приватное поле и публичное свойство, обеспечивающее доступ к этому полю. Можете прислать ваш проект на support@cadsofttools.com, проверим в отладчике.
Добавьте в тестовый код экспорта инициализацию конвертера для объекта TsgCADImage:

Code: Select all

Img:= TsgCADImage.Create();
Img.Converter.InitializeSections();

Александр.

[grigorij_evd]

Здравствуйте Александр!
По поводу вставки Вы приводили код:
var
xref: TsgDWGImage;
begin
if not (DNavigator.Picture.Graphic is TsgCADImage) then
Exit;
Img := TsgCADImage(DNavigator.Picture.Graphic);
xref := TsgDWGImage.Create();
xref.IsWithoutBorder := true;
xref.LoadFromFile('colors.dwg');//это я так понимаю то что мы вставляем?
Img.AddScaledDXF(xref, 'colors.dwg', MakeFPoint(100, 100, 0), MakeFPoint(1, 1, 1), 0);//а это на чертёж (который открыт)?
Img.GetExtents();
DNavigator.Invalidate();
end;
И как после того как мы выделили объект примитив, получить в цикле список вершин?
Григорий.

[support]

Здравствуйте Григорий.

xref.LoadFromFile('colors.dwg');//это я так понимаю то что мы вставляем?
Img.AddScaledDXF(xref, 'colors.dwg', MakeFPoint(100, 100, 0), MakeFPoint(1, 1, 1), 0);//а это на чертёж (который открыт)?

Вы правы, xref в примере - это чертёж который будет добавлен в виде внешней ссылки. Img - это чертёж, на который будет добавлена внешняя ссылка. Открыты (импортированы) при этом оба чертежа. Img в примере реализован как доступ к содержимому графического просмотрщика (DNavigator.Picture.Graphic). Однако вместо этого можно использовать код аналогичный импорту xref.
Для выбранного примитива можно получить набор свойств в зависимости от его типа. Например, список вершин полилинии содержится в TsgDXFPolyline.Vertexes. Описание поддерживаемых примитивов и их свойств приведено в документации.

Александр.

[grigorij_evd]

procedure TForm1.AddPolyline;
var
vDXFPolyline: TsgDXFPolyline;
Vertex: TsgDXFVertex;
I:Integer;
begin
for I:=0 to StringGrid1.RowCount-1 do
begin
vDXFPolyline := TsgDXFPolyline.Create;
Vertex := TsgDXFVertex.Create;
Vertex.Point := MakeFPoint(StrToFloat(StringGrid1.Cells[1,0]),StrToFloat(StringGrid1.Cells[0,1]), 0);
vDXFPolyline.AddEntity(Vertex);
vDXFPolyline.Color := clRed;
vDXFPolyline.SetLWeight(100);
Img := TsgCADImage(DNavigator.Picture.Graphic);
Img.Create;
Img.Converter.OnCreate(vDXFPolyline);
Img.Converter.Loads(vDXFPolyline);
Img.CurrentLayout.AddEntity(vDXFPolyline);
//FLastAdded := vDXFPolyline;
Img.RefreshCurrentLayout;
Img.GetExtents;
end;
end;
///////////////////////////////////////////////////
procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.Rows[0].Strings[0]:='1982.12';//абстрактные числа
StringGrid1.Rows[1].Strings[0]:='1582.12';
StringGrid1.Rows[2].Strings[0]:='1962.12';
StringGrid1.Rows[3].Strings[0]:='1782.12';
StringGrid1.Rows[4].Strings[0]:='1952.12';
StringGrid1.Rows[5].Strings[0]:='1482.12';
StringGrid1.Rows[6].Strings[0]:='182.12';
StringGrid1.Rows[7].Strings[0]:='1582.12';
StringGrid1.Rows[8].Strings[0]:='1962.12';
///
StringGrid1.Cells[1,0]:='12352.12';
StringGrid1.Cells[1,1]:='432.43';
StringGrid1.Cells[1,2]:='456.45';
StringGrid1.Cells[1,3]:='5433.43';
StringGrid1.Cells[1,4]:='76.344'

fmDeveloperIDE := TfmDeveloperIDE.Create(Self);
FDNavigator := TsgDrawingNavigator.Create(Self);
FDNavigator.Parent := ScrollBox1;
FDNavigator.AutoFocus := True;
FDNavigator.RectZooming := True;
FDNavigator.OnMouseMove := DNMouseMove;
TsgDrawingNavigatorAccess(FDNavigator).OnKeyDown := DNKeyDown;
FManager := TsgSelectionManager.Create;
FBlockLibrary := TsgBlocklibrary.Create;
FManager.Mode := mmSelect;
{$IFDEF SGDEL_4}
{$ENDIF}
end;

и ничего не отрисовывается
Григорий

[support]

Здравствуте Григорий.

Vertex.Point := MakeFPoint(StrToFloat(StringGrid1.Cells[1,0]),StrToFloat(StringGrid1.Cells[0,1]), 0);

В каждой итерации цикла будет создаваться Vertex с одинаковым положением. Кроме того в вашем коде не приведено значение StringGrid1.Cells[0,1]. Также не нужно в цикле устанавливать параметры полилинии, создавать новый TsgCADImage объект (его вообще здесь не нужно создавать), добавлять полилинию на чертёж и пересчитывать размеры чертежа. Эти операции выполняются однократно (кроме Img.Create - создавать новый чертёж не нужно!).

Александр.

[grigorij_evd]

Здравствуйте, каким образом можно у выделенного примитива перемещать отдельную вершину
>>Вы писали:
Например, список вершин полилинии содержится в TsgDXFPolyline.Vertexes. Описание поддерживаемых примитивов и их свойств приведено в документации.
>>
в документации примера не нашёл.
Григорий

[support]

Здравствуйте Григорий.
В документации приведены описания примитивов и их свойств для реализации работы с примитивами. Пример кода изменения первой вершины полилинии чертежа:

Code: Select all

var
  mVertex: TsgDXFVertex;
  mPolyline: TsgDXFPolyline;
  I: Integer;

begin
  for I := 0 to Img.CurrentLayout.Count - 1 do
  begin
    if Img.CurrentLayout.Entities[I].EntType = cePolyline then
    begin
      mPolyline := TsgDXFPolyLine(Img.CurrentLayout.Entities[I]);
      mVertex := TsgDXFVertex.Create();
      mVertex.Point := MakeFPoint(1, 1, 0);
      mPolyline.DeleteEntity(0);
      mPolyline.InsertEntity(0, mVertex);
      Img.Converter.Loads(mPolyline);
      break;
    end;
  end;
  Img.GetExtents();
end; 

Александр.

[grigorij_evd]

Александр спасибо за ответ, но необходимо именно перемещать вершину примитива (полилинии) мышью после её выделения.
Григорий.