■一時オブジェクトスナップの省略文字 (OneKey と同じ）
M, MI, MD, MM : mid (中点)
C, CE, CN, CC : cen (中心)
Q, QU, QA, QQ : qua (四半円点)
I, IT, I I : int (交点)
E, EN, ED, EE : end（端点)
T, TA, TN, TT : tan (接線)
N, NE, NA : nea (近接点)
P, PE, PR, PP : per (垂線)
S, IN, IS : ins (挿入基点)
O, D, ND : nod (点)
NN, NO : non (解除)
V, M2, MT, MP, MMM : m2p (２点間中点)
EX, ET : ext (延長)
F, FR, FM : from (基点設定)
A, AP : app (仮想交点)
PA : par (平行)
X, XX : [ESC]キー
G, GC : gce (図心)
※コマンドオプションが優先されます。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
BcadCtrl19, Vcl.StdCtrls, Vcl.ExtCtrls, IMM, IniFiles;
type
TForm1 = class(TForm)
Timer1: TTimer;
Edit6: TEdit;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private 宣言 }
public
{ Public 宣言 }
// 基準カーソル位置とマウス移動の判断の閾値
curX, curY, dXY : integer;
// Bricscad が起動中 ON
bcadFlag : boolean;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure HwndSendKeys(h: HWND; const keystr: string);
{ Hwnd をアクティブにして、Keyを押す}
var
i : integer;
s: string;
begin
if IsWindowEnabled(h) then begin
SetForegroundWindow(h);
s := UpperCase(keystr);
for i := 1 to Length(s) do begin
keybd_event(Byte(s[i]), 0, 0, 0);
keybd_event(Byte(s[i]), 0, KEYEVENTF_KEYUP, 0);
Sleep(1);
end;
end;
end;
function makeObjectSnapStr(const cmdo: string; const optstr: string): string;
begin
result := '';
// オプションリストに存在
if (optstr = '') or (cmdo.IndexOf(',' + optstr + ',') < 0) then begin
// 一時オブジェクトスナップ
// 中点：MID
if optstr = 'M' then result := 'id' + #13
else if optstr = 'MI' then result := 'd' + #13
else if optstr = 'MD' then result := #08 + 'id' + #13
else if optstr = 'MM' then result := #08 + 'id' + #13
// 中心：CEN
else if optstr = 'C' then result := 'en' + #13
else if optstr = 'CE' then result := 'n' + #13
else if optstr = 'CN' then result := #08+'en' + #13
else if optstr = 'CC' then result := #08+'en' + #13
// 四半円点：QUA
else if optstr = 'Q' then result := 'ua' + #13
else if optstr = 'QU' then result := 'a' + #13
else if optstr = 'QA' then result := #08 + 'ua' + #13
else if optstr = 'QQ' then result := #08 + 'ua' + #13
// 端点：END
else if optstr = 'E' then result := 'nd' + #13
else if optstr = 'EN' then result := 'd' + #13
else if optstr = 'ED' then result := #08 + 'nd' + #13
else if optstr = 'EE' then result := #08 + 'nd' + #13
// 交点：INT
else if optstr = 'I' then result := 'nt' + #13
else if optstr = 'IT' then result := #08 + 'nt' + #13
else if optstr = 'II' then result := #08 + 'nt' + #13
// 接線：TAN
else if optstr = 'T' then result := 'an' + #13
else if optstr = 'TA' then result := 'n' + #13
else if optstr = 'TN' then result := #08 + 'an' + #13
else if optstr = 'TT' then result := #08 + 'an' + #13
// 近接点：NEA
else if optstr = 'N' then result := 'ea' + #13
else if optstr = 'NE' then result := 'a' + #13
else if optstr = 'NA' then result := #08 + 'ea' + #13
// 垂線：PER
else if optstr = 'P' then result := 'er' + #13
else if optstr = 'PE' then result := 'r' + #13
else if optstr = 'PR' then result := #08 + 'er' + #13
else if optstr = 'PP' then result := #08 + 'er' + #13
// 挿入基点：INS
else if optstr = 'S' then result := #08 + 'ins' + #13
else if optstr = 'IS' then result := #08 + 'ns' + #13
else if optstr = 'IN' then result := 's' + #13
// 点：NOD
else if optstr = 'D' then result := #08 + 'nod' + #13
else if optstr = 'O' then result := #08 + 'nod' + #13
else if optstr = 'ND' then result := #08 + 'od' + #13
// 解除：NON
else if optstr = 'NN' then result := #08 + 'on' + #13
else if optstr = 'NO' then result := 'n' + #13
// 2点間中点：M2P
else if optstr = 'V' then result := #08 + 'm2p' + #13
else if optstr = 'MT' then result := #08 + 'tp' + #13
else if optstr = 'M2' then result := #08 + '2p' + #13
else if optstr = 'MP' then result := #08 + '2p' + #13
else if optstr = 'MMM' then result := #08#08 + '2p' + #13
// 延長：EXT
//else if optstr = 'E' then result := 'xt' + #13
else if optstr = 'EX' then result := 't' + #13
else if optstr = 'ET' then result := #08 + 'xt' + #13
// 基点設定：FROM
else if optstr = 'F' then result := 'rom' + #13
else if optstr = 'FR' then result := 'om' + #13
else if optstr = 'FM' then result := #08 + 'rom' + #13
// 仮想交点：APP
else if optstr = 'A' then result := 'pp' + #13
else if optstr = 'AP' then result := 'p' + #13
// 平行：PAR
else if optstr = 'PA' then result := 'r' + #13
//else if optstr = 'PR' then result := #08 + 'ar' + #13
// [ESC]
else if optstr = 'X' then result := #27
else if optstr = 'XX' then result := #27
// 図心 : GCE
else if optstr = 'G' then result := 'ce'+#13
else if optstr = 'GC' then result := 'e'+#13;
end;
end;
function makeCmdOptionList(const cmds: string): string;
var
n, m : integer;
s, s2 : string;
begin
result := '';
s := cmds;
if (s.IndexOf('(') > 0) and (s.IndexOf(')') > 0) then begin
m := Pos('[', s);
n := Pos(']', s);
if (m > 0) and (n > m) then s := Copy(s, m + 1, n-m-1);
if s <> '' then begin
while True do begin
m := Pos('(', s);
n := Pos(')', s);
if (m > 0) and (n > m) then begin
s2 := Copy(s, m + 1, n - m -1);
if (s2.Length > 0) and (s2.Length <= 5) then result := result + s2 + ',';
Delete(s, 1, n);
end
else break;
end;
end;
end
else if (s.IndexOf('選択:') > 0) then begin
result := 'W,L,C,BOX,ALL,F,WP,CP,G,CL,A,R,M,P,U,AU,SI,';
end;
// OPT の始まりと終わりは、','で囲まれている状態にする
if result <> '' then result := ',' + result;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
ini : TIniFile;
begin
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
try
ini.WriteInteger('OneKey', 'MouseMove', dXY);
ini.WriteBool('OneKey','ImeOff', CheckBox1.Checked);
ini.WriteBool('OneKey','OneKey', CheckBox2.Checked);
finally
ini.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
ini : TIniFile;
begin
Edit6.Text := '';
dXY := 40;
// スクリーンの右下隅に表示
Left := Screen.Width - Width - 10;
Top := Screen.Height - Height - 130;
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
try
dXY := ini.ReadInteger('OneKey','MouseMove', dXY);
CheckBox1.Checked := ini.ReadBool('OneKey','ImeOff', True);
CheckBox2.Checked := ini.ReadBool('OneKey','OneKey', True);
finally
ini.Free;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
PT: TPoint;
cmdline, cmdstr, cmdopt, optstr, kbstr : string;
n : integer;
dX, dY :double;
optFlag, cmdFlag : boolean;
IME : HWND;
termFlag : boolean;
begin
termFlag := False;
Timer1.Enabled := False;
try
cmdline := GetBcadCmdLine;
except
cmdline := '';
Caption := 'ERR1';
end;
// IME Off
if CheckBox1.Checked and (cmdLine = ': ') then begin
IME := ImmGetDefaultIMEWnd(BcadCmdLineHandle);
if IME <> 0 then begin
// ON であれば OFF にする
if Boolean(SendMessage(IME, WM_IME_CONTROL, $0005, 0)) then
SendMessage(IME, WM_IME_CONTROL, $0006, 0);
end;
end;
// MouseMove
if CheckBox2.Checked and IsWindowEnabled(BcadMainWinHandle) and GetCursorPos(PT) then begin
// 前回との偏差（CAD 座標と同じ方向）
dx := PT.X -curX;
dy := curY -PT.Y;
Edit6.Text := dX.ToString + ',' + dY.ToString;
// コマンドオプションリスト
cmdopt := makeCmdOptionList(cmdline);
n := LastDelimiter(':', cmdline);
// コマンド入力中
if n = 1 then cmdstr := Trim(Copy(cmdline, 2))
// コマンドオプション待ち
else if n > 1 then optstr := Trim(Copy(cmdline, n + 1))
else optstr := '';
// コマンド入力中
cmdFlag := cmdstr <> '';
// コマンドオプション入力中
if optstr <> '' then begin
optstr := UpperCase(optStr);
// オプションリストに存在
optFlag := Pos(',' + optStr + ',', cmdopt) > 0;
end
else
optFlag := False;
// コマンド入力中は、右上方向のみ
if cmdFlag and (dX > dXY) and (dY > dXY) then begin
HwndSendKeys(BcadMainWinHandle, #13);
Sleep(500);
end
// オプションの場合は全方向
else if optFlag and (abs(dX) > dXY) and (abs(dY) > dXY) then begin
HwndSendKeys(BcadMainWinHandle, #13);
Sleep(500);
end
// 一時オブジェクトスナップに変換できる時は、全方向
else if (optstr <> '') and (abs(dX) > dXY) and (abs(dY) > dXY) then begin
kbstr := makeObjectSnapStr('', optstr);
if kbstr <> '' then begin
HwndSendKeys(BcadMainWinHandle, kbstr);
Sleep(500);
end;
end;
// 基準座標を更新
curX := PT.X; curY := PT.Y;
end;
// 追従して終了
if not bcadflag then begin
if IsWindow(BcadMainWinHandle) then begin
bcadflag := True;
SetForegroundWindow(BcadMainWinHandle);
end;
end
else begin
if not IsWindow(BcadMainWinHandle) then begin
termFlag := True;
Close;
end;
end;
if not termFlag then
Timer1.Enabled := True;
end;
end.
