ARES, DraftSight 2025 プロット Delphi サンプル 2024/10/25 .. 2025/05/09
-PRINT コマンド、COM (ActiveX) で印刷するサンプルです。
2025/05/09 DraftSight の情報を追加
■事前バインディングの準備
事前（アーリー）バインディングのために、タイプライブリの取り込みが必要ですが、ARES に限らず他 のCAD でも 64 ビット版は、Delphi
IDE からタイプライブリの取り込みが出来ません。
https://docwiki.embarcadero.com/RADStudio/Alexandria/ja/TLIBIMP.EXE
以下、「コマンドプロンプト」のコピーです。
｜C:\Users\owner>cd..
｜
｜C:\Users>cd..
｜
｜C:\>cd C:\Program Files\Graebert GmbH\ARES Standard 2025\BIN
｜
｜C:\Program Files\Graebert GmbH\ARES Standard 2025\BIN>"C:\Program Files (x86)\Embarcadero\Studio\21.0\bin64\tlibimp.exe" -P ARESS.exe
｜Embarcadero TLIBIMP Version 12.16581 [x64]
｜Copyright(c) 1995-2020 Embarcadero Technologies, Inc.
｜
｜ARES.exe を開いています
｜タイプ ライブラリの読み込み....
｜作成完了 C:\Program Files\Graebert GmbH\ARES Standard 2025\BIN\PCAD_DB_X_TLB.dcr
｜作成完了 C:\Program Files\Graebert GmbH\ARES Standard 2025\BIN\PCAD_DB_X_TLB.pas
｜作成完了 C:\Program Files\Graebert GmbH\ARES Standard 2025\BIN\PCAD_AC_X_TLB.dcr
｜作成完了 C:\Program Files\Graebert GmbH\ARES Standard 2025\BIN\PCAD_AC_X_TLB.pas
｜
PCAD_AC_X_TLB.pas、PCAD_DB_X_TLB.pas 2つの.pas をパスの通ったフォルダ（「例えば Imports）にいれるか、プロジェクトに追加。
uses 節にComObj, BPCAD_AC_X_TLB, PCAD_DB_X_TLB を追加すれば、Windows 64ビット、32ビットで使えるようになります。
PCAD_DB_X_TLB.pas は、OdaX...dll からも作成できます。
｜C:\Program Files\Graebert GmbH\ARES Standard 2025\BIN>"C:\Program
Files (x86)\Embarcadero\Studio\21.0\bin64\tlibimp.exe" -P OdaX_24.7_17.dll
｜Embarcadero TLIBIMP Version 12.16581 [x64]
｜Copyright(c) 1995-2020 Embarcadero Technologies, Inc.
｜
｜OdaX_24.7_17.dll を開いています
｜タイプ ライブラリの読み込み....
｜作成完了! C:\Program Files\Graebert GmbH\ARES Standard 2025\BIN\PCAD_DB_X_TLB.dcr
｜作成完了! C:\Program Files\Graebert GmbH\ARES Standard 2025\BIN\PCAD_DB_X_TLB.pas
※遅延（レイト）バインディングではタイプライブリの取り込みは不要になり、IAcadApplication、IAcadDocument ...
等はすべて OleVariant になります。
また、入力支援は働きません。定数 (const) も使えず、自前で記述する必要があります。
ProgId を変更するだけで CAD、CADのバージョンに関係なく動く可能性があります。
■事前バインディングのサンプルコード
unit ARESUnit87;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
ComObj, ActiveX, PCAD_AC_X_TLB, PCAD_DB_X_TLB, // 追加
Vcl.StdCtrls;
type
TForm87 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form87: TForm87;
implementation
{$R *.dfm}
// size : 'A0' ～ 'A9', 'B0' ～ 'B9' sw : 0= 用紙横置き, 1 = 縦置き
function paperNameToPaperSize(const size: string; sw:integer; var w: double; var h: double): boolean;
var
i: integer;
wary, hary:array of double;
begin
result := False;
w := 0;
h := 0;
wary := [1189, 841, 594, 420, 297, 210, 148, 105, 74, 52];// 用紙サイズ A0～A9 の横幅
hary := [ 841, 594, 420, 297, 210, 148, 105, 74, 52, 37];
for i := 0 to 9 do begin
if Pos('A' + i.ToString, size) > 0 then begin
if sw < 1 then begin
w := wary[i];
h := hary[i];
end
else begin
h := wary[i];
w := hary[i];
end;
result := True;
break;
end;
end;
if not result then begin
wary := [1456, 1030, 728, 515, 364, 257, 182, 128, 91, 64];// 用紙サイズ B0～B9の横幅
hary := [1030, 728, 515, 364, 257, 182, 128, 91, 64, 45];
for i := 0 to 9 do begin
if Pos('B'+i.ToString, size) > 0 then begin
if sw < 1 then begin
w := wary[i];
h := hary[i];
end
else begin
h := wary[i];
w := hary[i];
end;
result := True;
break;
end;
end;
end;
end;
// ARES コマンドプロット
procedure TForm87.Button1Click(Sender: TObject);
var
app : IAcadApplication;
doc : IAcadDocument;
sl : TStringList;
fname : TFileName;
pt1, pt2 : array [0..1] of double;
rotIndex : integer;
scale : double;
paperName, styleName, printerName : string;
paperW, paperH, dx, dy : double;
i : integer;
begin
try
app := GetActiveOleObject('PCAD_AC_X.AcadApplication') as IAcadApplication;
//if IsIconic(app.HWND_) then OpenIcon(app.HWND_);
if app.WindowState = acMin then app.WindowState := acNorm;
SetForegroundWindow(app.HWND_);
doc := app.ActiveDocument;
fname := ChangeFileExt(ParamStr(0), '.scr');
printerName := 'pdfFactory';
paperName := 'A4';
styleName := 'monochrome.ctb';
pt1[0] := 0;
pt1[1] := 0;
pt2[0] := 420;
pt2[1] := 297;
rotIndex := 1; // 回転角度 0 ～ 3 x 90deg
if paperNameToPaperSize(paperName, 0, paperW, paperH) then begin
dx := abs(pt2[0] - pt1[0]);
dy := abs(pt2[1] - pt1[1]);
if dx > dy then scale := dx / paperW
else scale := dy / paperH;
end
else
scale := -1.0; // フィット
{
0 =用紙縦 0°
90 =用紙横 右90°
180=用紙縦 180°
270=用紙横 左80°
通常90で使用
}
sl := TStringList.Create;
with sl do begin
try
// 横方向に 11 個 x 1 列
for i := 0 to 10 do begin
pt1[0] := 420 * i;
pt1[1] := 0;
pt2[0] := 420 * (i + 1);
pt2[1] := 297;
DeleteFile(fname);
Clear;
Add('ZOOM'#13);
// 始点コーナー
Add(Format('%.4f,%.4f', [pt1[0], pt1[1]]));
// 反対側のコーナー
Add(Format('%.4f,%.4f', [pt2[0], pt2[1]]));
Add('-PRINT');
// 印刷オプションの詳細設定? はい(Y) または いいえ(N)
Add('Y');
// シート名
Add('Model');
// プリンタ名
Add(printerName); //'pdfFactory');
// ペーパー サイズ
Add(paperName); // 'A4');
// 単位: インチ(I) または ミリメートル(M)
Add('M');
// 方向: 縦(P) または 横(L)
case rotIndex of
0: Add('P');
1: Add('L');
2: Add('P');
3: Add('L');
else Add('L');
end;
// 上下を逆にして印刷しますか? はい(Y) または いいえ(N)
// N = 右90°Y= 左90°
case rotIndex of
0: Add('N');
1: Add('N');
2: Add('Y');
3: Add('Y');
else Add('N');
end;
// 印刷範囲: すべてのジオメトリ(A), 図面境界(B), 指定(S) または 現在ビュー(C)
Add('S');
// 始点コーナー
Add(Format('%.4f,%.4f', [pt1[0], pt1[1]]));
// 反対側のコーナー
Add(Format('%.4f,%.4f', [pt2[0], pt2[1]]));
// 印刷尺度 ミリメートル = 図面単位 フィット(F) または 解像度(R)
if scale > 0 then Add(Format('1=%.4f', [scale]))
else Add('F');
// 印刷 X,Y オフセット 中心(C)
Add('C');
// 印刷スタイル テーブルを使用? はい(Y) または いいえ(N
Add('Y');
// 印刷スタイル名
Add(styleName); // 'monochrome.ctb');
// 線幅を印刷に反映? はい(Y) または いいえ(N)
Add('Y');
// オプション: 表示どおり(D), 隠線(H), レンダリング(R) または ワイヤフレーム(W)
Add('D');
// ファイルに出力? はい(Y) または いいえ(N)
Add('N');
// 印刷設定をシートに適用? はい(Y) または いいえ(N)
Add('N');
// 今すぐ印刷しますか? はい(Y) または いいえ(N)
Add('Y');
Add('FILEDIA 1');
SaveToFile(fname);
if FileExists(fname) then begin
doc.SendCommand('FILEDIA'#13'0'#13);
Sleep(10);
// スクリプトロード
doc.SendCommand('LOADSCRIPT'#13 + fname + #13);
// 終了待ち
while True do begin
Sleep(500);
Application.ProcessMessages;
try
if app.GetAcadState.IsQuiescent then break;
except
break;
end;
end;
end;
end;
finally
Free;
end;
end;
except
end;
end;
end.
■遅延バインディング
タイプライブラリの取り込み、uses ... CAD_AC_X_TLB, PCAD_DB_X_TLB は不要です。
ProgId を変更するだけで CAD、CADのバージョンに関係なく動く可能性があります。
・AutoCAD 2025： 'Autocad.Application.25'
（末尾 2 桁の数字はシステム変数 ACADVER の値と思われる）
・ARES： 'PCAD_AC_X.AcadApplication'
・DraftSight： 'DraftSight_AC_X.AcadApplication'
・BricsCAD： 'BricscadApp.AcadApplication'
・IJCAD, GstarCAD： 'Gcad.Application.25'
（末尾 2 桁の数字は 'IJCAD 2025' の末尾 2 桁）
・ZWCAD： 'ZWCAD.Application'
以下、変更部分のみ
※ CAD によっては、'-PRINT' コマンドを '-PLOT'、'LOADSCRIPT' コマンドを 'SCRIPT' に変える必要があります。
procedure TForm87.....
const
acNorm = 1;
acMin = 2;
acMax = 3;
var
app : OleVariant;
doc : OleVariant;
.....
begin
app := GetActiveOleObject('PCAD_AC_X.AcadApplication');
if app.WindowState = acMin then app.WindowState := acNorm;
SetForegroundWindow(app.HWND);
.....
end;
■ARES で動いたコード（遅延バインディング）
procedure TForm87.Button1Click(Sender: TObject);
var
app: oleVariant;
doc: oleVariant;
layout : oleVariant;
ProgId : string;
begin
try
ProgId := 'PCAD_AC_X.AcadApplication';
app := GetActiveOleObject(ProgId);
//app := GetActiveOleObject('DraftSight_AC_X.AcadApplication');
//app := GetActiveOleObject('BricscadApp.AcadApplication');
//app := GetActiveOleObject('ZWCAD.Application');
//app := GetActiveOleObject('Gcad.Application.25');
Caption := app.Caption;
if IsIconic(app.HWND) then OpenIcon(app.HWND);
SetForegroundWindow(app.HWND);
doc := app.ActiveDocument;
layout := doc.ActiveLayout;
layout.RefreshPlotDeviceInfo;
// プリンターをセット
layout.ConfigName := 'pdfFactory';
layout.CanonicalMediaName := 'A4';
layout.StyleSheet := 'monochrome.ctb';
// acDisplay, acExtents, acLimits, acView, acWindow, acLayout
layout.PlotType := acLimits;
layout.CenterPlot := True;
layout.UseStandardScale := False;
layout.SetCustomScale(1.0, 1.414); // 分子、分母の順
layout.RefreshPlotDeviceInfo;
doc.SetVariable('backgroundplot', 0);
// 印刷実行
try
if (Pos('PCAD', Uppercase(ProgId)) = 0) and Pos('DRAFT', Uppercase(ProgId)) = 0) then begin
// ↓ARES 以外用（ARES ではエラーになる）
doc.Plot.PlotToDevice(layout.ConfigName);
end
else begin
// ↓ARES、DraftSight 用
doc.Plot.PlotToDevice();
end;
except
ShowMessage('PlotToDevice Error');
end;
except
ShowMessage('error');
end;
end;