Hello,
Please try the code below, it creates a valid DWG file containing three 3DFACE objects in a block.
Code: Select all
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, CADImage, DXFConv, CADToDWG, sgConsts, Generics.Collections, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
FCADImage: TsgCADImage;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure AddEntityToImage(ATargetImage: TsgCADImage; AEntity: TsgDXFEntity);
begin
if not Assigned(ATargetImage) then Exit;
ATargetImage.CurrentLayout.AddEntity(AEntity);
if Assigned(ATargetImage.Converter.OnCreate) then
ATargetImage.Converter.OnCreate(AEntity);
ATargetImage.Converter.Loads(AEntity);
ATargetImage.GetExtents;
end;
procedure SaveToDWG(ACADImage: TsgCADImage; AFileName: string);
var
vCADtoDWG: TsgCADtoDWG;
begin
if not Assigned(ACADImage) then Exit;
vCADtoDWG := TsgCADtoDWG.Create(ACADImage);
try
vCADtoDWG.SaveToFile(AFileName);
finally
vCADtoDWG.Free;
end;
end;
function MakeSingleDTMFaces(ACADImage: TsgCADImage; pt1, pt2, pt3: TFPoint; blockName: string = 'Block'): TsgDXF3dFace;
begin
Result:= TsgDXF3dFace.Create;
Result.Point := pt1;
Result.Point1 := pt2;
Result.Point2 := pt3;
Result.Point3 := pt3;
Result.Layer := ACADImage.Converter.LayerByName(blockName);
end;
procedure Create3DIfcFace(ACADImage: TsgCADImage);
var
mesh3dFace: TsgDXF3dFace;
P1: TFPoint;
I: Integer;
step: Integer;
vCount: Integer;
pList: TList<TFPoint>;
vBlock: TsgDXFBlock;
vInsert: TsgDXFInsert;
layerName: string;
begin
pList := TList<TFPoint>.Create;
vBlock := TsgDXFBlock.Create;
layerName := '3dFaces';
vBlock.Name := '3dFacesBlock';
vBlock.Flags := 2;
P1 := MakeFPoint(0, 0, 0);
pList.Add(P1);
P1 := MakeFPoint(75, 50, 50);
pList.Add(P1);
P1 := MakeFPoint(150, 0, 0);
pList.Add(P1);
P1 := MakeFPoint(0, 0, 0);
pList.Add(P1);
P1 := MakeFPoint(75, 140, 0);
pList.Add(P1);
P1 := MakeFPoint(75, 50, 50);
pList.Add(P1);
P1 := MakeFPoint(75, 50, 50);
pList.Add(P1);
P1 := MakeFPoint(75, 140, 0);
pList.Add(P1);
P1 := MakeFPoint(150, 0, 0);
pList.Add(P1);
try
step := 0;
vCount := pList.Count;
for I := 1 to (vCount div 3) do
begin
mesh3dFace := MakeSingleDTMFaces(ACADImage, pList[step],
pList[step + 1],
pList[step + 2],
layerName);
if Assigned(ACADImage.Converter.OnCreate) then
ACADImage.Converter.OnCreate(mesh3dFace);
ACADImage.Converter.Loads(mesh3dFace);
vBlock.AddEntity(mesh3dFace);
step := step + 3;
end;
if Assigned(ACADImage.Converter.OnCreate) then
ACADImage.Converter.OnCreate(vBlock);
ACADImage.Converter.Loads(vBlock);
ACADImage.Converter.Sections[csBlocks].AddEntity(vBlock);
vInsert := TsgDXFInsert.Create;
vInsert.Block := vBlock;
vInsert.Point := MakeFPoint(0, 0, 0);
vInsert.Scale := MakeFPoint(1, 1, 1);
vInsert.Color := clByLayer;
vInsert.Layer := ACADImage.Converter.LayerByName(layerName);
AddEntityToImage(ACADImage, vInsert);
finally
FreeAndNil(pList);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FCADImage := TsgCADImage.Create;
FCADImage.Converter.InitializeSectionsBegin;
FCADImage.Converter.InitializeSectionsEnd;
FCADImage.CurrentLayout := FCADImage.Layouts[0];
Create3DIfcFace(FCADImage);
SaveToDWG(FCADImage, ExtractFilePath(Application.ExeName) + '3dFaces.dwg');
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreeAndNil(FCADImage);
end;
end.
Mikhail