moving a hatch
Moderators: SDS, support, admin
moving a hatch
Hello to everyone.
I post code to create a hatch in a drawing - after having loaded a dwg under a drawingnavigator.
This code works.
Now I need to programmatically change the position of the hatch, or the shape (size).
For example I want to move just 1 vertex, or maybe move the whole hatch x units to the left.
but for example
vpoly.Points[0].X := vpoly.Points[0].X-30;
does not work, because X is read only
color I can change it, just do vhatch.color:=clNavy; fsgpaintbox.repaint;
How can I do it?
thank you
Alan
I post code to create a hatch in a drawing - after having loaded a dwg under a drawingnavigator.
This code works.
Code: Select all
....
private
FsgPaintBox: TsgDrawingNavigator;
....
public
property sgPaintBox: TsgDrawingNavigator read GetFsgPaintBox;
.........................
procedure TForm1.AddHatchClick(Sender: TObject);
var VHPData: PsgHatchPatternData;
vhatch:tsgcadhatch;
v2dblist: tsg2dboundarylist;
vpoly:tsg2dpolyline;
vlayout:TsgDXFLayout;
begin
vhatch:=tsgcadhatch.Create;
vHatch.HatchName := 'ANSI31';
v2DBList:=vHatch.AddBoundaryList(7);
vPoly := Tsg2DPolyline.Create;
v2DBList.Add(tsg2dpolyline(vPoly));
with vpoly do
begin
Closed := True;
AddVertex(MakeF2DPoint(100,100);
AddVertex(MakeF2DPoint(100,150);
AddVertex(MakeF2DPoint(200,125);
AddVertex(MakeF2DPoint(100,100);
end;
vHatch1.SetColor(clRed);
New(vHPData);
with VHPData do
begin
BaseP := MakeFPoint(0, 0, 0);
Offset := MakeFPoint(-1, 1, 0);
LineAngle := 45.0;
IsDash := False;
Lines := nil;
DashNum := 0;
end;
vHatch.HatchPatternData.Add(vHPData);
with TsgCADImage(FsgPaintBox.Picture.Graphic) do
begin
vlayout:=converter.Layouts[0];
converter.Loads(vhatch);
vlayout.AddEntity(vhatch);
fsgpaintbox.repaint;
end;
end;
For example I want to move just 1 vertex, or maybe move the whole hatch x units to the left.
but for example
vpoly.Points[0].X := vpoly.Points[0].X-30;
does not work, because X is read only
color I can change it, just do vhatch.color:=clNavy; fsgpaintbox.repaint;
How can I do it?
thank you
Alan
Re: moving a hatch
Hello Alan,
You can move or tranform a hatch by changing the coordinates of its boundary. Have a look at the following code:
The ChangeHatchBoundary procedure searches a hatch by its name (e.g. 'ANSI31') and assignes a newly created Tsg2DBoundaryList instance to the hatch boundary list with a specified index (vHatch.BoundaryData[AIndex]). The CreateBoundaryList function creates a boundary list as a single Tsg2DPolyline object from a list of two-dimensional points. Below is an example of using the ChangeHatchBoundary procedure:
Mikhail
You can move or tranform a hatch by changing the coordinates of its boundary. Have a look at the following code:
Code: Select all
uses
..., CADImage, DXFConv, sgLists;
...
function CreateBoundaryList(A2DPointList: TF2DPointList): Tsg2DBoundaryList;
var
I: Integer;
v2DPoly: Tsg2DPolyline;
begin
Result := Tsg2DBoundaryList.Create;
Result.BoundaryType := 7;
v2DPoly := Tsg2DPolyline.Create;
v2DPoly.Closed := True;
for I := 0 to A2DPointList.Count - 1 do
v2DPoly.AddVertex(A2DPointList.Items[I]);
Result.Add(v2DPoly);
end;
procedure ChangeHatchBoundary(ACADImage: TsgCADImage; AHatchName: string; AIndex: Integer; A2DPointList: TF2DPointList);
var
I: Integer;
vHatch: TsgCADHatch;
begin
for I := 0 to ACADImage.Converter.Counts[csEntities] - 1 do
if ACADImage.Converter.Entities[I].EntType = ceHatch then
begin
vHatch := ACADImage.Converter.Entities[I] as TsgCADHatch;
if vHatch.HatchName = AHatchName then
begin
vHatch.BoundaryData[AIndex].AssignBoundary(CreateBoundaryList(A2DPointList));
ACADImage.Converter.Loads(vHatch);
ACADImage.GetExtents;
end;
end;
end;
Code: Select all
uses
..., CADImage, DXFConv, sgConsts, sgLists;
var
vCADImage: TsgCADImage;
v2DPointList: TF2DPointList;
...
v2DPointList := TF2DPointList.Create;
v2DPointList.Add(MakeF2DPoint(100,100));
v2DPointList.Add(MakeF2DPoint(100,150));
v2DPointList.Add(MakeF2DPoint(500,125));
ChangeHatchBoundary(vCADImage, 'ANSI31', 0, v2DPointList);
Technical Support E-mail: support@cadsofttools.com
Chat support on Skype: cadsofttools.support
Chat support on Skype: cadsofttools.support