R12 形式の DXF ファイルを作る (2016/ 8/19, 2018/12/13)
2018/12/13
・PLOYLINE （直線のみ）の作成を追加
・Variant 型からの変換を追加
・TEXT 作成の不具合を修正
■R12 形式の DXF ファイルは、ハンドル番号、ハンドル数、クラス名が不要なので、作りやすいです。
ただし、R12 時代に無い図形は作成できません。例えば、LWPOLYLINE は、POLYLINE で作成します。
※ファイルを挿入するとき、ファイル名の前に "*" を付けると、分解挿入されます。
分解挿入の時、尺度指定の S オプションが使えなくなり、X, Y の尺度を指定する必要があります。
{ 2018/12/13
・Variant -> TAcadPoint 変換を追加
・POLYLINE 作成（直線のみ）を追加
・TEXT 作成の不具合を修正
}
unit MakeR12Dxf_V;
interface
uses
Windows, //for TPoint
System.UITypes,
System.Variants, //for OleVariant;
SysUtils,
Graphics,
Classes; //for TStrings
type
TAcadPoint = Record
x, y, z :Extended;
end;
function V3ToAcPt(vpt : OleVariant): TAcadPoint;
function VptsToAcPts(vpts : OleVariant; var acpts: array of TAcadPoint): boolean;
procedure MakeR12DxfHead(sl: TStrings);
procedure AddR12DxfEntHead(sl: TStringList);
procedure AddR12DxfLineEnt(sl: TStrings; p1, p2: TAcadPoint; const Layer: string; const LType: string; LColor: integer);
procedure AddR12DxfTextEnt(sl: TStrings;
const Txt: string; pt10, pt11: TAcadPoint; Takasa, Haba, Kakudo: double;
code72, code73: integer; const Kiten: string; const Lay: string; color: integer);
procedure AddR12DxfCircleEnt(sl: TStrings; Center: TAcadPoint; hankei: double; const Layer: string; const LType: string; LColor: integer);
procedure AddR12DxfArcEnt(sl: TStrings; Center: TAcadPoint; hankei, StDeg, EdDeg: double; const Layer: string; const LType: string; LColor: integer);
procedure AddR12DxfPolylineEnt(sl: TStrings; pts : array of TAcadPoint; closed : boolean ; const Layer: string; const LType: string; LColor: integer);
procedure AddR12DxfTerm(sl: TStrings);
procedure AddR12DxfLtypeHidden2(sl: TStrings);
procedure AddR12DxfLtypeDummy(sl: TStrings);
implementation
//{$R *.dfm}
// バリアントの3D配列を TAcadPoint に
function V3ToAcPt(vpt : OleVariant): TAcadPoint;
begin
result.x := vpt[0];
result.y := vpt[1];
result.z := vpt[2];
end;
// バリアントの１次元配列（2D座標)を TAcadPoint に
// vpts は、x1, y1, x2, y2, ....
// acpt は、acpt[0], acpt[1], ...
function VptsToAcPts(vpts : OleVariant; var acpts: array of TAcadPoint): boolean;
var
n, m, i :integer;
begin
// 一次元配列の数
n := VarArrayHighBound(vpts, 1) + 1;
m := Length(acpts);
if n div 2 = m then begin
for i := 0 to n div 2 -1 do begin
acpts[i].x := vpts[i * 2];
acpts[i].y := vpts[i * 2 + 1];
acpts[i].z := 0.0;
end;
end;
result := n div 2 =m;
end;
procedure MakeR12DxfHead(sl: TStrings);
begin
sl.Clear;
sl.Add(' 0' + #13#10 + 'SECTION' + #13#10 + ' 2' + #13#10 + 'HEADER' + #13#10 +
' 9' + #13#10 + '$ACADVER' + #13#10 + ' 1' + #13#10 + 'AC1009' + #13#10 +
' 9' + #13#10 + '$CELTYPE' + #13#10 + ' 6' + #13#10 + 'BYLAYER' + #13#10 +
' 9' + #13#10 + '$CECOLOR' + #13#10 + ' 62' + #13#10 + '256' + #13#10 +
' 0' + #13#10 + 'ENDSEC');
sl.Add(' 0' + #13#10 + 'SECTION' + #13#10 + ' 2' + #13#10 + 'TABLES');
end;
procedure AddR12DxfTerm(sl: TStrings);
begin
sl.Add(' 0' + #13#10 + 'ENDSEC');
sl.Add(' 0' + #13#10 + 'EOF');
end;
procedure AddR12DxfLtypeDummy(sl: TStrings);
begin
with sl do
begin
// TABLESセクションのうちLTYPEだけを追加
Add(' 0' + #13#10 + 'TABLE');
Add(' 2' + #13#10 + 'LTYPE');
Add(' 70' + #13#10 + ' 2' + #13#10 + ' 0' + #13#10 + 'LTYPE');
Add(' 2' + #13#10 + 'CONTINUOUS' + #13#10 + ' 70' + #13#10 + ' 0' + #13#10 + ' 3' + #13#10 + 'Solid line');
Add(' 72' + #13#10 + ' 65' + #13#10 + ' 73' + #13#10 + ' 0' + #13#10 + ' 40' + #13#10 + '0.0');
Add(' 0' + #13#10 + 'ENDTAB');
end
end;
procedure AddR12DxfLtypeHidden2(sl: TStrings);
begin
with sl do
begin
// TABLESセクションのうちLTYPEだけを追加
Add(' 2' + #13#10 + 'LTYPE');
Add(' 0' + #13#10 + 'LTYPE' + #13#10 + ' 2' + #13#10 + 'HIDDEN2' +
#13#10 + ' 70' + #13#10 + ' 0');
Add(' 3' + #13#10 + 'Hidden (.5x) _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _');
Add(' 72' + #13#10 + ' 65' + #13#10 + ' 73' + #13#10 + ' 2');
Add(' 40' + #13#10 + '4.7625' + #13#10 + ' 49' + #13#10 + '3.175' +
#13#10 + ' 49' + #13#10 + '-1.5875');
Add(' 0' + #13#10 + 'ENDTAB');
end
end;
procedure AddR12DxfEntHead(sl: TStringList);
begin
with sl do begin
Add(' 0' + #13#10 + 'ENDSEC');
Add(' 0' + #13#10 + 'SECTION' + #13#10 + ' 2' + #13#10 + 'ENTITIES');
end;
end;
// R12形式なので、TTFは設定できない
// すでに存在するSTYLEの場合は、フォント名は適当で良い
procedure AddR12DxfTextStyle(sl: TStrings; const style, font1, font2: string);
begin
with sl do begin
Add(' 0' + #13#10 + 'TABLE' + #13#10 + ' 2' + #13#10 + 'STYLE' + #13#10 + ' 70' + #13#10 + ' 1');
Add(' 0' + #13#10 + 'STYLE' + #13#10 + ' 2' + #13#10 + style + #13#10 + ' 70' + #13#10 +' 0');
Add(' 40' + #13#10 + '0.0' + #13#10 + ' 41' + #13#10 + '1.0' + #13#10 + ' 50' + #13#10 + '0.0');
Add(' 71' + #13#10 + ' 0' + #13#10 + ' 42' + #13#10 + '2.5' + #13#10 + ' 3' + #13#10 + font1);
Add(' 4' + #13#10 + font2 + #13#10 + ' 0' + #13#10 + 'ENDTAB');
end;
end;
procedure AddR12DxfLineEnt(sl: TStrings; p1, p2: TAcadPoint; const Layer: string; const LType: string; LColor: integer);
begin
with sl do begin
Add(' 0' + #13#10 + 'LINE');
Add(' 8' + #13#10 + Layer + #13#10 + ' 6' + #13#10 + LType + #13#10 +
' 62' + #13#10 + IntToStr(LColor) + #13#10 + ' 48' + #13#10 + '1.0');
Add(' 10' + #13#10 + FloatToStr(p1.x) + #13#10 + ' 20' + #13#10 + FloatToStr(p1.y) + #13#10 +
' 30' + #13#10 + FloatToStr(p1.z));
Add(' 11' + #13#10 + FloatToStr(p2.x) + #13#10 + ' 21' + #13#10 + FloatToStr(p2.y) + #13#10 +
' 31' + #13#10 + FloatToStr(p2.z));
end;
end;
procedure AddR12DxfCircleEnt(sl: TStrings; Center: TAcadPoint; hankei: double; const Layer: string; const LType: string; LColor: integer);
begin
with sl do begin
Add(' 0' + #13#10 + 'CIRCLE');
Add(' 8' + #13#10 + Layer + #13#10 + ' 6' + #13#10 + LType + #13#10 +
' 62' + #13#10 + IntToStr(LColor) + #13#10 + ' 48' + #13#10 + '1.0');
Add(' 10' + #13#10 + FloatToStr(Center.x) + #13#10 + ' 20' + #13#10 + FloatToStr(Center.y) + #13#10 +
' 30' + #13#10 + FloatToStr(Center.z));
Add(' 40' + #13#10 + FloatToStr(Hankei));
end;
end;
procedure AddR12DxfArcEnt(sl: TStrings; Center: TAcadPoint; hankei, StDeg, EdDeg: double; const Layer: string; const LType: string; LColor: integer);
begin
with sl do begin
Add(' 0' + #13#10 + 'ARC');
Add(' 8' + #13#10 + Layer + #13#10 + ' 6' + #13#10 + LType + #13#10 +
' 62' + #13#10 + IntToStr(LColor) + #13#10 + ' 48' + #13#10 + '1.0');
Add(' 10' + #13#10 + FloatToStr(Center.x) + #13#10 + ' 20' + #13#10 + FloatToStr(Center.y) + #13#10 +
' 30' + #13#10 + FloatToStr(Center.z));
Add(' 40' + #13#10 + FloatToStr(Hankei) + #13#10 +
' 50' + #13#10 + FloatToStr(StDeg) + #13#10 + ' 51' + #13#10 + FloatToStr(EdDeg));
end;
end;
procedure AddR12DxfPolylineEnt(sl: TStrings; pts : array of TAcadPoint; closed : boolean ; const Layer: string; const LType: string; LColor: integer);
var
i : integer;
begin
with sl do begin
Add(' 0' + #13#10 + 'POLYLINE');
Add(' 8' + #13#10 + Layer + #13#10 + ' 6' + #13#10 + LType + #13#10 +
' 62' + #13#10 + IntToStr(LColor) + #13#10 + ' 48' + #13#10 + '1.0');
Add(' 66' + #13#10 + '1');
Add(' 10' + #13#10 + '0.0' + #13#10 + ' 20' + #13#10 + '0.0' + #13#10 + ' 30' + #13#10 + '0.0');
if closed then
Add(' 70' + #13#10 + '1')
else
Add(' 70' + #13#10 + '0');
for i := 0 to Length(pts) - 1 do begin
Add(' 0' + #13#10 + 'VERTEX');
Add(' 8' + #13#10 + Layer);
Add(' 10' + #13#10 + FloatToStr(pts[i].x) + #13#10 + ' 20' + #13#10 + FloatToStr(pts[i].y) + #13#10 +
' 30' + #13#10 + '0.0');
end;
Add(' 0' + #13#10 + 'SEQEND');
end;
end;
// 201812/13 修正
procedure AddR12DxfTextEnt(sl: TStrings;
const Txt: string; pt10, pt11: TAcadPoint; Takasa, Haba, Kakudo: double;
code72, code73: integer; const Kiten: string; const Lay: string; color :Integer);
var
n: integer;
s: string;
begin
if kiten <> '' then begin
s := Kiten;
n := Length(s);
if (n = 2) then begin
if (s[1] = 'M') then code73 := 2
else if (s[1] = 'T') then code73 := 3
else if (s[1] = 'B') then code73 := 1;
if (s[2] = 'L') then code72 := 0
else if (s[2] = 'C') then code72 := 1
else if (s[2] = 'R') then code72 := 2;
end
else if n = 1 then begin
if (s[1] = 'L') then code72 := 0
else if (s[1] = 'C') then code72 := 1
else if (s[1] = 'R') then code72 := 2
else if (s[1] = 'A') then code72 := 3
else if (s[1] = 'M') then code72 := 4
else if (s[1] = 'F') then code72 := 5;
end;
end;
with sl do begin
Add(' 0' + #13#10 + 'TEXT');
Add(' 8' + #13#10 + Lay + #13#10 +
' 62' + #13#10 + IntToStr(color));
Add(' 10' + #13#10 + FloatToStr(pt10.x) + #13#10 + ' 20' + #13#10 + FloatToStr(pt10.y) + #13#10 +
' 30' + #13#10 + FloatToStr(pt10.z));
Add(' 11' + #13#10 + FloatToStr(pt11.x) + #13#10 + ' 21' + #13#10 + FloatToStr(pt11.y) + #13#10 +
' 31' + #13#10 + FloatToStr(pt11.z));
Add(' 1' + #13#10 + Txt);
Add(' 40' + #13#10 + FloatToStr(takasa));
Add(' 41' + #13#10 + FloatToStr(Haba));
Add(' 50' + #13#10 + FloatToStr(Kakudo));
Add(' 72' + #13#10 + IntToStr(code72) + #13#10 +' 73' + #13#10 + IntToStr(code73));
end;
end;
end.
//-----------------------------------------------------
// 使い方
// ※ Variant 型は、他の CAD 用のプログラムを流用するために追加しています
// 通常は、TAcadPoint を使います
//-----------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
var
sl: TStringList;
p1, p2 : TAcadPoint;
DxfName : TFileName;
vpt1, vpt2 : OleVariant;
vpts : OleVariant;
acpts : array of TAcadPoint;
begin
// 通常はこちら
// LINE 用テストデータ
p1.x := 100;
p1.y := 200;
p1.z := 0;
p2.x := 200;
p2.y := 100;
p2.z := 0;
// バリアントを使う場合はこちら
// LINE 用テストデータ
// Variant To TAcadPoint の変換が必要
vpt1 := VarArrayCreate([0, 2], VarDouble);
vpt2 := vpt1;
vpt1[0] := 100;
vpt1[1] := 200;
vpt1[2] := 0;
vpt2[0] := 300;
vpt2[1] := 400;
vpt2[2] := 0;
// POLYLINE 用テストデータ
vpts := VarArrayCreate([0, 7], VarDouble);
vpts[0] := 100;
vpts[1] := 100;
vpts[2] := 200;
vpts[3] := 100;
vpts[4] := 200;
vpts[5] := 50;
vpts[6] := 100;
vpts[7] := 50;
SetLength(acpts, 4);
// Variant To TAcadPoint の変換
VptsToAcPts(vpts , acpts);
sl := TStringList.Create;
try
// ヘッダー
MakeR12DxfHead(sl);
// TABLESセクションのうちLTYPEだけを追加
AddR12DxfLtypeDummy(sl);
// ENTITIES 開始
AddR12DxfEntHead(sl);
// LINE を追加
AddR12DxfLineEnt(sl, V3ToAcPt(vpt1), V3ToAcPt(vpt2), '0', 'BYLAYER', 256);
// TEXT を追加
AddR12DxfTextEnt(sl, 'TEST', V3ToAcPt(vpt1), V3ToAcPt(vpt2), 10, 1, 0, 0, 0, 'ML', '0', 256);
// POLYLINE を追加
AddR12DxfPolylineEnt(sl, acpts, True, '0', 'BYLAYER', 256);
// ENDSEC
AddR12DxfTerm(sl);
// DXFファイルを追加
DxfName := ChangeFileExt(ParamStr(0), '.dxf');
// ファイルに保存
sl.SaveToFile(DxfName);
// Memo に表示
Memo1.Lines.Assign(sl);
finally
sl.Free;
end;
end;