 |
||
＜入門者歓迎です。ベテランのあなた、VectorScriptの普及にお力添えを！＞ |
|
||
＜入門者歓迎です。ベテランのあなた、VectorScriptの普及にお力添えを！＞ |
クイックソートの原理を簡単に言うと、
『全体を中間値より大きい部分と小さい部分に分割することを繰り返す』のですが、
何処まで繰り返すのでしょうか？
単純に考えると、それ以上は分割不可能な『１個まで』となりますが、
値の重複があるとそう簡単ではありません。下手をすると無限ループになります。
それで if (left <= lt) & (rt <= right) then として、
並べ替えが起きなかったらそれ以上はQSort2を呼び出さないようにしたのですが、
pivotの値が並べ替え範囲内の最小値だった場合、その範囲内はソートされないバグがありました。
下のスクリプトではpivotは配列の両端と中央の値を平均しているので、
両端の平均または中央だけの値を使うよりはいいだろうと思っていましたが、
同じ値が３個あればpivotが最小値になる可能性はゼロではないので無視はできません。
というわけで、pivotより大きい値の数をカウントしてnRtに入れ、
nRtがゼロでなければopt(option)をTRUEにしてやり直すようにしました。
opt=TRUEのときは、全部の値を合計して平均値を出しています。
全ケースでpivotに全体の平均を使うようにすれば処理をやり直すことはなくなるし、
スクリプトも少し簡単になるので、そのほうが早くなる可能性はあります。
{////////////////////////////// QSort2
itemID でソート ////////////////////////////}
procedure QSort2(left, right:longint; opt:boolean);
var
＿＿i, j, lt, rt, nRt : longint;
＿＿pivot { 境界値 } : real;
＿＿temp : DM_item;
＿＿
＿＿{ 中間値を求める（opt=TRUEなら全ての値の平均） }
＿＿function GetPivot(opt:boolean):real;
＿＿var
＿＿＿＿i : longint;
＿＿＿＿sum : real;
＿＿begin
＿＿＿＿if opt then begin
＿＿＿＿＿＿sum:= 0;
＿＿＿＿＿＿for i:= left to right do
＿＿＿＿＿＿＿＿sum:= sum + itemArray[i].itemID;
＿＿＿＿＿＿GetPivot:= sum / (right - left + 1);
＿＿＿＿end
＿＿＿＿else
＿＿＿＿＿＿GetPivot:= (itemArray[left].itemID + itemArray[(left+right) div 2].itemID + itemArray[right].itemID) / 3;
＿＿end;{GetPivot}
begin{QSort2}
＿＿case (right - left) of
＿＿＿＿0: begin end;
＿＿＿＿1: begin
＿＿＿＿＿＿if itemArray[right].itemID < itemArray[left].itemID then begin
＿＿＿＿＿＿＿＿temp:= itemArray[right];
＿＿＿＿＿＿＿＿itemArray[right]:= itemArray[left];
＿＿＿＿＿＿＿＿itemArray[left]:= temp;
＿＿＿＿＿＿end;
＿＿＿＿＿＿DebugMessage(MaxDebug, left, right);
＿＿＿＿end;
＿＿＿＿otherwise begin
＿＿＿＿＿＿pivot:= GetPivot(opt);
＿＿＿＿＿＿lt:= left - 1;
＿＿＿＿＿＿rt:= right + 1; nRt:= 0;
＿＿＿＿＿＿for i:= left to right do begin
＿＿＿＿＿＿＿＿if itemArray[i].itemID < pivot then begin
＿＿＿＿＿＿＿＿＿＿lt:= lt + 1;
＿＿＿＿＿＿＿＿＿＿tempArray[lt]:= itemArray[i];
＿＿＿＿＿＿＿＿end{if}
＿＿＿＿＿＿＿＿else begin
＿＿＿＿＿＿＿＿＿＿rt:= rt - 1;
＿＿＿＿＿＿＿＿＿＿tempArray[rt]:= itemArray[i];
＿＿＿＿＿＿＿＿＿＿if pivot < itemArray[i].itemID then
＿＿＿＿＿＿＿＿＿＿＿＿nRt:= nRt + 1;
＿＿＿＿＿＿＿＿end;{else}
＿＿＿＿＿＿end;{for}
＿＿＿＿＿＿for i:= left to lt do
＿＿＿＿＿＿＿＿itemArray[i]:= tempArray[i];
＿＿＿＿＿＿j:= right;
＿＿＿＿＿＿for i:= rt to right do begin
＿＿＿＿＿＿＿＿itemArray[i]:= tempArray[j];
＿＿＿＿＿＿＿＿j:= j - 1;
＿＿＿＿＿＿end;
＿＿＿＿＿＿DebugMessage(MaxDebug, left, right);
＿＿＿＿＿＿if (left <= lt) & (rt <= right) then begin
＿＿＿＿＿＿＿＿QSort2(left, lt, false);
＿＿＿＿＿＿＿＿QSort2(rt, right, false);
＿＿＿＿＿＿end
＿＿＿＿＿＿else if 0 < nRt then
＿＿＿＿＿＿＿＿QSort2(left, lt, true);
＿＿＿＿end;{otherwise}
＿＿end;{case}
たくさんのデータをソート出来るように配列をマイナスから始めると、
何故かpivotの計算で「配列の範囲外にアクセスした」とエラーが出ました。
調べると、leftもrightもゼロ以下なのに、(left + right) div 2 がプラスの値になっていました。
具体的には両端が-32768と-31744なら平均は-32256になるはずですが、実際には512でした。
これはleftとrightをinteger型にしていたのが原因です。
integer型整数は16ビットなので、-32768〜+32767の範囲しか表せません。
ゼロから１を足してゆくと、0、1、2、3・・・32765、32766、32767、-32768、-32767、-32766、と、
32767の次はいきなり-32768になります。
おかしな話ですが、コンピュータの整数はそういうもんなんです。
Ｃ言語などでは符号無しの16ビット整数もあって、範囲は0〜65535です。
この場合、0、1、2、3・・・65533、65534、65535、0、1、2・・・となります。
実はCPU自体は16ビット整数の-1と65535を区別してなくて、
ある整数が符号付きか符合無しかは、コンパイラやプログラマの解釈次第ということです。
まあ、VectorScriptには符号付き整数しかないので、その辺は考えなくていいですが。
整数の計算結果が範囲外になってもエラーが出ないのは、たいていはその必要ないからです。
ちゃんとしたコンパイラならエラーを出すオプションがありますが、処理速度が落ちるし、
たいていはチェックしない方が都合がいいのでデフォルトでオフになってます。
というわけで、integer型で (-32768 + -31744) div 2 を計算すると、
まず、-32768 + -31744 は -64512 となりますが、
-64512は16ビット整数の範囲外なので、1024と解釈されます。
1024 div 2 は 512 なので、
(-32768 + -31744) div 2 = 512 という結果になります。
その他いろいろ不都合があってめんどうなので、
配列を参照する変数は全てlongint型に直しました。
与太郎さん、最後までありがとうございました。
実はDialogMakerなるものを作っていたのですが、最後の最後に回避出来ないバグに遭遇し
まして、放置しております。公開出来ず残念です...。
安定版クイックソートを修正しました。これで大丈夫だと思います。
PROCEDURE TestSort;
{ クイックソート（安定ソート） }
{ tempArrayでメモリを余分に使います }
{$ DEBUG}
CONST
＿＿MaxArray = 20;
＿＿MaxDebug = 20;
TYPE
＿＿DM_item = STRUCTURE
＿＿＿＿itemID : INTEGER;
＿＿＿＿itemName : STRING;
＿＿END ;
VAR
＿＿itemArray, tempArray : ARRAY[1..MaxArray] OF DM_item;
＿＿dataIndex : INTEGER ;
{////////////////////////////// AddData
配列をセット ////////////////////////////}
procedure AddData(id:integer; nm:string);
begin
＿＿dataIndex:= dataIndex + 1;
＿＿itemArray[dataIndex].itemID:= id;
＿＿itemArray[dataIndex].itemName:= nm;
end;
{////////////////////////////// DebugMessage
デバッグメッセージ ////////////////////////////}
procedure DebugMessage(n, st, ed:integer);
var
＿＿i : integer;
＿＿s : string;
begin
＿＿s:= Concat(st, '..', ed, ' ');
＿＿for i:= 1 to n do begin
＿＿＿＿s:= Concat(s, '__', itemArray[i].itemID, ':', itemArray[i].itemName);
＿＿end;
＿＿Message(s);
＿＿WriteLn(s);
end;
{////////////////////////////// QSort2
itemID でソート ////////////////////////////}
procedure QSort2(left, right:integer);
var
＿＿i, j, lt, rt : integer;
＿＿pivot { 境界値 } : real;
＿＿temp : DM_item;
begin
＿＿case (right - left) of
＿＿＿＿0: begin end;
＿＿＿＿1: begin
＿＿＿＿＿＿if itemArray[right].itemID < itemArray[left].itemID then begin
＿＿＿＿＿＿＿＿temp:= itemArray[right];
＿＿＿＿＿＿＿＿itemArray[right]:= itemArray[left];
＿＿＿＿＿＿＿＿itemArray[left]:= temp;
＿＿＿＿＿＿end;
＿＿＿＿＿＿DebugMessage(MaxDebug, left, right);
＿＿＿＿end;
＿＿＿＿otherwise begin
＿＿＿＿＿＿pivot:= (itemArray[left].itemID + itemArray[(left+right) div 2].itemID + itemArray[right].itemID) / 3;
＿＿＿＿＿＿lt:= left - 1;
＿＿＿＿＿＿rt:= right + 1;
＿＿＿＿＿＿for i:= left to right do begin
＿＿＿＿＿＿＿＿if itemArray[i].itemID < pivot then begin
＿＿＿＿＿＿＿＿＿＿lt:= lt + 1;
＿＿＿＿＿＿＿＿＿＿tempArray[lt]:= itemArray[i];
＿＿＿＿＿＿＿＿end{if}
＿＿＿＿＿＿＿＿else begin
＿＿＿＿＿＿＿＿＿＿rt:= rt - 1;
＿＿＿＿＿＿＿＿＿＿tempArray[rt]:= itemArray[i];
＿＿＿＿＿＿＿＿end;{else}
＿＿＿＿＿＿end;{for}
＿＿＿＿＿＿for i:= left to lt do
＿＿＿＿＿＿＿＿itemArray[i]:= tempArray[i];
＿＿＿＿＿＿j:= right;
＿＿＿＿＿＿for i:= rt to right do begin
＿＿＿＿＿＿＿＿itemArray[i]:= tempArray[j];
＿＿＿＿＿＿＿＿j:= j - 1;
＿＿＿＿＿＿end;
＿＿＿＿＿＿DebugMessage(MaxDebug, left, right);
＿＿＿＿＿＿if (left <= lt) & (rt <= right) then begin
＿＿＿＿＿＿＿＿QSort2(left, lt);
＿＿＿＿＿＿＿＿QSort2(rt, right);
＿＿＿＿＿＿end;
＿＿＿＿end;{otherwise}
＿＿end;{case}
end;
{////////////////////////////// Main ////////////////////////////}
BEGIN
＿＿dataIndex:= 0;
＿＿AddData(5, 'mmm');
＿＿AddData(5, 'nnn');
＿＿AddData(5, 'ooo');
＿＿AddData(2, 'ddd');
＿＿AddData(2, 'eee');
＿＿AddData(2, 'fff');
＿＿AddData(7, 'sss');
＿＿AddData(7, 'ttt');
＿＿AddData(1, 'aaa');
＿＿AddData(1, 'bbb');
＿＿AddData(1, 'ccc');
＿＿AddData(4, 'jjj');
＿＿AddData(4, 'kkk');
＿＿AddData(4, 'lll');
＿＿AddData(3, 'ggg');
＿＿AddData(3, 'hhh');
＿＿AddData(3, 'iii');
＿＿AddData(6, 'ppp');
＿＿AddData(6, 'qqq');
＿＿AddData(6, 'rrr');
＿＿
＿＿DebugMessage(MaxDebug, 1, MaxDebug);＿＿QSort2(1, MaxDebug);
＿＿AlrtDialog('結果は Output File(Output.txt) に書き出しました。');
END;
RUN(TestSort);
元々はprocedure QSort2の上にprocedure QSortがあったのでエラーが出なかったんです。
ここに貼付ける前にいらない行を消しました。確認するまでもないと思ったら、大間違いでした。
要するに、最初以降はQSortを呼んでいたんですね。こりゃあいくら修正しても直らないはずだ。
ホント困ります。他の方法で回避できればいいんですが、できないものもありますしね。
ちなみに与太郎さん
＞QSort(left, lt);
＞QSort(rt, right);
違っています（笑）問題はこれじゃないですけど。
アイデアが出てからバグのないバージョンの完成まで20年くらいかかったと、
何かで読んだ記憶があります。こんなに短いのになんで？って感じですが。
もちろんPASCALもデバッガもない頃の話です。
配列内で要素を移動してるうちにわけがわからなくなるからでしょうか。
そこで元の配列の他にもう１つ配列を使うと、左右への振り分けが判りやすくなります。
また、クイックソートは不安定ソートですが、２つの配列を使えば簡単に安定させられるはずです。
PROCEDURE TestSort ;
{$ DEBUG}
CONST
＿＿MaxArray = 20;
＿＿MaxDebug = 20;
TYPE
＿＿DM_item = STRUCTURE
＿＿＿＿itemID : INTEGER ;
＿＿＿＿itemName : STRING ;
＿＿END ;
VAR
＿＿itemArray, tempArray : ARRAY[1..MaxArray] OF DM_item ;
＿＿dataIndex : INTEGER ;
{////////////////////////////// AddData
配列をセット ////////////////////////////}
procedure AddData(id:integer; nm:string);
begin
＿＿dataIndex:= dataIndex + 1;
＿＿itemArray[dataIndex].itemID:= id;
＿＿itemArray[dataIndex].itemName:= nm;
end;
{////////////////////////////// DebugMessage
デバッグメッセージ ////////////////////////////}
procedure DebugMessage(n:integer);
var
＿＿i : integer;
＿＿s : string;
begin
＿＿for i:= 1 to n do begin
＿＿＿＿s:= Concat(s, '__', itemArray[i].itemID, ':', itemArray[i].itemName);
＿＿end;
＿＿Message(s);
＿＿WriteLn(s);
end;
{////////////////////////////// QSort2
itemID でソート ////////////////////////////}
procedure QSort2(left, right : INTEGER);
var
＿＿i, j, lt, rt : INTEGER;
＿＿pivot { 境界値 } : REAL;
＿＿temp : DM_item;
begin
＿＿case (right - left) of
＿＿＿＿0: begin end;
＿＿＿＿1: begin
＿＿＿＿＿＿if itemArray[right] < itemArray[left] then begin
＿＿＿＿＿＿＿＿temp:= itemArray[right];
＿＿＿＿＿＿＿＿itemArray[right]:= itemArray[left];
＿＿＿＿＿＿＿＿itemArray[left]:= temp;
＿＿＿＿＿＿＿＿DebugMessage(MaxDebug);
＿＿＿＿＿＿end;
＿＿＿＿end;
＿＿＿＿otherwise begin
＿＿＿＿＿＿pivot:= (itemArray[left].itemID + itemArray[(left+right) div 2].itemID + itemArray[right].itemID) / 3;
＿＿＿＿＿＿lt:= left - 1;
＿＿＿＿＿＿rt:= right + 1;
＿＿＿＿＿＿for i:= left to right do begin
＿＿＿＿＿＿＿＿if itemArray[i].itemID < pivot then begin
＿＿＿＿＿＿＿＿＿＿lt:= lt + 1;
＿＿＿＿＿＿＿＿＿＿tempArray[lt]:= itemArray[i];
＿＿＿＿＿＿＿＿end{if}
＿＿＿＿＿＿＿＿else begin
＿＿＿＿＿＿＿＿＿＿rt:= rt - 1;
＿＿＿＿＿＿＿＿＿＿tempArray[rt]:= itemArray[i];
＿＿＿＿＿＿＿＿end;{else}
＿＿＿＿＿＿end;{for}
＿＿＿＿＿＿for i:= left to lt do
＿＿＿＿＿＿＿＿itemArray[i]:= tempArray[i];
＿＿＿＿＿＿j:= right;
＿＿＿＿＿＿for i:= rt to right do begin
＿＿＿＿＿＿＿＿itemArray[i]:= tempArray[j];
＿＿＿＿＿＿＿＿j:= j - 1;
＿＿＿＿＿＿end;
＿＿＿＿＿＿DebugMessage(MaxDebug);
＿＿＿＿＿＿QSort(left, lt);
＿＿＿＿＿＿QSort(rt, right);
＿＿＿＿end;{otherwise}
＿＿end;{case}
end;
{////////////////////////////// Main ////////////////////////////}
BEGIN
＿＿dataIndex:= 0;
＿＿AddData(5, 'mmm');
＿＿AddData(5, 'nnn');
＿＿AddData(5, 'ooo');
＿＿AddData(2, 'ddd');
＿＿AddData(2, 'eee');
＿＿AddData(2, 'fff');
＿＿AddData(7, 'sss');
＿＿AddData(7, 'ttt');
＿＿AddData(1, 'aaa');
＿＿AddData(1, 'bbb');
＿＿AddData(1, 'ccc');
＿＿AddData(4, 'jjj');
＿＿AddData(4, 'kkk');
＿＿AddData(4, 'lll');
＿＿AddData(3, 'ggg');
＿＿AddData(3, 'hhh');
＿＿AddData(3, 'iii');
＿＿AddData(6, 'ppp');
＿＿AddData(6, 'qqq');
＿＿AddData(6, 'rrr');
＿＿DebugMessage(MaxDebug);
＿＿
＿＿QSort2(1, MaxDebug);
＿＿AlrtDialog('結果は Output File(Output.txt) に書き出しました。');
END;
RUN(TestSort);
で、安定ソートなら上のデータがabc順に並び替えられるはずですが、そうなりません。
悩ましいです。
あまりの要素の多さに...。なるほど、今回は非常に助かりました、masafumiさん。
最後の壁を乗り越えれば完成なんですが...。
どうも、masafumi です。要素数だけソートすると大変だなぁ・・・。と思い、ちょっとチェックしてみました。(^^;)
var
temp2:DM_item;
begin
・・・・・・・
・・・・・・
temp := itemArray[ ii ].itemID ;
temp2:=itemArray[ii];
itemArray[ ii ].itemID := itemArray[ jj ].itemID ;
itemArray[ ii ]:=itemArray[ jj ];
itemArray[ jj ].itemID := temp ;
itemArray[ jj ]:=temp2;
・・・・・・・
・・・・・・
end;
これで要素数に関係なく行けそうです。お騒がせ致しました。
どうもmasafumiさん！
なるほど、構造体の要素分だけtempが必要になるんですね。実際はもっと多いので出来る
だけ要素をへらした方がいいかな。
こんばんは、masafumi です。
itemID と同時に itemName も変更する必要が有ります。
下記は変数に temp2 を追加して temp2 に itemName を保存しています。
SSort()は必要ないと思います。
{////////////////////////////// QSort itemID でソート ////////////////////////////}
PROCEDURE QSort( left, right : INTEGER ) ;
VAR
ii, jj : INTEGER ;
pivot { 境界値 } : REAL ;
temp : INTEGER ;
temp2: STRING;
BEGIN
IF left < right THEN BEGIN
pivot := ( itemArray[ left ].itemID+itemArray[ right ].itemID )/2 ;
ii := left ;
jj := right ;
REPEAT
WHILE itemArray[ ii ].itemID < pivot DO
ii := ii+1 ;
WHILE itemArray[ jj ].itemID > pivot DO
jj := jj-1 ;
IF ii <= jj THEN
BEGIN
temp := itemArray[ ii ].itemID ;
temp2:= itemArray[ii].itemName;
itemArray[ ii ].itemID := itemArray[ jj ].itemID ;
itemArray[ ii ].itemName := itemArray[ jj ].itemName ;
itemArray[ jj ].itemID := temp ;
itemArray[ jj ].itemName := temp2 ;
ii := ii+1 ;
jj := jj-1 ;
END ;{ End of if }
UNTIL ii > jj ;
QSort( left , jj ) ;
QSort( ii, right ) ;
END ;{ End of if }
END ;
構造体を使った配列でソートを行うと間違った結果になります。どこがおかしいのか分か
りません。30〜40ぐらいの配列の大きさを想定していますので、特にスピードは要求しま
せん。
PROCEDURE TestSort ;
TYPE
DM_item = STRUCTURE
itemID : INTEGER ;
itemName : STRING ;
END ;
VAR
itemArray : ARRAY[ 1..5 ] OF DM_item ;
{////////////////////////////// QSort
itemID でソート ////////////////////////////}
PROCEDURE QSort( left, right : INTEGER ) ;
VAR
ii, jj : INTEGER ;
pivot { 境界値 } : REAL ;
temp : INTEGER ;
BEGIN
IF left < right THEN BEGIN
pivot := ( itemArray[ left ].itemID+itemArray[ right ].itemID )/2 ;
ii := left ;
jj := right ;
REPEAT
WHILE itemArray[ ii ].itemID < pivot DO
ii := ii+1 ;
WHILE itemArray[ jj ].itemID > pivot DO
jj := jj-1 ;
IF ii <= jj THEN BEGIN
temp := itemArray[ ii ].itemID ;
itemArray[ ii ].itemID := itemArray[ jj ].itemID ;
itemArray[ jj ].itemID := temp ;
ii := ii+1 ;
jj := jj-1 ;
END ;{ End of if }
UNTIL ii > jj ;
QSort( left , jj ) ;
QSort( ii, right ) ;
END ;{ End of if }
END ;
{////////////////////////////// SSort
itemID でソート ////////////////////////////}
PROCEDURE SSort( Max_int : INTEGER ) ;
VAR
ii , jj ,w : INTEGER ;
BEGIN
ii := 0 ;
jj := ii+1 ;
WHILE ii < Max_int-1 DO BEGIN
ii := ii+1 ;
WHILE jj < Max_int DO BEGIN
jj := jj+1 ;
IF itemArray[ jj ].itemID < itemArray[ ii ].itemID THEN BEGIN
w := itemArray[ jj ].itemID ;
itemArray[ jj ].itemID := itemArray[ ii ].itemID ;
itemArray[ ii ].itemID := w ;
END ;
END ;
END ;
END ;
{////////////////////////////// Main ////////////////////////////}
BEGIN
itemArray[ 1 ].itemID := 5 ; itemArray[ 1 ].itemName := 'bbb' ;
itemArray[ 2 ].itemID := 4 ; itemArray[ 2 ].itemName := 'aaa' ;
itemArray[ 3 ].itemID := 6 ; itemArray[ 3 ].itemName := 'ccc' ;
itemArray[ 4 ].itemID := 8 ; itemArray[ 4 ].itemName := 'eee' ;
itemArray[ 5 ].itemID := 7 ; itemArray[ 5 ].itemName := 'ddd' ;
QSort( 1, 5 ) ;
SSort( 5 ) ;
AlrtDialog( Concat( itemArray[ 1 ].itemID , '=' , itemArray[ 1 ].itemName , ' ' ,itemArray[ 2 ].itemID , '=', itemArray[ 2 ].itemName ) ) ;
END ;
RUN( TestSort ) ;
石男さん、サイトの紹介ありがとうございます。
対応バージョンが書いてあるのがちょっと嬉しい。
SDKサブルーチンライブラリの丁寧な解説ありがとうございました。
File関係など使えそうなのもあります。ちなみに「HiBase」はなくなっております。
その代わりxmlが使えます。複雑な構造にしなければ充分にいけます。
SDKサブルーチンライブラリについて少ない情報ですが以下のサイトで取れます。ここに
なければ後は自力で...
http://charles-chandler.org/
＞実行時の単位で-1ですか？
違うようです。-1mmなのかな微妙です。
SDKサブルーチンライブラリとは、VectorWorks plug-in libraryのことです。
VectorScriptプラグインのxxx.vssやxxx.xxtに相当します。
CPUで直接実行するバイナリ形式なので、VectorScriptより格段に高速です。
そのかわり開発にはC++コンパイラとSDK(Software Deveropment Kit)が必要です。
SDKで作るからSDKサブルーチンライブラリと呼んでいます。
SDKサブルーチンライブラリがPlug-insフォルダにあると、VWは起動時にサブルーチンを読み込みます。
それらのサブルーチンは、標準組込みサブルーチン（VSリファレンスに載ってるやつ）と同じように、
VectorScriptで使用できます。
読み込み時に「VWPluginLibraryRoutines.p」と「VWPluginLibraryRoutines.h」にヘッダが書き出されます。
ですから「VWPluginLibraryRoutines.p」を見れば、どんなサブルーチンが追加されているか判ります。
だだし、パラメータや実行結果の説明はありません。
NNAやAAAが注力している「イベント」や「HiBase」については多少は情報がありますが、
開発者自身の使用しか想定していないものは当然何の説明もないので、
常識で判断するか、自分で動作確認することになります。
つまり「使用は自己責任で」ということです。
＞変換された多角形はy方向に-1だけズレて出来ます。
えっ、そういう仕様なんですか？
実行時の単位で-1ですか？
では、SDKサブルーチンライブラリよりもうひとつ！DoMenuで「TrueTypeを多角形に変換」
を使うとうまく制御できなかったりしたものです。そこで...
PROCEDURE xxxx ;
VAR
txtH , polyH : HANDLE ;
something : LONGINT ;
boo : BOOLEAN ;
BEGIN
MoveTo( 0 , 0 ) ;
CreateText( 'TrueTypeToPoly' ) ;
txtH := LNewObj ;
something := TrueTypeToPoly( txtH, polyH ) ;
boo := SetParent( polyH, GetParent ( txtH ) );
END ;
RUN( xxxx ) ;
これで完全に制御できます。変換された多角形はy方向に-1だけズレて出来ます。
全て与太郎殿のご説明の通りでございます。
＞「最上位」の図形は最前面ではなく最背面にある
よくある話です、まあ説明なしよりはいいのですが...。ターゲット図形のハンドルを取る
ためのサブルーチンをつくるのが面倒なので、ご指摘の通りSDKサブルーチンライブラリか
ら関数を探しました（笑）
＞FindObjAtPt_CreateとFindObjAtPt_GetCount
まあこんな便利な物は表に出してもらいたいものです。
説明しよう！、（富山敬風に）
＞PickObjectを使うと任意の座標点の下にある最上位の図形のハンドルが返ります。
VSリファレンスで言うところの「最上位」とは、見た目で一番上（前面）の図形のことではない。
図形ハンドルリストの最初の図形ということである。「最上位」はFirstの誤訳と思われる。
したがって、マニュアルの「最上位」は「最初」と読み替えることが必要だ。
図形は描いた順にリストにリンクされるので、「最上位」の図形は最前面ではなく最背面にある。
通常、VSサブルーチンはリストの最初から図形を検索するので、
多くのサブルーチンが戻り値として「最上位」の図形ハンドルを返す。
座標の下に複数の図形があった場合にPickObjectでどの図形のハンドルが返ってくるかは、
下のスクリプトで試していただきたい。
procedure test;
var
x, y :real;
h :handle;
begin
DSelectAll;
Message('選択したい図形をクリックしてください');
GetPt(x, y);
h:= PickObject(x, y);
SetSelect(h);
ClrMessage;
end;
Run(test);
お分かりのように、選択されるのは最前面の図形である。
これは選択ツールと同じ動作なので、使う方も混乱する心配が無い。
つまり通常とは反対に、PickObjectの内部ではリンクの最後から図形を検索しているのである。
と言うわけで、フッフッフッ石男殿！
「PickObjectでは任意の座標点の下にある最後（最前面）の図形のハンドルが返る」のでござる！
ご油断召されましたな。しかも...
拙者の見たところFindObjAtPt_CreateとFindObjAtPt_GetCountはVSリファレンスに載っておらぬ。
つまりこれはSDKサブルーチンライブラリで追加された関数である。
ここのところの説明が、ちと足りぬようじゃが、いかがかの石男殿？
PickObjectを使うと任意の座標点の下にある最上位の図形のハンドルが返ります。座標の
下に複数の図形があった場合どうするの？という疑問が湧いてきまして、自力で考えられ
ず探したら出てきました。2009では動作確認済み、それ以外は分かりません。
PROCEDURE xxxxx;
VAR
cnt, i : INTEGER;
startContainer : HANDLE;
list : LONGINT;
loc: VECTOR;
BEGIN
GetPt(loc.x, loc.y);
startContainer := NIL;
list := FindObjAtPt_Create(startContainer, 1, 0, loc.x, loc.y, 1);
cnt := FindObjAtPt_GetCount(list);
i := 0;
WHILE i < cnt DO BEGIN
AlrtDialog(Concat('Index: ', i, ' Obj Type: ', GetType(FindObjAtPt_GetObj(list, i))));
i := i + 1;
END;
END;
Run(xxxxx);
オブジェクト（プラグインオブジェクト）は通常、「回転、移動で実行」というタイミン
グでスクリプトが動きますが、「指定されたイベントで実行」という選択肢があります。
データパレットの中にプッシュボタンがついているのをイメージしてもらえば、分ると
思います。このボタンを付けるためのサンプルです。
オブジェクトにも種類があり、それによってやり方が変わりますが、基本の部分は同じ
です。情報源は全て英語ですし、基本的にサポートなしの世界なので気合いがある人のみ
勧めます。
備忘録的にサンプルをアップします。「プロパティ」ー「指定されたイベントで実行」に
チェックをいれてお使いください。この辺りはサポートなしですので、苦情は困ります。
オブジェクトにボタンをつけて、そのボタンをクリックすると基本的にオブジェクトの外
に飛び出します。オブジェクトそのものを更新したい時はGetCustomObjectInfoなどで自分自身を呼び出す必要があります。
{Object that has a button on the Object Info palette: }
PROCEDURE Example ;
CONST
kObjOnInitXProperties = 5;
kResetEventID = 3;
kObjXPropHasUIOverride = 8;
kWidgetButton = 12;
kObjOnObjectUIButtonHit = 35;
VAR
theEvent, theButton :LONGINT;
result :BOOLEAN;
buttonEventID :INTEGER;
thisDoesNothing :LONGINT;
glovalHd ,objHand , recHand , wallHand : HANDLE ;
objName : STRING ;
x , y , obj_ang : REAL ;
{///////////////Dialog Variable///////////////}
lEditID : LONGINT ;
co_index : INTEGER ;
fill_color , pen_color : RGBCOLOR ;
{////////////////////////////////dialog_Setup///////////////////////////////}
FUNCTION dialog_Setup : BOOLEAN ;
BEGIN
lEditID := CreateLayout( 'Color Control' , true , 'OK' , 'Cancel' ) ;
CreateStaticText(lEditID, 4 , '線の色:' , 12 ) ;
CreateColorPopup(lEditID, 5 , 24 ) ;
CreateStaticText(lEditID, 6 , '面の色:' , 12 ) ;
CreateColorPopup(lEditID, 7 , 24 ) ;
SetFirstLayoutItem(lEditID, 4 ) ;
SetRightItem( lEditID, 4 , 5 , 0 , 0 ) ;
SetBelowItem( lEditID, 4 , 6 , 0 , 0 ) ;
SetRightItem( lEditID, 6 , 7 , 0 , 0 ) ;
dialog_Setup := VerifyLayout( lEditID ) ;
END ;
{///////////////////////////////dialog_Handler////////////////////////////////}
PROCEDURE dialog_Handler( VAR item : LONGINT ; data : LONGINT ) ;
BEGIN
CASE item OF
{ dialog initialization }
SetupDialogC:
BEGIN
END ;
{ user selected OK }
1:
BEGIN
GetColorChoice( lEditID, 5 , co_index ) ;
ColorIndexToRGB( co_index , pen_color.red , pen_color.green , pen_color.blue ) ;
GetColorChoice( lEditID, 7 , co_index ) ;
ColorIndexToRGB( co_index , fill_color.red , fill_color.green , fill_color.blue ) ;
END ;
END ;{ End of CASE item }
END ;
{//////////////////////////////////MAIN///////////////////////////////////////}
BEGIN
vsoGetEventInfo(theEvent, theButton);
CASE theEvent OF
{User has single-clicked the object's icon.}
kObjOnInitXProperties:
BEGIN
{ Buttonを付ける時の決まり事 vsoAppendWidgetとセットで }
result := SetObjPropVS(kObjXPropHasUIOverride, TRUE);
{Now we manually add the "normal" parameters...}
{One way is to use this single call to add all
of the existing parameters.}
result := vsoInsertAllParams;
{Finally, we add the button. 3番目の引数は関係なし }
result := vsoAppendWidget(kWidgetButton, 10 , '新規作成...', thisDoesNothing);
result := vsoAppendWidget(kWidgetButton, 11 , '変更...', thisDoesNothing);
END;
{User has clicked a button in the Object Info palette.}
kObjOnObjectUIButtonHit:
BEGIN
CASE theButton OF
10:
BEGIN
IF dialog_Setup THEN BEGIN
{ RunLayoutDialog 1=ok 2=cancel }
IF RunLayoutDialog( lEditID , dialog_Handler ) = 1 THEN BEGIN
Rect(0, 0, 10, 10);
glovalHd := LNewObj ;
SetFillBack( glovalHd , fill_color.red , fill_color.green , fill_color.blue ) ;
SetPenFore( glovalHd , pen_color.red , pen_color.green , pen_color.blue ) ;
END ;
END ;{ End of dialog_Setup }
END;
11:
BEGIN
IF dialog_Setup THEN BEGIN
{ RunLayoutDialog 1=ok 2=cancel }
IF RunLayoutDialog( lEditID , dialog_Handler ) = 1 THEN BEGIN
IF GetCustomObjectInfo( objName , objHand , recHand , wallHand ) THEN BEGIN
SetFillBack( objHand , fill_color.red , fill_color.green , fill_color.blue ) ;
SetPenFore( objHand , pen_color.red , pen_color.green , pen_color.blue ) ;
ResetObject( objHand ) ;
END ;
END ;
END ;{ End of dialog_Setup }
END ;
END;
END;
{Object内の図形はここで書く}
kResetEventID:
BEGIN
Rect(0, 0, 10, 10);
END;
END;
END;
Run(Example);
＞江戸の黒板当番さま
作業画面の設計で、カテゴリが「AA建築申請」のメニューコマンドとツールを
新しいメニュー「建築申請」とツールセット「建築申請」に登録しました。
１回目は「○○○+建築申請」の名前で保存に失敗したので、
２回目は名前をそのままにしたら保存出来ました。
でも、最初に失敗したのがたまたまか名前のせいかは判りません。
与太郎さま
お世話になっています。
＞12.5用の作業画面を読み込めなかったのでメニューとツールの登録が必要でしたが、
＞一見問題なく動いているようです。
動いているんですか。作業画面が読み込めない時点でつまずいていますんで
メニューとツールの登録についても教えていただけませんか？
マニュアルを超えた話の様な．．．．．．
50程度のファイルなら、スクリプトを書いて動作を確認する間に、
手作業で変換が終わってしまうと思います。
ただ、物件ごとに50件だとやはり面倒なので、
MacOSXのAppleScriptで自動変換する方法を書いてみます。
複数ファイルを対象とするにはAppleScriptをアプレットにします。
ファイルをドラッグ＆ドロップでアプレットに落とせば、スクリプトを実行できます。
個々のファイルの処理は、
ファイルを開く、
ファイル書き出すメニューコマンドを実行、
ファイル保存ダイアログが開くまで待つ、
「OK」ボタンを押す（または「Enter」キーを押す）、
書き出しが終わるまで待つ、
ファイルを閉じる、
保存警告ダイアログが出たら「いいえ」ボタンを押す（または「Command」+「d」を押す）
のようになります。
スクリプトを簡単にするために、
VectorWorksはあらかじめ起動しておきます。
また、書き出しコマンドには「Command」+「Option」+「s」を割り当てます。
ファイルを閉じるときに保存警告ダイアログが出たり出なかったりすると面倒なので、
DoScript" "で適当なVectorScriptを実行して、必ずダイアログが出るようにします。
AppleScriptでは「System Events」経由でキーの打ちこみが可能なので、
適当なタイミングでキーを打つ方法でスクリプトは書けます。
on open | selectFiles |
＿＿tell application "Finder"
＿＿＿＿repeat with | currFile | in | selectFiles |
＿＿＿＿＿＿set | filePath | to (| currFile | as string)
＿＿＿＿＿＿if folder | filePath | exists then
＿＿＿＿＿＿else
＿＿＿＿＿＿＿＿open | currFile |
＿＿＿＿＿＿＿＿delay 3
＿＿＿＿＿＿＿＿tell application "VectorWorks11.5"
＿＿＿＿＿＿＿＿＿＿DoScript " Message('変換中...'); "
＿＿＿＿＿＿＿＿end tell
＿＿＿＿＿＿＿＿tell application "System Events"
＿＿＿＿＿＿＿＿＿＿tell process "VectorWorks11.5"
＿＿＿＿＿＿＿＿＿＿＿＿keystroke "s" using {command down, option down}
＿＿＿＿＿＿＿＿＿＿＿＿delay 1
＿＿＿＿＿＿＿＿＿＿＿＿keystroke return
＿＿＿＿＿＿＿＿＿＿＿＿delay 3
＿＿＿＿＿＿＿＿＿＿end tell
＿＿＿＿＿＿＿＿end tell
＿＿＿＿＿＿＿＿tell application "VectorWorks11.5"
＿＿＿＿＿＿＿＿＿＿activate
＿＿＿＿＿＿＿＿＿＿DoScript " ClrMessage; "
＿＿＿＿＿＿＿＿end tell
＿＿＿＿＿＿＿＿tell application "System Events"
＿＿＿＿＿＿＿＿＿＿tell process "VectorWorks11.5"
＿＿＿＿＿＿＿＿＿＿＿＿keystroke "w" using {command down}
＿＿＿＿＿＿＿＿＿＿＿＿delay 1
＿＿＿＿＿＿＿＿＿＿＿＿keystroke "d" using {command down}
＿＿＿＿＿＿＿＿＿＿end tell
＿＿＿＿＿＿＿＿end tell
＿＿＿＿＿＿＿＿delay 2
＿＿＿＿＿＿end if
＿＿＿＿end repeat
＿＿end tell
end open
アプリの名前を変えている場合は、その名前でないとアプリの切り替えが出来ません。
所々にdelayがあるのは、VWの動作（ダイアログを開く等）とのタイミングを取るためです。
Delayが短かすぎるとAppleScriptがVWを追い越してしまって、ファイルを書き出せなかったり
ファイルが閉じなかったりするので、Macの性能が違うと調整が必要です。
AppleScriptではOSXアプリの全てのUI要素にアクセス出来ます。
UI要素とは、ウィンドウ、パレット、ボタン、メニューなど、ドキュメントウインドウの中身
以外の部分です。
「UIElementInspector」や「UI Browser」でUI要素の名前を調べれば、特定のボタンを押したり、
ダイアログが開いているかを判断して実行するスクリプトも書けます。
「UI Browser」ではAppleScriptの自動生成してくれるようです。
2009で建築申請を試してみました。
12.5用の作業画面を読み込めなかったのでメニューとツールの登録が必要でしたが、
一見問題なく動いているようです。
与太郎さま早速ありがとうございます。
基本的な機能拡張用のスクリプトの変更の仕方だと思うのですよ。
ソースがオープンになることで突然、自己責任でといわれても
途方に暮れてしまいますよね。
2009のデモ版でもちょっとお試しくださいませ。
2009は手元にないので2008（デモ版）に入れてちょこっと見ただけですが、
「建築申請書類作成...」で文字化けする症状なら、
とりあえずSetTextFontの行をコメントアウトしたら日本語になりました。
確認申請の申請書も1Fileにしておくためには外せないPluginなんですが
Workspacesがだめなのかな、上手く動きません。
http://www.aanda.co.jp/VIPRoom/vsot/downloadextra.htm
ここのです。
http://www.aanda.co.jp/VIPRoom/vsot/index.htm
でソースがオープンになっているのですがアップデートに
ご協力というより使えるようにしていただける方募集です。
まあ、どれから始めたら良いものかなど教えて下さい。
タニさん、こんばんは。
データパレットにボタンを付ける方法は、VectorScript談話室2004（バックナンバー）の
石男さんのレス「イベント実行」のサンプルで判ると思います。
＞与太郎様
早速のご指導ありがとうございます。
ご指摘頂いた「特定イベント」でカスタムダイアログを開く方法ですが、
正多角形ツールのデータパレットにある「頂点を追加」のようなボタンを押して
ダイアログが開くように設定することは可能でしょうか。
パラメータを設定する際の「型」の選択項目にボタンの項目がないので、
何か他の方法で設定が可能なのでしょうか。
以上、ご指導をお願いいたします。
FUNCTION GetCustomObjectChoice(objectName:STRING; parameterName:STRING; choiceIndex:INTEGER):STRING;
で、ポップアップパラメータのアイテムを調べることは出来ますが、
ポップアップパラメータのアイテムを書き換えるサブルーチンはありません。
プラグインオブジェクトのフォントを変えるには、
「特定イベント」でカスタムダイアログを開いて、ダイアログ内のポップアップメニュー
からフォントを選ぶか、
GetObjectVariableBoolean(h, 800, TRUE); でプラグインオブジェクトのフォントを
フォントメニューから変更出来るように指定してください。
現在、プラグインオブジェクトを作成しており、
プラグインオブジェクトに表示される文字のフォントを変更可能にしたいと思っています。
方法としてはパラメータのPop-upリストにフォントリストを表示させ、
そこから選択できるようにしたいのですが、scriptの組み方が分かりません。
イメージは文字ツールで文字を作成した時にデータパレットに表示されるフォントリストです。
・GetFontName(fontID:INTEGER);で取得したフォント名を
パラメータに表示させる方法が考えられますが、scriptが分かりません。
分かる方、ご指導をお願いいたします。
喫茶室に書き込んで下さい。
移動しました。
