mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 17:25:39 +02:00
1340 lines
37 KiB
ObjectPascal
1340 lines
37 KiB
ObjectPascal
unit LoadDXF;
|
||
|
||
Interface
|
||
|
||
uses SysUtils, Classes, Windows, Graphics, ComCtrls, Variants, PCTypesUtils,DrawObjects,Menus, DlgBase, ExtDlgs,
|
||
U_Common_Classes, PCLayerDlg, OleCtnrs, Buttons, PCgui, GuiStrings, DrawEngine, PowerCad;
|
||
|
||
type
|
||
TSections = (scHeader, scTables, scBlocks, scEntities, scClasses, scUnknow);
|
||
|
||
TArcDirection = (adClockwise, adCounterClockwise);
|
||
|
||
TSourceBlockName = array[0..12] of Char;
|
||
|
||
TRealType = Single;
|
||
|
||
TVector2D = record
|
||
X, Y: TRealType;
|
||
end;
|
||
|
||
TTransf2D = array[1..3, 1..3] of TRealType;
|
||
|
||
TPoint2D = record
|
||
X, Y, W: TRealType;
|
||
end;
|
||
|
||
TRect2D = record
|
||
case Byte of
|
||
0: (Left, Bottom, W1, Right, Top, W2: TRealType);
|
||
1: (FirstEdge, SecondEdge: TPoint2D);
|
||
end;
|
||
|
||
TGroupTable = array[0..512] of Variant;
|
||
|
||
TDXFRead = class(TMyObject)
|
||
private
|
||
fStream: TextFile;
|
||
fCurrentSection: TSections;
|
||
fGroupCode: Word;
|
||
fGroupValue: Variant;
|
||
fProgressBar: TProgressBar;
|
||
|
||
procedure SetProgressBar(PB: TProgressBar);
|
||
public
|
||
constructor Create(FileName: String);
|
||
destructor Destroy; override;
|
||
procedure Rewind;
|
||
{ Return False if EOF. }
|
||
function ConsumeGroup: Boolean;
|
||
procedure NextSection;
|
||
function ReadAnEntry(GroupDel: Word; var Values: TGroupTable): Word;
|
||
|
||
property GroupCode: Word read FGroupCode;
|
||
property GroupValue: Variant read FGroupValue;
|
||
property CurrentSection: TSections read FCurrentSection;
|
||
property PositionBar: TProgressBar read fProgressBar write SetProgressBar;
|
||
end;
|
||
|
||
(*
|
||
TDXFWrite = class(TMyObject)
|
||
private
|
||
FStream: TextFile;
|
||
public
|
||
constructor Create(FileName: String);
|
||
destructor Destroy; override;
|
||
|
||
procedure Reset;
|
||
procedure BeginSection(Sect: TSections);
|
||
procedure EndSection(Sect: TSections);
|
||
procedure WriteGroup(GroupCode: Word; GroupValue: Variant);
|
||
procedure WriteAnEntry(var Values: TGroupTable);
|
||
end;
|
||
*)
|
||
|
||
EDXFException = Exception;
|
||
EDXFEndOfFile = EAbort;
|
||
EDXFInvalidDXF = EDXFException;
|
||
|
||
TDXF2DImport = class(TMyObject)
|
||
private
|
||
fTextFont: TFont;
|
||
FCADCmp2D: TPowerCAD;
|
||
fDXFRead: TDXFRead;
|
||
fScale: TRealType;
|
||
fHasExtension, fUnableToReadAll, fVerbose: Boolean;
|
||
fSetLayers: Boolean; // Se True i layers letti modificano quelli del CAD in base all'ordine di recupero.
|
||
fAngleDir: TArcDirection;
|
||
fExtension: TRect2D;
|
||
FLayNb: integer;
|
||
fLayerList: TStringList; { Contain the name of the layers and the layer itself. }
|
||
fBlockList: TStringList; { Contain the name of the blocks and the block itself. }
|
||
|
||
(* procedure ReadEntitiesAsContainer(const Container: TContainer2D); *)
|
||
{ Read the DXF blocks. }
|
||
procedure ReadBlocks;
|
||
{ Read the DXF entities. }
|
||
procedure ReadEntities;
|
||
protected
|
||
// Leggono le entit<69>
|
||
function ReadLine2D(Entry: TGroupTable): TFigure;
|
||
function ReadTrace2D(Entry: TGroupTable): TFigure;
|
||
function ReadSolid2D(Entry: TGroupTable): TFigure;
|
||
function ReadArc2D(Entry: TGroupTable): TFigure;
|
||
function ReadCircle2D(Entry: TGroupTable): TFigure;
|
||
function ReadEllipse2D(Entry: TGroupTable): TFigure;
|
||
function ReadPolyline2D(Entry: TGroupTable): TFigure;
|
||
function ReadText2D(Entry: TGroupTable): TFigure;
|
||
function ReadSourceBlock(Entry: TGroupTable): TFigure;
|
||
function ReadBlock(Entry: TGroupTable): TFigure;
|
||
function ReadEntity(IgnoreBlock: Boolean): TFigure;
|
||
|
||
function GoToSection(Sect: TSections): Boolean;
|
||
|
||
property DXFRead: TDXFRead read FDXFRead;
|
||
public
|
||
constructor Create(const FileName: String; const aCAD: TPowerCad);
|
||
destructor Destroy; override;
|
||
|
||
// procedure SetTextFont(F: TVectFont);
|
||
|
||
{ Read the DXF header. }
|
||
procedure ReadHeader;
|
||
{ Read the DXF tables. }
|
||
procedure ReadTables;
|
||
|
||
{ Read the DXF informations. }
|
||
procedure ReadDXF;
|
||
{ Read the DXF informations as a block. }
|
||
// function ReadDXFAsSourceBlock(const Name: TSourceBlockName): Boolean;
|
||
{ Read the DXF informations as a container. }
|
||
// function ReadDXFAsContainer: TContainer2D;
|
||
procedure SetTextFont(F: TFont);
|
||
|
||
property HasExtension: Boolean read fHasExtension;
|
||
property Extension: TRect2D read FExtension;
|
||
property BlockList: TStringList read FBlockList;
|
||
property LayerList: TStringList read FLayerList;
|
||
property Scale: TRealType read fScale write fScale;
|
||
property SetLayers: Boolean read fSetLayers write fSetLayers;
|
||
property UnableToReadAllTheFile: Boolean read fUnableToReadAll;
|
||
property Verbose: Boolean read fVerbose write fVerbose;
|
||
end;
|
||
|
||
(*
|
||
TDXF2DExport = class(TMyObject)
|
||
private
|
||
FDXFWrite: TDXFWrite;
|
||
FCADCmp2D: TCADCmp2D;
|
||
protected
|
||
procedure WriteLine2D(Line: TLine2D);
|
||
procedure WriteFrame2D(Frm: TFrame2D);
|
||
procedure WriteCurve2D(Curve: TCurve2D);
|
||
procedure WriteOutline2D(Poly: TOutline2D);
|
||
procedure WriteText2D(Text: TJustifiedVectText2D);
|
||
procedure WriteBlock(Block: TBlock2D);
|
||
procedure WriteEntity(Obj: TObject2D);
|
||
public
|
||
constructor Create(const FileName: String; const CAD: TCADCmp2D);
|
||
destructor Destroy; override;
|
||
|
||
{ Write the DXF headers. }
|
||
procedure WriteHeader;
|
||
{ Write the DXF tables. }
|
||
procedure WriteTables;
|
||
{ Write the DXF blocks. }
|
||
procedure WriteBlocks;
|
||
{ Write the DXF entities. }
|
||
procedure WriteEntities;
|
||
{ Write the DXF informations. }
|
||
procedure WriteDXF;
|
||
end;
|
||
*)
|
||
|
||
function Point2D(const X, Y: TRealType): TPoint2D;
|
||
function PointDistance2D(const P1, P2: TPoint2D): TRealType;
|
||
function VectorLength2D(const V: TVector2D): TRealType;
|
||
function Vector2D(PFrom, PTo: TPoint2D): TVector2D;
|
||
function CartesianPoint2D(const P: TPoint2D): TPoint2D;
|
||
function ReorderRect2D(const R: TRect2D): TRect2D;
|
||
function CartesianRect2D(const R: TRect2D): TRect2D;
|
||
|
||
var
|
||
Colors : array[0..255] of TColor;
|
||
|
||
Implementation
|
||
|
||
uses Math, Dialogs, Forms, PCDrawing, U_Common;
|
||
|
||
// function body
|
||
function CartesianRect2D(const R: TRect2D): TRect2D;
|
||
begin
|
||
Result.FirstEdge := CartesianPoint2D(R.FirstEdge);
|
||
Result.SecondEdge := CartesianPoint2D(R.SecondEdge);
|
||
end;
|
||
|
||
function ReOrderRect2D(const R: TRect2D): TRect2D;
|
||
begin
|
||
Result := CartesianRect2D(R);
|
||
if R.Left > R.Right then
|
||
begin
|
||
Result.Left := R.Right;
|
||
Result.Right := R.Left;
|
||
end;
|
||
if R.Bottom > R.Top then
|
||
begin
|
||
Result.Bottom := R.Top;
|
||
Result.Top := R.Bottom;
|
||
end;
|
||
end;
|
||
|
||
function CartesianPoint2D(const P: TPoint2D): TPoint2D;
|
||
begin
|
||
if (P.W <> 1.0) and (P.W <> 0.0) then
|
||
begin
|
||
Result.X := P.X / P.W;
|
||
Result.Y := P.Y / P.W;
|
||
Result.W := 1.0;
|
||
end
|
||
else
|
||
Result := P;
|
||
end;
|
||
|
||
function Vector2D(PFrom, PTo: TPoint2D): TVector2D;
|
||
begin
|
||
if PFrom.W <> PTo.W then
|
||
begin
|
||
PFrom := CartesianPoint2D(PFrom);
|
||
PTo := CartesianPoint2D(PTo);
|
||
end;
|
||
Result.X := PTo.X - PFrom.X;
|
||
Result.Y := PTo.Y - PFrom.Y;
|
||
end;
|
||
|
||
function VectorLength2D(const V: TVector2D): TRealType;
|
||
begin
|
||
Result := Sqrt(V.X * V.X + V.Y * V.Y);
|
||
end;
|
||
|
||
function Point2D(const X, Y: TRealType): TPoint2D;
|
||
begin
|
||
Result.X := X;
|
||
Result.Y := Y;
|
||
Result.W := 1.0;
|
||
end;
|
||
|
||
function PointDistance2D(const P1, P2: TPoint2D): TRealType;
|
||
begin
|
||
Result := VectorLength2D(Vector2D(P1, P2));
|
||
end;
|
||
|
||
function ColorToIndex(Col: TColor; Active: Boolean): Integer;
|
||
begin
|
||
Result := 7;
|
||
case Col of
|
||
clBlack,
|
||
clWhite: Result := 7;
|
||
clRed: Result := 1;
|
||
clYellow: Result := 2;
|
||
clLime: Result := 3;
|
||
clAqua: Result := 4;
|
||
clBlue: Result := 5;
|
||
clFuchsia: Result := 6;
|
||
clGray: Result := 8;
|
||
clLtGray: Result := 9;
|
||
end;
|
||
if not Active then Result := -1 * Result;
|
||
end;
|
||
|
||
{ --================== TDXFRead ==================-- }
|
||
|
||
procedure TDXFRead.SetProgressBar(PB: TProgressBar);
|
||
begin
|
||
fProgressBar := PB;
|
||
if Assigned(fProgressBar) then
|
||
begin
|
||
fProgressBar.Min := 0;
|
||
fProgressBar.Max := FileSize(fStream);
|
||
fProgressBar.Position := FilePos(fStream);
|
||
end;
|
||
end;
|
||
|
||
constructor TDXFRead.Create(FileName: String);
|
||
begin
|
||
inherited Create;
|
||
fProgressBar := nil;
|
||
AssignFile(FStream, FileName);
|
||
Reset(FStream);
|
||
ConsumeGroup;
|
||
NextSection;
|
||
end;
|
||
|
||
destructor TDXFRead.Destroy;
|
||
begin
|
||
CloseFile(FStream);
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure TDXFRead.Rewind;
|
||
begin
|
||
Reset(FStream);
|
||
if Assigned(fProgressBar) then
|
||
fProgressBar.Position := 0;
|
||
ConsumeGroup;
|
||
NextSection;
|
||
end;
|
||
|
||
function TDXFRead.ConsumeGroup;
|
||
var
|
||
TxtLine: String;
|
||
LastSep: Char;
|
||
begin
|
||
LastSep := DecimalSeparator;
|
||
try
|
||
ReadLn(FStream, FGroupCode);
|
||
ReadLn(FStream, TxtLine);
|
||
if EOF(FStream) then
|
||
begin
|
||
Result := False;
|
||
Exit;
|
||
end;
|
||
case FGroupCode of
|
||
0..9,
|
||
999,
|
||
1000..1009: FGroupValue := Trim(TxtLine);
|
||
10..59,
|
||
140..147,
|
||
210..239,
|
||
1010..1059: begin
|
||
if Pos('.', TxtLine) > 0 then
|
||
DecimalSeparator := '.'
|
||
else
|
||
DecimalSeparator := ',';
|
||
try
|
||
FGroupValue := StrToFloat_My(Trim(TxtLine));
|
||
except
|
||
FGroupValue := varEmpty;
|
||
end;
|
||
end;
|
||
60..79,
|
||
170..175,
|
||
1060..1079 : begin
|
||
if Pos('.', TxtLine) > 0 then
|
||
DecimalSeparator := '.'
|
||
else
|
||
DecimalSeparator := ',';
|
||
try
|
||
FGroupValue := StrToInt(Trim(TxtLine));
|
||
except
|
||
FGroupValue := varEmpty;
|
||
end;
|
||
end;
|
||
else
|
||
FGroupValue := TxtLine;
|
||
end;
|
||
Result := True;
|
||
finally
|
||
DecimalSeparator := LastSep;
|
||
end;
|
||
if Assigned(fProgressBar) then
|
||
fProgressBar.Position := FilePos(fStream);
|
||
end;
|
||
|
||
procedure TDXFRead.NextSection;
|
||
begin
|
||
FCurrentSection := scUnknow;
|
||
while not ((FGroupCode = 0) and (FGroupValue = 'SECTION')) do
|
||
if ConsumeGroup = False then Exit;
|
||
ConsumeGroup;
|
||
if FGroupValue = 'HEADER' then
|
||
FCurrentSection := scHeader
|
||
else if FGroupValue = 'CLASSES' then
|
||
FCurrentSection := scClasses
|
||
else if FGroupValue = 'TABLES' then
|
||
FCurrentSection := scTables
|
||
else if FGroupValue = 'BLOCKS' then
|
||
FCurrentSection := scBlocks
|
||
else if FGroupValue = 'ENTITIES' then
|
||
FCurrentSection := scEntities;
|
||
ConsumeGroup;
|
||
end;
|
||
|
||
{ GroupDel = Group delimiter }
|
||
function TDXFRead.ReadAnEntry(GroupDel: Word; var Values: TGroupTable): Word;
|
||
begin
|
||
Result := 0;
|
||
{ Find the start of the entry. }
|
||
while (FGroupCode <> GroupDel) and (FGroupCode <> 0) do
|
||
if ConsumeGroup = False then Exit;
|
||
if (FGroupCode = 0) and (FGroupCode <> GroupDel) then Exit;
|
||
{ Read all values. }
|
||
repeat
|
||
if FGroupCode < 256 then
|
||
Values[FGroupCode] := FGroupValue
|
||
else if FGroupCode > 999 then
|
||
{ The extended data types are remapped from 256=1000. }
|
||
Values[FGroupCode - 744] := FGroupValue;
|
||
ConsumeGroup;
|
||
until (FGroupCode = GroupDel) or (FGroupCode = 0);
|
||
Result := GroupDel;
|
||
end;
|
||
|
||
(*
|
||
{ --================== DXFWriter ==================-- }
|
||
|
||
constructor TDXFWrite.Create(FileName: String);
|
||
begin
|
||
inherited Create;
|
||
AssignFile(FStream, FileName);
|
||
Rewrite(FStream);
|
||
end;
|
||
|
||
destructor TDXFWrite.Destroy;
|
||
begin
|
||
CloseFile(FStream);
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure TDXFWrite.Reset;
|
||
begin
|
||
Rewrite(FStream);
|
||
end;
|
||
|
||
procedure TDXFWrite.WriteGroup(GroupCode: Word; GroupValue: Variant);
|
||
var
|
||
TxtLine: String;
|
||
LastSep: Char;
|
||
begin
|
||
LastSep := DecimalSeparator;
|
||
try
|
||
DecimalSeparator := '.';
|
||
WriteLn(FStream, Format('%3d', [GroupCode]));
|
||
case GroupCode of
|
||
0..9,
|
||
999,
|
||
1000..1009: TxtLine := Copy(GroupValue, 1, 255);
|
||
10..59,
|
||
140..147,
|
||
210..239,
|
||
1010..1059: TxtLine := Format('%.6f', [Double(GroupValue)]);
|
||
60..79,
|
||
170..175,
|
||
1060..1079 : TxtLine := Format('%6d', [Integer(GroupValue)]);
|
||
else
|
||
TxtLine := '';
|
||
end;
|
||
WriteLn(FStream, TxtLine);
|
||
finally
|
||
DecimalSeparator := LastSep;
|
||
end;
|
||
end;
|
||
|
||
procedure TDXFWrite.BeginSection(Sect: TSections);
|
||
begin
|
||
WriteGroup(0, 'SECTION');
|
||
case Sect of
|
||
scHeader: WriteGroup(2, 'HEADER');
|
||
scTables: WriteGroup(2, 'TABLES');
|
||
scBlocks: WriteGroup(2, 'BLOCKS');
|
||
scEntities: WriteGroup(2, 'ENTITIES');
|
||
end;
|
||
end;
|
||
|
||
procedure TDXFWrite.EndSection(Sect: TSections);
|
||
begin
|
||
WriteGroup(0, 'ENDSEC');
|
||
end;
|
||
|
||
{ Table Index => DXF file group value
|
||
0-255 => 0-255
|
||
256-512 => 1000-1255 }
|
||
procedure TDXFWrite.WriteAnEntry(var Values: TGroupTable);
|
||
var
|
||
Cont: Word;
|
||
begin
|
||
for Cont := 0 to 255 do
|
||
if VarType(Values[Cont]) > 0 then
|
||
WriteGroup(Cont, Values[Cont]);
|
||
for Cont := 1000 to 1255 do
|
||
if VarType(Values[Cont - 744]) > 0 then
|
||
WriteGroup(Cont, Values[Cont - 744]);
|
||
end;
|
||
*)
|
||
{ --================ DXF2DImport ==================-- }
|
||
|
||
procedure TDXF2DImport.SetTextFont(F: TFont);
|
||
begin
|
||
fTextFont := F;
|
||
end;
|
||
|
||
function TDXF2DImport.ReadLine2D(Entry: TGroupTable): TFigure;
|
||
Var
|
||
CurPos: TPoint;
|
||
CurPos1: TPoint;
|
||
begin
|
||
CurPos:= Point(Entry[10],Entry[20]);
|
||
CurPos1:= Point(Entry[11],Entry[21]);
|
||
Result := TFigure(FCADCmp2D.Line(FLayNb, CurPos.X, CurPos.Y, CurPos1.X, CurPos1.Y, 0, 0, 0, 0, False));
|
||
end;
|
||
|
||
function TDXF2DImport.ReadCircle2D(Entry: TGroupTable): TFigure;
|
||
var
|
||
CurPos: TPoint;
|
||
CurPos1: TPoint;
|
||
begin
|
||
CurPos := Point(Entry[10], Entry[20]);
|
||
CurPos1 := Point(Entry[40], Entry[40]);
|
||
Result := TFigure(FCADCmp2D.Circle(FLayNb, CurPos.X, CurPos.Y, CurPos1.X, 0, 0, 0, 0, 0, False));
|
||
// Result := TEllipse2D.Create(0, Point2D(Entry[10] - Entry[40], Entry[20] - Entry[40]),
|
||
// Point2D(Entry[10] + Entry[40], Entry[20] + Entry[40]));
|
||
end;
|
||
|
||
function TDXF2DImport.ReadEllipse2D(Entry: TGroupTable): TFigure;
|
||
var
|
||
CenterPt, MajorAx: TPoint2D;
|
||
MinorLen, MajorLen, SA, EA, RotA: TRealType;
|
||
CurPos: TPoint;
|
||
CurPos1: TPoint;
|
||
begin
|
||
CenterPt := Point2D(Entry[10], Entry[20]);
|
||
MajorAx := Point2D(Entry[11], Entry[21]);
|
||
MinorLen := Entry[40];
|
||
MajorLen := PointDistance2D(CenterPt, MajorAx);
|
||
CurPos := Point(Entry[10], Entry[20]);
|
||
CurPos1 := Point(Entry[40], Entry[40]);
|
||
SA := Entry[41];
|
||
EA := Entry[42];
|
||
RotA := ArcTan2(MajorAx.Y - CenterPt.Y, MajorAx.X - CenterPt.X);
|
||
|
||
if (SA = 0.0) and (EA = 2 * Pi) then
|
||
// Ellisse completa
|
||
Result := TFigure(FCADCmp2D.Ellipse(FLayNb, CurPos.X, CurPos.Y, MajorLen, MinorLen, RotA, 0, 0, 0, 0, 0, False))
|
||
else
|
||
// Arco di ellisse
|
||
FCADCmp2D.DeselectAll(FLayNb);
|
||
result := TFigure(FCADCmp2D.Arc(FLayNb, CurPos.X, CurPos.Y, CurPos1.X, SA, EA, 0, 0, 0, 0, 0, 0, True));
|
||
if RotA <> 0 then
|
||
FCADCmp2D.RotateSelection(RotA,
|
||
DoublePoint(Point2D(CenterPt.X - MajorLen, CenterPt.X - MinorLen).X, Point2D(CenterPt.X + MajorLen, CenterPt.X + MinorLen).Y));
|
||
end;
|
||
|
||
function TDXF2DImport.ReadArc2D(Entry: TGroupTable): TFigure;
|
||
var
|
||
SA, EA: TRealType;
|
||
CurPos: TPoint;
|
||
CurPos1: TPoint;
|
||
begin
|
||
SA := DegToRad(Entry[50]);
|
||
EA := DegToRad(Entry[51]);
|
||
CurPos := Point(Entry[10], Entry[20]);
|
||
CurPos1 := Point(Entry[40], Entry[40]);
|
||
result := TFigure(FCADCmp2D.Arc(FLayNb, CurPos.X, CurPos.Y, CurPos1.X, SA, EA, 0, 0, 0, 0, 0, 0, False));
|
||
// Result.Direction := FAngleDir;
|
||
end;
|
||
|
||
function TDXF2DImport.ReadTrace2D(Entry: TGroupTable): TFigure;
|
||
var
|
||
PointsArr: array[1..4] of TDoublePoint;
|
||
begin
|
||
// SetLength(PointsArr, 4);
|
||
PointsArr[1] := DoublePoint(Entry[10], Entry[20]);
|
||
PointsArr[2] := DoublePoint(Entry[11], Entry[21]);
|
||
PointsArr[3] := DoublePoint(Entry[12], Entry[22]);
|
||
PointsArr[4] := DoublePoint(Entry[13], Entry[23]);
|
||
Result := TFigure(FCADCmp2D.PolyLine(FLayNb, PointsArr[1], 4, 0, 0, 0, 0, 0, 0, False, False));
|
||
end;
|
||
|
||
function TDXF2DImport.ReadSolid2D(Entry: TGroupTable): TFigure;
|
||
var
|
||
PointsArr: array[1..5] of TDoublePoint;
|
||
begin
|
||
if VarType(Entry[13]) = varEmpty then
|
||
begin
|
||
PointsArr[1] := DoublePoint(Entry[10], Entry[20]);
|
||
PointsArr[2] := DoublePoint(Entry[11], Entry[21]);
|
||
PointsArr[3] := DoublePoint(Entry[12], Entry[22]);
|
||
PointsArr[4] := DoublePoint(Entry[13], Entry[23]);
|
||
Result := TFigure(FCADCmp2D.PolyLine(FLayNb, PointsArr[1], 4, 0, 0, 0, 0, 0, 0, False, False));
|
||
end
|
||
else
|
||
begin
|
||
PointsArr[1] := DoublePoint(Entry[10], Entry[20]);
|
||
PointsArr[2] := DoublePoint(Entry[11], Entry[21]);
|
||
PointsArr[3] := DoublePoint(Entry[12], Entry[22]);
|
||
PointsArr[4] := DoublePoint(Entry[13], Entry[23]);
|
||
PointsArr[5] := DoublePoint(Entry[10], Entry[20]);
|
||
Result := TFigure(FCADCmp2D.PolyLine(FLayNb, PointsArr[1], 5, 0, 0, 0, 0, 0, 0, True, False));
|
||
end;
|
||
end;
|
||
|
||
function TDXF2DImport.ReadText2D(Entry: TGroupTable): TFigure;
|
||
var
|
||
TmpRect: TRect2D;
|
||
begin
|
||
// Result := nil;
|
||
if fTextFont = nil then
|
||
Exit;
|
||
TmpRect.FirstEdge := Point2D(Entry[10], Entry[20]);
|
||
TmpRect.SecondEdge := Point2D(Entry[10], Entry[20] + Entry[40]);
|
||
// Result := TJustifiedVectText2D.Create(0, fTextFont, TmpRect, Entry[40], Entry[1]);
|
||
if Entry[1] = 'F' then
|
||
begin
|
||
// Result.DrawBox := True;
|
||
end;
|
||
if VarType(Entry[72]) <> 0 then
|
||
begin
|
||
// case Entry[72] of
|
||
// 1: Result.HorizontalJust := jhCenter;
|
||
// 2: Result.HorizontalJust := jhRight;
|
||
// end;
|
||
// case Entry[73] of
|
||
// 1: Result.VerticalJust := jvBottom;
|
||
// 2: Result.VerticalJust := jvCenter;
|
||
// end;
|
||
if (Entry[72] > 0) or (Entry[73] > 0) then
|
||
// Result.Points[1] := Point2D(Entry[11], Entry[21]);
|
||
end;
|
||
if VarType(Entry[50]) <> 0 then
|
||
begin
|
||
// Result.Transform(Translate2D(-Result.Points[1].X, -Result.Points[1].Y));
|
||
// Result.Transform(Rotate2D(DegToRad(Entry[50])));
|
||
// Result.Transform(Translate2D(Result.Points[1].X, Result.Points[1].Y));
|
||
end;
|
||
// Result.DrawBox := False;
|
||
end;
|
||
|
||
function TDXF2DImport.ReadPolyline2D(Entry: TGroupTable): TFigure;
|
||
var
|
||
LocalEntry: TGroupTable;
|
||
IsClosedInM, IsSpline2D: Boolean;
|
||
begin
|
||
// Considera le polilinee 2D e 3D alla stessa maniera.
|
||
// Determina i flags della polilinea.
|
||
if VarType(Entry[70]) <> varEmpty then
|
||
begin
|
||
IsClosedInM := Entry[70] and 1 = 1;
|
||
IsSpline2D := (Entry[70] and 2 = 2) or (Entry[70] and 4 = 4);
|
||
end
|
||
else
|
||
begin
|
||
IsClosedInM := False;
|
||
IsSpline2D := False;
|
||
end;
|
||
|
||
if IsSpline2D then
|
||
begin // Leggo la spline2D
|
||
// Result := TPolyline2D.Create(0, [Point2D(0, 0)]);
|
||
// Result.Points.Delete(0);
|
||
// Leggo soli punti aggiunti, quindi gruppo 70 con bit 8.
|
||
fDXFRead.ReadAnEntry(0, LocalEntry);
|
||
while LocalEntry[0] = 'VERTEX' do
|
||
begin
|
||
if (VarType(LocalEntry[70]) <> varEmpty)
|
||
and (LocalEntry[70] and 8 = 8) then
|
||
// Result.Points.Add(Point2D(LocalEntry[10], LocalEntry[20]));
|
||
FDXFRead.ReadAnEntry(0, LocalEntry);
|
||
end;
|
||
// if Result.Points.Count = 0 then
|
||
begin // La spline <20> stata creata senza i punti aggiuntivi.
|
||
// Result.Free;
|
||
// Result := nil;
|
||
fUnableToReadAll := True;
|
||
if fVerbose then
|
||
ShowMessage('Spline without spline-fitting isn''t supported.');
|
||
end;
|
||
end
|
||
else
|
||
begin // Leggo la polilinea2D
|
||
// Result := TPolyline2D.Create(0, [Point2D(0, 0)]);
|
||
// Result.Points.Delete(0);
|
||
// Leggo tutti i punti.
|
||
fDXFRead.ReadAnEntry(0, LocalEntry);
|
||
while LocalEntry[0] = 'VERTEX' do
|
||
begin
|
||
// Result.Points.Add(Point2D(LocalEntry[10], LocalEntry[20]));
|
||
FDXFRead.ReadAnEntry(0, LocalEntry);
|
||
end;
|
||
if IsClosedInM then // la chiudo.
|
||
// Result.Points.Add(Result.Points[0]);
|
||
end;
|
||
if (LocalEntry[0] <> 'SEQEND') then
|
||
begin
|
||
fUnableToReadAll := True;
|
||
Raise EDXFInvalidDXF.Create('Invalid DXF file.');
|
||
end;
|
||
end;
|
||
|
||
function TDXF2DImport.ReadEntity(IgnoreBlock: Boolean): TFigure;
|
||
var
|
||
Entry: TGroupTable;
|
||
NLayer: Integer;
|
||
begin
|
||
// Result := nil;
|
||
FDXFRead.ReadAnEntry(0, Entry);
|
||
NLayer := FLayerList.IndexOf(Entry[8]);
|
||
if NLayer > -1 then
|
||
FCADCmp2D.ActiveLayer := 1;
|
||
if Entry[0] = 'LINE' then
|
||
Result := ReadLine2D(Entry)
|
||
else if Entry[0] = 'ARC' then
|
||
Result := ReadArc2D(Entry)
|
||
else if Entry[0] = 'TRACE' then
|
||
Result := ReadTrace2D(Entry)
|
||
else if Entry[0] = 'SOLID' then
|
||
Result := ReadSolid2D(Entry)
|
||
else if Entry[0] = 'CIRCLE' then
|
||
Result := ReadCircle2D(Entry)
|
||
else if Entry[0] = 'ELLIPSE' then
|
||
Result := ReadEllipse2D(Entry)
|
||
else if Entry[0] = 'POLYLINE' then
|
||
Result := ReadPolyline2D(Entry)
|
||
else if Entry[0] = 'TEXT' then
|
||
Result := ReadText2D(Entry)
|
||
else if (not IgnoreBlock) and (Entry[0] = 'INSERT') then
|
||
Result := ReadBlock(Entry);
|
||
end;
|
||
|
||
function TDXF2DImport.ReadBlock(Entry: TGroupTable): TFigure;
|
||
begin
|
||
result := nil;
|
||
ShowMessage('Some blocks cannot be read.');
|
||
Exit;
|
||
end;
|
||
|
||
(*
|
||
procedure TDXF2DImport.ReadEntitiesAsContainer(const Container: TContainer2D);
|
||
var
|
||
Tmp: TObject2D;
|
||
ID: Integer;
|
||
begin
|
||
ID := 0;
|
||
while DXFRead.GroupValue <> 'ENDSEC' do
|
||
begin
|
||
Tmp := ReadEntity(True);
|
||
if Assigned(Tmp) then
|
||
begin
|
||
Tmp.Transform(Scale2D(fScale, fScale));
|
||
Tmp.ApplyTransform;
|
||
Tmp.ID := ID;
|
||
Container.Objects.Add(Tmp);
|
||
Inc(ID)
|
||
end
|
||
else
|
||
fUnableToReadAll := True;
|
||
end;
|
||
Container.UpdateExtension(Self);
|
||
end;
|
||
*)
|
||
|
||
constructor TDXF2DImport.Create(const FileName: String; const aCAD: TPowerCad);
|
||
begin
|
||
inherited Create;
|
||
fDXFRead := TDXFRead.Create(FileName);
|
||
fCADCmp2D := aCAD;
|
||
FLayNb := 1;
|
||
fLayerList := TStringList.Create;
|
||
fBlockList := TStringList.Create;
|
||
fSetLayers := True;
|
||
fScale := 1.0;
|
||
fHasExtension := False;
|
||
fUnableToReadAll := False;
|
||
end;
|
||
|
||
destructor TDXF2DImport.Destroy;
|
||
begin
|
||
fDXFRead.Free;
|
||
fLayerList.Free;
|
||
fBlockList.Free;
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TDXF2DImport.GoToSection(Sect: TSections): Boolean;
|
||
begin
|
||
FDXFRead.Rewind;
|
||
while (FDXFRead.CurrentSection <> scUnknow) and
|
||
(FDXFRead.CurrentSection <> Sect) do
|
||
FDXFRead.NextSection;
|
||
Result := FDXFRead.CurrentSection = Sect;
|
||
end;
|
||
|
||
procedure TDXF2DImport.ReadDXF;
|
||
begin
|
||
if fCADCmp2D = nil then Exit;
|
||
fUnableToReadAll := False;
|
||
FDXFRead.Rewind;
|
||
while (FDXFRead.CurrentSection <> scUnknow) do
|
||
begin
|
||
case FDXFRead.CurrentSection of
|
||
scHeader: ReadHeader;
|
||
scTables: ReadTables;
|
||
scBlocks: ReadBlocks;
|
||
scEntities: ReadEntities;
|
||
end;
|
||
FDXFRead.NextSection;
|
||
end;
|
||
end;
|
||
|
||
procedure TDXF2DImport.ReadHeader;
|
||
var
|
||
Entry: TGroupTable;
|
||
begin
|
||
fHasExtension := False;
|
||
fExtension.Right := 1000;
|
||
fExtension.Top := 1000;
|
||
fExtension.W1 := 1.0;
|
||
fExtension.Left := -1000;
|
||
fExtension.Bottom := -1000;
|
||
fExtension.W2 := 1.0;
|
||
fAngleDir := adCounterClockwise;
|
||
while fDXFRead.ReadAnEntry(9, Entry) <> 0 do
|
||
begin
|
||
if Entry[9] = '$ANGDIR' then
|
||
begin
|
||
if Entry[70] = 1 then
|
||
fAngleDir := adClockwise
|
||
else
|
||
fAngleDir := adCounterClockwise;
|
||
end
|
||
else if Entry[9] = '$EXTMAX' then
|
||
begin
|
||
fExtension.Right := Entry[10];
|
||
fExtension.Top := Entry[20];
|
||
fHasExtension := True;
|
||
end
|
||
else if Entry[9] = '$EXTMIN' then
|
||
begin
|
||
fExtension.Left := Entry[10];
|
||
fExtension.Bottom := Entry[20];
|
||
fHasExtension := True;
|
||
end;
|
||
end;
|
||
if fHasExtension then
|
||
FExtension := ReOrderRect2D(FExtension);
|
||
end;
|
||
|
||
procedure TDXF2DImport.ReadTables;
|
||
var
|
||
Entry: TGroupTable;
|
||
begin
|
||
if fCADCmp2D = nil then Exit;
|
||
fDXFRead.ReadAnEntry(0, Entry);
|
||
while fDXFRead.GroupValue <> 'ENDSEC' do
|
||
begin
|
||
if Entry[0] = 'LAYER' then
|
||
begin
|
||
if fSetLayers then
|
||
// with fCADCmp2D.Layers[fLayerList.Count] do
|
||
// begin
|
||
// Pen.Color := Colors[Abs(Round(Entry[62]))];
|
||
// Brush.Style := bsClear;
|
||
// Active := Entry[62] >= 0;
|
||
// Name := Entry[2];
|
||
// end;
|
||
fLayerList.AddObject(Entry[2], fCADCmp2D.Layers[fLayerList.Count]);
|
||
end;
|
||
fDXFRead.ReadAnEntry(0, Entry);
|
||
end;
|
||
end;
|
||
|
||
procedure TDXF2DImport.ReadEntities;
|
||
var
|
||
Tmp: TFigure;
|
||
begin
|
||
if fCADCmp2D = nil then Exit;
|
||
while DXFRead.GroupValue <> 'ENDSEC' do
|
||
begin
|
||
Tmp := ReadEntity(False);
|
||
if Assigned(Tmp) then
|
||
begin
|
||
// Tmp.Transform(Scale2D(fScale, fScale));
|
||
// Tmp.ApplyTransform;
|
||
// FCADCmp2D.AddCustomFigure(FLayNb, Tmp, False);
|
||
end
|
||
else
|
||
fUnableToReadAll := True;
|
||
end;
|
||
end;
|
||
|
||
procedure TDXF2DImport.ReadBlocks;
|
||
var
|
||
Entry: TGroupTable;
|
||
NLayer: Integer;
|
||
tmp: TFigure;
|
||
begin
|
||
if fCADCmp2D = nil then Exit;
|
||
while DXFRead.GroupValue <> 'ENDSEC' do
|
||
begin
|
||
FDXFRead.ReadAnEntry(0, Entry);
|
||
// NLayer := FLayerList.IndexOf(Entry[8]);
|
||
// if NLayer > -1 then
|
||
// FCADCmp2D.CurrentLayer := NLayer;
|
||
if Entry[0] = 'BLOCK' then
|
||
begin
|
||
Tmp := ReadSourceBlock(Entry);
|
||
if Assigned(Tmp) then
|
||
begin
|
||
FCADCmp2D.AddCustomFigure(1, Tmp, False);
|
||
fBlockList.AddObject(Entry[2], Tmp);
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function TDXF2DImport.ReadSourceBlock(Entry: TGroupTable): TFigure;
|
||
var
|
||
BasePoint: TPoint2D;
|
||
// Tmp: TObject2D;
|
||
TmpName: TSourceBlockName;
|
||
begin
|
||
Result := nil;
|
||
if (Entry[70] and $4) or (Entry[70] and $1) then
|
||
{ XRef and anonymous are not allowed. }
|
||
Exit;
|
||
BasePoint.X := Entry[10];
|
||
BasePoint.Y := Entry[20];
|
||
BasePoint.W := 1.0;
|
||
// if Entry[2] = '' then
|
||
// TmpName := StringToBlockName(Format('BLOCK%d', [FCADCmp2D.SourceBlocksCount]))
|
||
// else
|
||
// TmpName := StringToBlockName(Entry[2]);
|
||
// Result := TSourceBlock2D.Create(0, TmpName, [nil]);
|
||
while FDXFRead.GroupValue <> 'ENDBLK' do
|
||
begin
|
||
ReadEntity(False);
|
||
// if Assigned(Tmp) then
|
||
// Result.Objects.Add(Tmp);
|
||
end;
|
||
// if Result.Objects.Count > 0 then
|
||
// begin
|
||
// Result.Transform(Translate2D(-BasePoint.X, -BasePoint.Y));
|
||
// Result.ApplyTransform;
|
||
// Result.UpdateExtension(Self);
|
||
// end
|
||
// else
|
||
// begin
|
||
// Result.Free;
|
||
// Result := nil;
|
||
// end;
|
||
end;
|
||
|
||
(*
|
||
{ --================ DXF2DExport ==================-- }
|
||
|
||
constructor TDXF2DExport.Create(const FileName: String; const CAD: TCADCmp2D);
|
||
begin
|
||
inherited Create;
|
||
FDXFWrite := TDXFWrite.Create(FileName);
|
||
FCADCmp2D := CAD;
|
||
end;
|
||
|
||
destructor TDXF2DExport.Destroy;
|
||
begin
|
||
FDXFWrite.WriteGroup(0, 'EOF');
|
||
FDXFWrite.Free;
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure TDXF2DExport.WriteDXF;
|
||
begin
|
||
if fCADCmp2D = nil then Exit;
|
||
FDXFWrite.Reset;
|
||
WriteHeader;
|
||
WriteTables;
|
||
WriteBlocks;
|
||
WriteEntities;
|
||
end;
|
||
|
||
procedure TDXF2DExport.WriteHeader;
|
||
var
|
||
TmpInt: Integer;
|
||
begin
|
||
if fCADCmp2D = nil then Exit;
|
||
with FDXFWrite do
|
||
begin
|
||
BeginSection(scHeader);
|
||
{ Angle direction, Default CounterClockWise }
|
||
WriteGroup(9, '$ANGDIR');
|
||
TmpInt := 0;
|
||
WriteGroup(70, TmpInt);
|
||
{ Extension of the drawing }
|
||
WriteGroup(9, '$EXTMAX');
|
||
WriteGroup(10, FCADCmp2D.DrawingExtension.Right);
|
||
WriteGroup(20, FCADCmp2D.DrawingExtension.Top);
|
||
WriteGroup(30, 0);
|
||
WriteGroup(9, '$EXTMIN');
|
||
WriteGroup(10, FCADCmp2D.DrawingExtension.Left);
|
||
WriteGroup(20, FCADCmp2D.DrawingExtension.Bottom);
|
||
WriteGroup(30, 0);
|
||
WriteGroup(9, '$CECOLOR');
|
||
WriteGroup(62, 256);
|
||
WriteGroup(9, '$CELTYPE');
|
||
WriteGroup(6, 'BYLAYER');
|
||
{ End Header Section }
|
||
EndSection(scHeader);
|
||
end;
|
||
end;
|
||
|
||
procedure TDXF2DExport.WriteTables;
|
||
var
|
||
Count: Integer;
|
||
begin
|
||
if fCADCmp2D = nil then Exit;
|
||
with FDXFWrite do
|
||
begin
|
||
{ Begin Tables Section }
|
||
BeginSection(scTables);
|
||
WriteGroup(0, 'TABLE');
|
||
WriteGroup(2, 'LTYPE');
|
||
WriteGroup(70, 1);
|
||
WriteGroup(0, 'LTYPE');
|
||
WriteGroup(2, 'CONTINUOUS');
|
||
WriteGroup(70, 64);
|
||
WriteGroup(3, 'Solid line');
|
||
WriteGroup(72, 65);
|
||
WriteGroup(73, 0);
|
||
WriteGroup(40, 0.0);
|
||
WriteGroup(0, 'ENDTAB');
|
||
WriteGroup(0, 'TABLE');
|
||
WriteGroup(2, 'LAYER');
|
||
WriteGroup(70, 257);
|
||
WriteGroup(0, 'LAYER');
|
||
WriteGroup(2, '0');
|
||
WriteGroup(70, 64);
|
||
WriteGroup(62, 7);
|
||
WriteGroup(6, 'CONTINUOUS');
|
||
for Count := 0 to 255 do
|
||
with FCADCmp2D.Layers[Count] do
|
||
if Modified then
|
||
begin
|
||
WriteGroup(0, 'LAYER');
|
||
WriteGroup(2, Name);
|
||
WriteGroup(70, 64);
|
||
WriteGroup(62, ColorToIndex(Pen.Color, Active));
|
||
WriteGroup(6, 'CONTINUOUS');
|
||
end;
|
||
WriteGroup(0, 'ENDTAB');
|
||
{ End Tables Section }
|
||
EndSection(scTables);
|
||
end;
|
||
end;
|
||
|
||
procedure TDXF2DExport.WriteEntities;
|
||
var
|
||
TmpIter: TGraphicObjIterator;
|
||
TmpObj: TObject2D;
|
||
begin
|
||
if fCADCmp2D = nil then Exit;
|
||
FDXFWrite.BeginSection(scEntities);
|
||
TmpIter := fCADCmp2D.ObjectsIterator;
|
||
try
|
||
TmpObj := TmpIter.First as TObject2D;
|
||
while TmpObj <> nil do
|
||
begin
|
||
WriteEntity(TmpObj);
|
||
TmpObj := TmpIter.Next as TObject2D;
|
||
end;
|
||
finally
|
||
TmpIter.Free;
|
||
FDXFWrite.EndSection(scEntities);
|
||
end;
|
||
end;
|
||
|
||
procedure TDXF2DExport.WriteBlocks;
|
||
var
|
||
TmpIter: TGraphicObjIterator;
|
||
TmpObj: TObject2D;
|
||
begin
|
||
if fCADCmp2D = nil then Exit;
|
||
FDXFWrite.BeginSection(scBlocks);
|
||
TmpIter := fCADCmp2D.SourceBlocksIterator;
|
||
try
|
||
TmpObj := TmpIter.First as TObject2D;
|
||
while TmpObj <> nil do
|
||
begin
|
||
WriteEntity(TmpObj);
|
||
TmpObj := TmpIter.Next as TObject2D;
|
||
end;
|
||
finally
|
||
TmpIter.Free;
|
||
FDXFWrite.EndSection(scBlocks);
|
||
end;
|
||
end;
|
||
|
||
procedure TDXF2DExport.WriteLine2D(Line: TLine2D);
|
||
var
|
||
TmpPnt: TPoint2D;
|
||
begin
|
||
with FDXFWrite, Line do
|
||
begin
|
||
TmpPnt := TransformPoint2D(Points[0], ModelTransform);
|
||
WriteGroup(10, TmpPnt.X);
|
||
WriteGroup(20, TmpPnt.Y);
|
||
WriteGroup(30, 0);
|
||
TmpPnt := TransformPoint2D(Points[1], ModelTransform);
|
||
WriteGroup(11, TmpPnt.X);
|
||
WriteGroup(21, TmpPnt.Y);
|
||
WriteGroup(31, 0);
|
||
end;
|
||
end;
|
||
|
||
procedure TDXF2DExport.WriteFrame2D(Frm: TFrame2D);
|
||
var
|
||
TmpPnt: TPoint2D;
|
||
begin
|
||
with FDXFWrite, Frm do
|
||
begin
|
||
WriteGroup(66, 1);
|
||
WriteGroup(10, 0);
|
||
WriteGroup(20, 0);
|
||
WriteGroup(30, 0); // Questo setta l'elevazione.
|
||
WriteGroup(0, 'VERTEX');
|
||
WriteGroup(8, FCADCmp2D.Layers[Frm.Layer].Name);
|
||
TmpPnt := TransformPoint2D(Points[0], ModelTransform);
|
||
WriteGroup(10, TmpPnt.X);
|
||
WriteGroup(20, TmpPnt.Y);
|
||
WriteGroup(30, 0);
|
||
WriteGroup(0, 'VERTEX');
|
||
WriteGroup(8, FCADCmp2D.Layers[Frm.Layer].Name);
|
||
TmpPnt := TransformPoint2D(Point2D(Points[0].X, Points[1].Y), ModelTransform);
|
||
WriteGroup(10, TmpPnt.X);
|
||
WriteGroup(20, TmpPnt.Y);
|
||
WriteGroup(30, 0);
|
||
WriteGroup(0, 'VERTEX');
|
||
WriteGroup(8, FCADCmp2D.Layers[Frm.Layer].Name);
|
||
TmpPnt := TransformPoint2D(Points[1], ModelTransform);
|
||
WriteGroup(10, TmpPnt.X);
|
||
WriteGroup(20, TmpPnt.Y);
|
||
WriteGroup(30, 0);
|
||
WriteGroup(0, 'VERTEX');
|
||
WriteGroup(8, FCADCmp2D.Layers[Frm.Layer].Name);
|
||
TmpPnt := TransformPoint2D(Point2D(Points[1].X, Points[0].Y), ModelTransform);
|
||
WriteGroup(10, TmpPnt.X);
|
||
WriteGroup(20, TmpPnt.Y);
|
||
WriteGroup(30, 0);
|
||
WriteGroup(0, 'VERTEX');
|
||
WriteGroup(8, FCADCmp2D.Layers[Frm.Layer].Name);
|
||
TmpPnt := TransformPoint2D(Points[0], ModelTransform);
|
||
WriteGroup(10, TmpPnt.X);
|
||
WriteGroup(20, TmpPnt.Y);
|
||
WriteGroup(30, 0);
|
||
WriteGroup(0, 'SEQEND');
|
||
end;
|
||
end;
|
||
|
||
procedure TDXF2DExport.WriteText2D(Text: TJustifiedVectText2D);
|
||
var
|
||
TmpPnt, TmpPnt1: TPoint2D;
|
||
InsPnt: TPoint2D;
|
||
AllPnt: TPoint2D;
|
||
TmpAngle: Single;
|
||
begin
|
||
with FDXFWrite, Text do
|
||
begin
|
||
WriteGroup(1, Text);
|
||
WriteGroup(40, Height);
|
||
TmpPnt := TransformPoint2D(Points[0], ModelTransform);
|
||
AllPnt := TransformPoint2D(Points[1], ModelTransform);
|
||
InsPnt := TransformPoint2D(Point2D(Points[0].X, Points[1].Y - Height), ModelTransform);
|
||
WriteGroup(10, InsPnt.X);
|
||
WriteGroup(20, InsPnt.Y);
|
||
WriteGroup(30, 0);
|
||
// I compute the angle of the Text from the rotation of it.
|
||
TmpPnt := TransformPoint2D(Point2D(0, 0), ModelTransform);
|
||
TmpPnt1 := TransformPoint2D(Point2D(10, 0), ModelTransform);
|
||
TmpAngle := ArcTan2(TmpPnt1.Y - TmpPnt.Y, TmpPnt1.X - TmpPnt.X);
|
||
WriteGroup(50, RadToDeg(TmpAngle));
|
||
case HorizontalJust of
|
||
jhCenter: begin
|
||
WriteGroup(11, AllPnt.X - InsPnt.X);
|
||
WriteGroup(21, AllPnt.Y - InsPnt.Y);
|
||
WriteGroup(31, 0);
|
||
WriteGroup(72, 1);
|
||
end;
|
||
jhRight: begin
|
||
WriteGroup(11, AllPnt.X);
|
||
WriteGroup(21, AllPnt.Y);
|
||
WriteGroup(31, 0);
|
||
WriteGroup(72, 2);
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TDXF2DExport.WriteCurve2D(Curve: TCurve2D);
|
||
var
|
||
Count: Integer;
|
||
TmpPnt: TPoint2D;
|
||
begin
|
||
with FDXFWrite, Curve do
|
||
begin
|
||
BeginUseProfilePoints;
|
||
try
|
||
WriteGroup(66, 1);
|
||
WriteGroup(10, 0);
|
||
WriteGroup(20, 0);
|
||
WriteGroup(30, 0); // Questo setta l'elevazione.
|
||
for Count := 0 to ProfilePoints.Count - 1 do
|
||
begin
|
||
WriteGroup(0, 'VERTEX');
|
||
WriteGroup(8, FCADCmp2D.Layers[Curve.Layer].Name);
|
||
TmpPnt := TransformPoint2D(ProfilePoints[Count], ModelTransform);
|
||
WriteGroup(10, TmpPnt.X);
|
||
WriteGroup(20, TmpPnt.Y);
|
||
WriteGroup(30, 0);
|
||
end;
|
||
WriteGroup(0, 'SEQEND');
|
||
finally
|
||
EndUseProfilePoints;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TDXF2DExport.WriteOutline2D(Poly: TOutline2D);
|
||
var
|
||
Count: Integer;
|
||
TmpPnt: TPoint2D;
|
||
begin
|
||
with FDXFWrite, Poly do
|
||
begin
|
||
WriteGroup(66, 1);
|
||
WriteGroup(10, 0);
|
||
WriteGroup(20, 0);
|
||
WriteGroup(30, 0); // Questo setta l'elevazione.
|
||
for Count := 0 to Points.Count - 1 do
|
||
begin
|
||
WriteGroup(0, 'VERTEX');
|
||
WriteGroup(8, FCADCmp2D.Layers[Poly.Layer].Name);
|
||
TmpPnt := TransformPoint2D(Points[Count], ModelTransform);
|
||
WriteGroup(10, TmpPnt.X);
|
||
WriteGroup(20, TmpPnt.Y);
|
||
WriteGroup(30, 0);
|
||
end;
|
||
WriteGroup(0, 'SEQEND');
|
||
end;
|
||
end;
|
||
|
||
procedure TDXF2DExport.WriteBlock(Block: TBlock2D);
|
||
begin
|
||
with FDXFWrite, Block do
|
||
begin
|
||
WriteGroup(2, Format('%s', [SourceName]));
|
||
WriteGroup(10, ModelTransform[3,1]);
|
||
WriteGroup(20, ModelTransform[3,2]);
|
||
WriteGroup(30, 0);
|
||
WriteGroup(41, ModelTransform[1,1]);
|
||
WriteGroup(42, ModelTransform[2,2]);
|
||
end;
|
||
end;
|
||
|
||
procedure TDXF2DExport.WriteEntity(Obj: TObject2D);
|
||
begin
|
||
with FDXFWrite do
|
||
if Obj is TLine2D then
|
||
begin
|
||
WriteGroup(0, 'LINE');
|
||
WriteGroup(8, FCADCmp2D.Layers[Obj.Layer].Name);
|
||
WriteLine2D(Obj as TLine2D);
|
||
end
|
||
else if Obj is TFrame2D then
|
||
begin
|
||
WriteGroup(0, 'POLYLINE');
|
||
WriteGroup(8, FCADCmp2D.Layers[Obj.Layer].Name);
|
||
WriteFrame2D(Obj as TFrame2D);
|
||
end
|
||
else if Obj is TCurve2D then
|
||
begin
|
||
WriteGroup(0, 'POLYLINE');
|
||
WriteGroup(8, FCADCmp2D.Layers[Obj.Layer].Name);
|
||
WriteCurve2D(Obj as TCurve2D);
|
||
end
|
||
else if Obj is TOutline2D then
|
||
begin
|
||
WriteGroup(0, 'POLYLINE');
|
||
WriteGroup(8, FCADCmp2D.Layers[Obj.Layer].Name);
|
||
WriteOutline2D(Obj as TOutline2D);
|
||
end
|
||
else if Obj is TJustifiedVectText2D then
|
||
begin
|
||
WriteGroup(0, 'TEXT');
|
||
WriteGroup(8, FCADCmp2D.Layers[Obj.Layer].Name);
|
||
WriteText2D(Obj as TJustifiedVectText2D);
|
||
end
|
||
else if Obj is TBlock2D then
|
||
begin
|
||
WriteGroup(0, 'INSERT');
|
||
WriteGroup(8, FCADCmp2D.Layers[Obj.Layer].Name);
|
||
WriteBlock(Obj as TBlock2D);
|
||
end;
|
||
end;
|
||
*)
|
||
|
||
const
|
||
ColArray1: array[1..4] of Byte = (0, 63, 127, 191);
|
||
ColArray2: array[1..4] of Byte = (127, 159, 191, 223);
|
||
var
|
||
Cont: Byte;
|
||
|
||
initialization
|
||
Colors[0] := RGB(255, 255, 255);
|
||
Colors[1] := RGB(255, 0, 0);
|
||
Colors[2] := RGB(255, 255, 0);
|
||
Colors[3] := RGB(0, 255, 0);
|
||
Colors[4] := RGB(0, 255, 255);
|
||
Colors[5] := RGB(0, 0, 255);
|
||
Colors[6] := RGB(255, 0, 255);
|
||
Colors[7] := RGB(0, 0, 0);
|
||
Colors[8] := RGB(134, 134, 134);
|
||
Colors[9] := RGB(187, 187, 187);
|
||
Colors[250] := RGB(0, 0, 0);
|
||
Colors[251] := RGB(45, 45, 45);
|
||
Colors[252] := RGB(91, 91, 91);
|
||
Colors[253] := RGB(137, 137, 137);
|
||
Colors[254] := RGB(183, 183, 183);
|
||
Colors[255] := RGB(179, 179, 179);
|
||
for Cont := 1 to 4 do
|
||
begin
|
||
Colors[Cont * 10] := RGB(255, ColArray1[Cont], 0);
|
||
Colors[40 + Cont * 10] := RGB(ColArray1[5 - Cont], 255, 0);
|
||
Colors[80 + Cont * 10] := RGB(0, 255, ColArray1[Cont]);
|
||
Colors[120 + Cont * 10] := RGB(0, ColArray1[5 - Cont], 255);
|
||
Colors[160 + Cont * 10] := RGB(ColArray1[Cont], 0, 255);
|
||
end;
|
||
Colors[210] := RGB(255, 0, 255);
|
||
Colors[220] := RGB(255, 0, 191);
|
||
Colors[230] := RGB(255, 0, 127);
|
||
Colors[240] := RGB(255, 0, 63);
|
||
for Cont := 1 to 4 do
|
||
begin
|
||
Colors[Cont * 10 + 1] := RGB(255, ColArray2[Cont], 127);
|
||
Colors[41 + Cont * 10] := RGB(ColArray2[5 - Cont], 255, 127);
|
||
Colors[81 + Cont * 10] := RGB(127, 255, ColArray2[Cont]);
|
||
Colors[121 + Cont * 10] := RGB(127, ColArray2[5 - Cont], 255);
|
||
Colors[161 + Cont * 10] := RGB(ColArray2[Cont], 127, 255);
|
||
end;
|
||
Colors[211] := RGB(255, 127, 255);
|
||
Colors[221] := RGB(255, 127, 223);
|
||
Colors[231] := RGB(255, 127, 191);
|
||
Colors[241] := RGB(255, 127, 159);
|
||
end.
|
||
|