与太郎さん、度々ありがとうございます。
また、丁寧な回答で恐縮いたします。
さて、「VectorScript Function Reference」の「LSActLayer」の説明には
「選択されている最下位の図形のハンドルを返します。」とありますが、実際には、与太郎さんの
説明のように「一番上の選択図形」を認識しているようです。マニュアルの間違いでしょうか。
そもそも「ハンドルを返します。」という記述が理解できずにいましたが、
図形を選択しているという情報をもらうことで、選択されていない状態を「nil」として与えてくれる
というような理解の仕方でよいでしょうか。
参考のスクリプトは大変参考になりました。
勉強の足がかりとして大変貴重なものとなります。ありがとうございます。

VWフォルダ＞「付属マニュアル」＞「VectorScript」の中に、VSBeginnersGuide.pdfがあります。
これでVectorScript Guide（英語版しかありません）の内容の８割方は押さえられます。
VSBeginnersGuide.pdfには無くてVectorScript Guideにしか載っていない重要な事項としては、
構造体(Structures)と動的配列(Dynamic Arrays)がありますが、これは日本語に訳したものが、
エーアンドエーのHP＞「開発」＞「旧バージョン」＞「マニュアル和訳」の中にあります。

「MiniPascal」、「VectorScript」でネットを検索すれば、
スクリプトに関する情報は結構見つかります。
入門者向けサイトもいくつかあります。
ただ残念なことに、エーアンドエーのサイトも含めて、ほとんどが中断状態なんですね。

SetNameはマニュアルで下のように説明されています。

−−−−−−−−−−−−−−−−−−−−−−−
PROCEDURE SetName(h:HANDLE; name:STRING);

h　 　 HANDLE　 図形のハンドル
name　 STRING　 図形の名前

ハンドルが指す図形の名前を変更します。
−−−−−−−−−−−−−−−−−−−−−−−

ハンドルとはオブジェクト（図形、レイヤ、レコード等）を指し示すものです。
スクリプトで個々の図形にアクセスするにはハンドルを使いこなす必要があります。

図形のハンドルを得る方法は、
FSActLayer, FActLayer等のハンドル取得関数を使う。
GetPtとPickObjectを使い、マウスクリック位置の図形のハンドルを得る。
ForEachObject等で、条件に一致した図形のハンドルをサブルーチンに渡してやる。
等の方法があります。

例として、アクティブレイヤの一番上の選択図形の名前を変えるスクリプトを書いてみます。
（データパレットで出来ることですが）
procedure ChangeObjectName;
var
＿objHand＿:handle;
＿newName, oldName＿:string;
begin
＿objHand:= LSActLayer;{ Last(=Top) Object Selected in Active Layer }
＿if objHand = nil then begin
＿＿AlrtDialog('アクティブレイヤの図形が選択されていません！');
＿end
＿else begin
＿＿oldName:= GetName(objHand);
＿＿newName:= StrDialog('図形の名前＝', oldName);
＿＿if not DidCancel & (oldName <> newName) then begin
＿＿＿if GetObject(newName) = nil then begin
＿＿＿＿SetName(objHand, newName);
＿＿＿end
＿＿＿else begin
＿＿＿＿AlrtDialog(Concat(newName, 'はすでに使われています！'));
＿＿＿end;
＿＿end;
＿end;
end;
Run(ChangeObjectName);

与太郎さん　ありがとうございます。
私、VectorScriptは、ほとんど素人です。『DoMenuTextByName』はなんとなく使えたのですが、
『SetName(objHand, name);』は、なんとなくでは動かせませんでした。
関数の基本的なことを理解していないので恥ずかしいのですが、「name」は希望の名前にすればいいと思うのですが、「objHand」の部分はどのようなスクリプトにすればよいのでしょうか。
ご指導よろしくお願いいたします。
＊蛇足ですが、バックナンバーを目的の単語で検索できると過去の資産をもっと有効に利用できるのですが...。

既存の図形に名前を付けるなら
SetName(objHand, name); を使います。

名前付きの図形を生成するなら
NameObject(name); の後で図形を生成します。

既に名前が使われているかどうかは、自分で調べなければなりません。
GetObject(name) でNilが返ってくれば、その名前は未使用です。

SetName、NameObject 共にカテゴリーは「図形の名前（Object Names）」になっています。
VW9まではマニュアルがPDFだったので「名前」で検索すれば簡単にSetNameもNameObjectも探せたのですが、
VW10以降はHTMLに変わったので、マニュアル全体から検索出来ません。
HTML版マニュアルだと、関係ない関数に多数ヒットするのを覚悟して、「Name」で検索するしかありません。
みなさん各自でHTMLを一つのファイルにまとめたり、PDF化するなどの工夫をされているようでが、
何度目かのバージョンアップで挫折することが多いようです。（バックナンバー：Sat Oct 30 20:48:19 2004〜）

一度マニュアル全体を眺めて、どんな関数があるか（できればカテゴリーまで）知っておけば、
今のマニュアルでも使えないこともないではないです。
また、VWファイルをVectorScript形式で書き出したものもスクリプトを書く参考になります。

＞マックンさん
ご報告ありがとうございました。
管理人さんに（勝手に）成り代わり、お礼を申し上げます。

＞管理人さん
新装開店おめでとうございます。
これからもお世話になります。どうぞよろしくお願いします。

続けて質問させてください。
データパレットのレコードでオブジェクトに名前を付けられますが、
既に決まっている名前をスクリプトで図形に与えたいのですが、どんな関数を使えばよいでしょうか。
「SetRecord」を見つけたのですが、違うようですね。
よろしくお願いいたします。
　また、A%A社のHPのVectorScript ドキュメントで『MiniCAD プログラミング入門』という
書籍を紹介していますが、入手可能なところをご存知でしたら、お知らせください。
お願いいたします。

石男さん、与太郎さん　ありがとうございます。
開発元に質問してみました。一度目の回答は、マニュアル通りの「自分で勉強しなさい」という回答でしたが、
コマンド名が知りたいだけだと苦情のメールを送ったら、やっと回答がありました。
公開しても問題ないと思うので、お知らせします。
〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜
SHADOW、VOLUMEのメニューコマンドはプラグインとして付加されているものですので、
VectorWorksアプリケーションフォルダ内「Plug-Ins」フォルダにインストールされ
ているプログラムのファイル名をsubMenuパラメータに渡してご利用ください。

メニュー名：ファイル名のリストは以下の通りです。

地域...：EX-Shadow/Volume[Area]
日影計算条件設定...：EX-Shadow[Setting]
真北方向...：EX-Shadow/Volume[SetDirection]
等時間日影図描画指定...：EX-Shadow[SetPalette]
日影計算実行：EX-Shadow[doShadow]
等時間日影図作成：EX-Shadow[plyShadow]
地点日影計算実行：EX-Shadow[pntShadow]
スムージング...：EX-Shadow[Smoothing]
建物の高さ変更...：EX-Shadow[SetHeight]
日影測定線作成：EX-Shadow[MakeLine]
日影計算条件一覧表：EX-Shadow[MakeReport]

逆日影計算条件...：EX-Volume[Setting]
カラー...：EX-Volume[SetColors]
階高...：EX-Volume[SetFloor]
容積計算実行...：EX-Volume[DoCalc]
逆日影測定線描画...：EX-Volume[WatchLine]
等高線描画：EX-Volume[MakeContour]
面積表：EX-Volume[MakeAreaTable]
逆日影計算条件一覧表：EX-Volume[MakeReport]
〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜
コマンド名に「EX-」と記されていますが、最新の「A&A Shadow/Volume」で動作を確認できました。
皆さんも、ご活用ください。

ここは新装開店のScript談話室でございます。
まだ、不都合の生じる恐れがありますが、開店を強行します。
お気づきの点をご一報頂けると有難いです。
あ、くれぐれも「送信ボタン」のクリックは一度だけにして下さい。
（やや長押し気味にプレスすると書き込みが反映されるような気がしますが…まさかねぇ）
書き込みが反映されない場合は、もう一度、左の「メニュー」で「Script談話室」をクリックして下さい。
または、ブラウザの「リロード（更新・再読み込み）」ボタンを使って下さい。
最終手段は、「フレームを別ウィンドウで開く」してから「リロード（更新・再読み込み）」です。

＞マックンさん
＞DoMenuTextByNameでコマンドを実行させたいのですが、
＞日影関係のコマンド名の情報はどこで知ることができるでしょうか。

＞石男さん
＞DoMenuTextByName等で使えるコマンド名はVW標準のものに限られていますよ。

自作のプラグイン・メニューでもDoMenuTextByNameで実行出来るので、
「プラグイン・コマンド...」のリストで目的のメニューコマンドが見つかれば、
その名前で実行できると思います。
ただし、メニューコマンドの名前はメニューに表示される名前と同じとは限らないので、
どれが目的のメニューコマンドか判らないかもしれません。

メニューコマンドがSDKで作ってある場合は、プラグインのリストには表示されないようです。
チャンクメニューはVectorScriptでは作れないので、必ずSDKで作ってあります。
試しにRenderWorksのメニューコマンドをDoMenuTextByNameで実行しようとしてみましたが、
やはりコマンド名が判らず、出来ませんでした。

それらしいメニューコマンドがなかったら、開発元にお尋ねになってはいかがでしょうか。

いちいちコマンド名を調べるのは面倒なので、ツールマクロみたいにスクリプトを自動生成して
くれるコマンドがあれば助かるんですけどね。

施工図を書いていると寸法線を連続で書くことが多いのですが、そんな時全てのポイン
ト指示するのが面倒なのでこんな物を作りました。1点目、2点目を指示してこれを仮の
直線として、この直線に交わる直線と四角形の辺の交点に寸法線を書いていくものです。やはり、自分専用かな？
Procedure Point2AutoDim ;
Label
999 ;
Var
p0 , p1 , p2 , p3 , p4 , p5 , sectpt : Point ;
parallel, intOnLines : Boolean ;
h : Handle ;
i , End_i , myType , horizonal : Integer ;
sect_array : DYNARRAY[ ] of Point ;
sectX_array , sectY_array : DYNARRAY[ ] of Real ;

{=================Main===================}
Begin
PushAttrs ;

GetPt( p0.x , p0.y ) ;
GetPtL( p0.x , p0.y , p1.x , p1.y ) ;

If ( ( p0.x = p1.x ) & ( p0.y <> p1.y ) ) Then
Begin
horizonal := 2 ;{ 垂直}
End Else
If ( ( p0.x <> p1.x ) & ( p0.y = p1.y ) ) Then
Begin
horizonal := 1 ;{ 水平}
End Else
Begin
SysBeep ;
AlrtDialog( '指示した2点が斜めになっています、水平もしくは垂直になるよう指示して下さい。' ) ;
GoTo 999 ;
End ;

h := FActLayer ;

ALLOCATE sect_array[ 1..2000 ] ;
i := 0 ;

Repeat
myType := GetType( h ) ;
If ( ( myType = 2 ) or ( myType = 3 ) ) Then
Begin
Case myType of
2 : Begin
GetSegPt1(h , p2.x , p2.y ) ;
GetSegPt2( h , p3.x , p3.y ) ;
LineLineIntersection( p0 , p1, p2 , p3 , parallel , intOnLines , sectpt ) ;
If ( ( parallel = false ) & ( intOnLines = true ) ) Then
Begin
i := i+1 ;
sect_array[ i ] := sectpt ;
End ;
End ;
3 : Begin
GetBBox( h , p2.x , p2.y , p3.x , p3.y ) ;
p4.x := p3.x ; p4.y := p2.y ;
p5.x := p2.x ; p5.y := p3.y ;
LineLineIntersection( p0 , p1, p2 , p4 , parallel , intOnLines , sectpt ) ;
If ( ( parallel = false ) & ( intOnLines = true ) ) Then
Begin
i := i+1 ;
sect_array[ i ] := sectpt ;
End ;
LineLineIntersection( p0 , p1, p2 , p5 , parallel , intOnLines , sectpt ) ;
If ( ( parallel = false ) & ( intOnLines = true ) ) Then
Begin
i := i+1 ;
sect_array[ i ] := sectpt ;
End ;
LineLineIntersection( p0 , p1, p4 , p3 , parallel , intOnLines , sectpt ) ;
If ( ( parallel = false ) & ( intOnLines = true ) ) Then
Begin
i := i+1 ;
sect_array[ i ] := sectpt ;
End ;
LineLineIntersection( p0 , p1, p5 , p3 , parallel , intOnLines , sectpt ) ;
If ( ( parallel = false ) & ( intOnLines = true ) ) Then
Begin
i := i+1 ;
sect_array[ i ] := sectpt ;
End ;
End ;

End ; { End of Case }
End ;
h := NextObj( h ) ;
until h = nil ;
End_i := i ;
ALLOCATE sect_array[ 1..End_i ] ;

Case horizonal of
1 : Begin
ALLOCATE sectX_array[ 1..End_i ] ;
i := 0 ;
Repeat
i := i +1 ;
sectX_array[ i ] := sect_array[ i ].x ;
until i = End_i ;
SortArray( sectX_array , End_i , 1) ;

{ 寸法線を描く }
i := 0 ;
Repeat
i := i+1 ;
LinearDim( sectX_array[ i ] , p0.y , sectX_array[ i+1 ] , p0.y , 0 , 0 , 771 , 771 , 0.412 ) ;
until i = End_i-1 ;
End ;
2 : Begin
ALLOCATE sectY_array[ 1..End_i ] ;
i := 0 ;
Repeat
i := i +1 ;
sectY_array[ i ] := sect_array[ i ].y ;
until i = End_i ;
SortArray( sectY_array , End_i , 1) ;

{ 寸法線を描く }
i := 0 ;
Repeat
i := i+1 ;
LinearDim( p0.x , sectY_array[ i ] , p0.x , sectY_array[ i+1 ] , 0 , 1 , 771 , 771 , 0 ) ;
until i = End_i-1 ;
End ;
End ; { End of Case }
999 :
PopAttrs ;
End ;
Run( Point2AutoDim ) ;

DoMenuTextByName等で使えるコマンド名はVW標準のものに限られていますよ。
ちなみにVSFunctionReference(HTML)の中にAdditional VectorScript Resourcesがあり
ます、その中に使えるメニュー等が書いてあります。

はじめまして。
DoMenuTextByNameでコマンドを実行させたいのですが、
日影関係のコマンド名の情報はどこで知ることができるでしょうか。
よろしくお願いいたします。

レスありがとうございます。
漢字を色々変更したところ選択できる漢字と
出来ない漢字があることがわかりました。
一応シンボル名を変更して使いたいと思います。
ありがとうございました。

＞ＤＯＮさま、
下のほうに、漢字のクラス名が検索されないことがある、という話題がありました。
シンボル名を半角英数字に直したら選択出来ませんか？

だれかわかるかた教えていただきたいのですが
画面上にある指定シンボルをすべて選択したいのですが
以前（ver10）でつかっていたコマンドですと
できたのですが、11をつかってからできないんです。

以前つかったコマンド
SelectObj((S='シンボルの名前'));

どのようにすればいいでしょうか？？
よろしくお願いします。

＞石男さん
励ましありがとうございます。
めげずに頑張ります。

＞与太郎さん
詳しい解説ありがとうございます。
桁落ちという現象内容が、よく分かりました。
回避方まで伝授していただきほんとにありがとうございます。
今後この辺も頭に入れてスクリプト作成に励みたいと思います。

皆さん大変長々とありがとうございました。

何故、円でなく曲線が生成されるのか。

半径が1.2mの円を描くとき、たとえば下のような場合、
x1 = 200.0
x2 = 202.4
y1 = 1000.0
y2 = 1002.4
この座標をを２進数で表すと、下のようになります。
x1 = 11001000
x2 = 11001010.011001100110011001100110011001100110011001
y1 = 1111101000
y2 = 1111101010.0110011001100110011001100110011001100110
0.4は２進数では割り切れないので循環小数になりますが、ここでは有効桁数を50桁にしています。
これを元にdx(=x2-x1)とdy(=y2-y1)を計算すると、
dx = 10.011001100110011001100110011001100110011001
dy = 10.0110011001100110011001100110011001100110
となり、有効桁数が少なくなってしまいます。
これは桁落ちという現象で、近い数字どうしで減算をするときに発生します。
dxとdyで有効桁数が違うのは、それぞれの座標が約200と約1000で違うせいです。
hechさんの例も、有効桁数の違いでdx=dyとならず、正円ではなく長円（曲線）が生成されたと考
えられます。
最下位数桁が変な数字になっているのも、桁落ちしたものを10進数に変換しているためでしょう。

(0, 0)を中心にして円を描いた後で所定の位置に移動すれば、この現象は回避できるはずです。

ちなみに、VW8.5までは座標値が32ビット整数なので、このような現象はありません。

円と曲線、これが一番厄介な問題だったりします、今まだの経験上...。
めげずに、続けてください...。

R＞他に四角を普通に書いて、単位設定の桁を上げていくと端数が出てくるのです。
浮動小数点データの丸め誤差のようです。
VW11.5ならArcByCenterを試してみてください。

レス遅くなりましてすみません。
＞与太郎さん
Arc(x-0.05,Y+0.05,x+0.05,y-0.05,0,360);
上記のような感じで、指令したのですが、やっぱりだめでした。

他に四角を普通に書いて、単位設定の桁を上げていくと端数が出てくるのです。
(下10桁目が1〜3位ずれる。）
しかも四角のサイズを直接数値入力しても下10桁目が端数になってしまいます。
スクリプトが原因ではなさそうですが、何かわかりますか？

＞石男さん
小技の利いたコードありがとうございます。
テストに一部使わせていただきました。

色々面倒なことになってしまいましたが、よろしくお願いします。

蛇足ですが、ArcByCenterでは描いた円弧のハンドルが取れないバグがあります。
以下、バウンディングボックスでの指定は嫌だと言う人のための中心座標値、半径、
開始角度、角度で円弧を描くサブルーチンです。

Procedure Test ;
{$DEBUG}
{********中心座標値、半径、開始角度、角度で円弧を描く*******}
Procedure CenterArc( c_x , c_y , myR , startAngle , arcAngle : Real ) ;
Begin
Arc( c_x- myR , c_y-myR , c_x+myR , c_y+myR , startAngle , arcAngle ) ;
End ;
{=================Main===================}
Begin
CenterArc( 0 , 0 , 50 , 0 , 30 ) ;
ReDraw ;
End ;
Run( Test ) ;

Arc(x1, y1, x2, y2, 0, 360); の、
bounding boxの縦横寸法（x2-x1、y1-y2）が微妙に違うのではないでしょうか。
単位設定の桁数を上げて、生成した図形の大きさを確認してください。

たびたび申し訳ありません。
また質問させてください。
最近会社でVW11.5を購入したのですが、9.5で作ったスクリプトで、
Arcで円を書くコードなのですが、結果が曲線になってしまいます。
9.5では問題ないのですが、11.5では曲線になってしまいます。
何かパラメータ設定が必要なのでしょうか?。
よろしくお願いします。

大変勉強になりました。
dynarrayの件も大変助かります。
適当にサバ読んで、30にしてました。
希望のスクリプト完成までは、まだまだですが頑張ります。

また何かありましたらこの掲示板に書き込み
させていただきます。
ありがとうございました。

＞はじめに'枠'なんて漢字を使う私もおかしいと気が付けって感じですが、
＞アルファベットにするのが、普通ですよね！。
漢字のほうが判り易いけれど、半角英数字のほうがトラブルが少ないです。
今回のようにエラーが出ないと、原因を見つけにくいのでやっかいです。

＞コードの始めのTYPEの宣言をもう１つ宣言することは、できるのでしょうか？。
定数や変数の定義と同じく、XXX=structure 〜 end; を好きなだけ書けます。
自分で定義した構造体を、別の構造体の要素にも出来ます。

＞d :Array[1..30] of arcInfo;
テストコードだからこうしているだけかも知れませんが、
配列の定義を d:DynArray[] of arcInfo; として、
criteria:= 'LOC=''Waku''';
n:= Count(criteria);
Allocate d[1..n];
ForEachObject(GetArc, criteria);
とすれば、必要なサイズの配列を確保出来ます。

＞与太郎さん
検証ありがとうございます。
名前に落とし穴があったとは、全く気付きませんでした。

はじめに'枠'なんて漢字を使う私もおかしいと気が付けって感じですが、
アルファベットにするのが、普通ですよね！。
月曜に会社で、確認してみます。

それと前に書き込んだコードの始めのTYPEの宣言を
もう１つ宣言することは、できるのでしょうか？。
Arcinfo・Rectinfoと設定したいのですが･･･。

くれくれ君で申し訳ありませんが、よろしくお願いします。

hechさん、地雷を踏んだようです。
最初はGetArc（GetArcは組込み手続き）が原因かと思いましたが、名前を変えてもForEachObjectは素通りされました。
それで今度は範囲図形の名前を「waku」に変えたら動きました。
でも「境界」でも動いたので、漢字が全てダメなわけではないです。特定の文字コードの問題でしょう。
それから、名前の上書きは問題ないようです。（元の手続きが使えなくなるだけ）

＞与太郎さん
ヒントを参考に簡易的なものを作ってみたのですが、
DEBUG画面で見て、希望の図形のハンドルが取得できないようです。
範囲図形の'枠'を作成
ForEachobjectでハンドル取得
の予定ですが、文法などいたらないところが多々ありますが、
見ていただけるとうれしいです。


procedure A;
type
arcInfo = structure
x, y, x2, y2 :real;
h :handle;
end;
var
haniX1,haniX2,haniY1,haniY2:real;
hanih :string;
i :longint;
d :Array[1..30] of arcInfo;
procedure GetArc(h:handle);
begin
i := i + 1;
GetBBox(h, d[i].x, d[i].y, d[i].x2, d[i].y2);
d[i].h := h;
end;{GetArc}

begin{main}
{$debug}
haniX1 := 2;
haniX2 := 3;
haniY1 := 25;
haniY2 := 24;
NameObject('枠');
rect( haniX1, haniY1, haniX2, haniY2 );
ForEachObject(GetArc, (LOC='枠'));
end;
run(A);

結果は、変数ｄに'枠'のハンドルが入力されて終了します。
サブルーチンが悪いのかわかりませんが、指導よろしくお願いします。

＞円が範囲内にあるか判定
ForEachObject(サブルーチン, (LOC='領域図形の名前'));で中心が領域図形内にある図形を処理できます。
処理範囲は全レイヤになります。
中心でなく、円全体が入っている必要があるなら、領域図形を半径分内側にオフセットすればいいです。

＞細い範囲内で均等に配置
円を１列に並べるなら簡単。そうでないなら難しいです。

石男さん、与太郎さんレスありがとうございます。

＞石男さん
＞2、各レイヤでの範囲内にある図形の判定（どこまでが範囲内かを自分で決めておく）
この辺のヒントをもう少しほしいのですが、ひとつのレイヤーに数千以上の同じ大きさの
円弧で書いた円がある中で、必要な範囲内の図形のハンドルの取得したいのです。

＞与太郎さん
＞最終的にどう並べたいかが判らないと雲を掴むような話です。
説明不足ですみません。
上にも書いたのですが、同じ大きさの円弧(Arc)で書いた円が数千以上あるレイヤー
を２つ重ねた状態(数千の位置関係はランダムです。)これを細い範囲で区切り
その中にある円の数をカウントして区切りの中で均等に配置しようと思っています。
しかしスキル不足で、石男さんのコメントしていただいた
＞2、各レイヤでの範囲内にある図形の判定
のところで、詰まっています。この辺を詳しくご教授いただけるとうれしいのですが･･･。

たびたび申し訳ありませんが、よろしくご教授お願いします。

＞hechさん
「範囲内の図形を均等配置」では説明不足でしたね。
図形が最初はどのような状態で、最終的にどう並べたいかが判らないと雲を掴むような話です。
「均等」も（図形が同サイズでない限り）ピッチと隙間のどちらを同じにするかで違います。
どちらにしても構造体の配列、GetBBox、SortArrayを使うんだと思いますが。

ちなみにVWの整列コマンドの均等配置オプションでは、２次元の均等配置は想定外みたいです。

>hechさん、出来れば題名は質問内容を...。
出来ますが、かなり面倒です。
1、範囲の設定
2、各レイヤでの範囲内にある図形の判定（どこまでが範囲内かを自分で決めておく）
3、範囲内の図形のみ均等に配置（どのような配置にするかは自分で決めておく）
大雑把な流れはこんなもんです。勉強がてら挑戦してみては...。

hechと申します。
いつも参考に見学させていただいています。
会社でVW9.5を使用しています。

早速ですが質問させてください。
ある範囲内（計算で算出した範囲）にある複数レイヤーに存在する図形を
均等に並べなおしできるでしょうか？

なにぶんスクリプト初心者なので、よろしくお願いします。

シンボルの反転状態を調べる。 　 与太郎
email:　 Mon Oct 24 12:59:12 2005

以前、シンボルの反転状態を調べる方法がないと書きましたが、よく調べたらIsFlipped関数、ま
たは検索条件のIsFlippedで反転状態を調べることが出来ました。
選択したシンボル図形の反転状態は、

if IsFlipped((T=SYMBOL)&(SEL=TRUE)) <> 0 then
＿Message('シンボルは反転している。')
else
＿Message('シンボルは反転していない｜シンボルではない｜選択図形がない。');

で調べられます。
ただし、ゼロ以外の値が返っても反転しているのが調べたいシンボル図形とは限りません。
編集が出来ないレイヤ上の選択シンボルが反転していてもゼロ以外が返ってきます。
事前にDSelectAll;を実行するなりして、全レイヤの図形を選択解除してから図形を選択しないと
いけません。
また、複数の選択シンボル図形の選択状態を１個づつ調べるには別の方法が必要です。
選択図形のハンドルを全部保存して１個づつ選択して調べてもいいですが、汎用性を考慮して、
IsFlippedSymbol関数を作ってみました。

特定の図形だけを検索対象にするためには図形の名前を検索条件にしました。ほとんどの場合図形
に名前は付いていないので、一時的な名前を付けて検索します。名前があるときは保存しておいて、
最後に名前を元に戻します。ただし、SetNameで'none'をセットしても無視されるので、元の名前
が'none'だった場合は図形の名前は消えてしまいます。

procedure test;
var
＿h＿:handle;

function IsFlippedSymbol(h:handle):boolean;
{ シンボルの反転状態を返す。 }
{ ハンドルのチェックは行っていない。 }
{ 図形の名前が'none'の場合、名前が消える。 }
const
＿SQ = Chr(39);{'}
＿TempName1 = 'Flipped Symbol?';
＿TempName2 = 'Flipped Symbol??';
var
＿result＿:boolean;
＿nm, tmpNm, criteria＿:string;
begin
＿nm:= GetName(h);
＿if nm <> TempName1 then
＿＿tmpNm:= TempName1
＿else
＿＿tmpNm:= TempName2;
＿SetName(h, tmpNm);
＿criteria:= Concat('N=', SQ, tmpNm, SQ);
＿if IsFlipped(criteria) = 0 then begin
＿＿result:= false;
＿end
＿else begin
＿＿result:= true;
＿end;
＿DelName(tmpNm);＿{ VW9以降はこの行を削除可能 }
＿if (nm <> '') & (nm <> 'none') then＿{ VW9以降はこの行を削除可能 }
＿＿SetName(h, nm);
＿IsFlippedSymbol:= result;
end;{IsFlippedSymbol}

begin{test}
＿h:= FSActLayer;
＿Message('Flip = ', IsFlippedSymbol(h));
end;{test}
Run(test);

関数:GetName(h)を使うと図形に付けた名前を調べられます。
名前を付けてなければ''(ヌル)が返ってきます。
ところが名前を消した図形では''でなく'none'が返ってきます。
それでは'none'という名前を付けるとどうなるかというと、'none'が返ってきます。
これでは名前が無いのか'none'なのか区別が付きません。
早い話、'none'という名前は付けないほうがいいということです。（言わなくても誰も付けないって？）

英語版では'一般'クラスが'none'なので、図形には'none'という名前は付けられません。
そういえば、グループ化するとグループのクラスが'一般'になるのは解かりにくいですが、
グループ自体には実体がないので'none'クラスになる（＝クラスが無い）というのは理屈に合ってます。
今からでも「一般」を「'無し」や「未設定」に変えてみましょうか（ウソ）。

（注意：VW11からはグループはアクティブ・クラスになるように変更されました。）

古いバージョンのVWでは、寸法を描くと必ず「寸法」クラスになってしまいます。
ツールマクロを改造して、描いた寸法をアクティブ・クラスにするスクリプトを作ってみます。

寸法ツールを選択して、「階層」−「ツールマクロ...」を実行し、
項目の内「ツール」だけをチェックしてツールマクロを作ります。
Alt/Optionキーを押しながら出来たコマンドをダブルクリックすると、スクリプトエディタが開きます。
下のようなスクリプトが自動生成されています。

Procedure CustTool;
VAR
Name:STRING;
Result:BOOLEAN;
BEGIN
PushAttrs;
CallTool(-210);
PopAttrs;
END;
Run(CustTool);

変数 Name, Result は未使用です。
ツール番号の-210は縦横寸法です。斜め寸法なら-211になります。
下のように SetClass の行を追加すると寸法はアクティブ・クラスに設定されます。
アクティブ・クラスに関係なく「一般」クラスにしたければ、
SetClass(LSActLayer, ActiveClass); でなく SetClass(LSActLayer, '一般'); と入れます。

Procedure CustTool_1;
{ 寸法をアクティブ・クラスで描く }
BEGIN
PushAttrs;
CallTool(-210);
SetClass(LSActLayer, ActiveClass);
PopAttrs;
END;
Run(CustTool_1);

上のスクリプトだと、連続寸法で描いた場合は、最後の寸法以外は「寸法」クラスのままになります。
描いた寸法全部をアクティブ・クラスに設定するには、下のようにします。

Procedure CustTool_2;
{ 寸法をアクティブ・クラスで描く }
VAR
h:handle;
BEGIN
PushAttrs;
CallTool(-210);
h:= LSActLayer;
while h <> nil do begin
SetClass(h, ActiveClass);
h:= PrevSObj(h);
end;{while}
PopAttrs;
END;
Run(CustTool_2);

このままだと、寸法を一つ描く度にスクリプトを実行しないといけません。
repeat と until LSActLayer = nil; を追加すると、連続して寸法を描けます。

Procedure CustTool_3;
{ 寸法をアクティブ・クラスで描く（連続） }
VAR
h:handle;
BEGIN
PushAttrs;
repeat
CallTool(-210);
h:= LSActLayer;
while h <> nil do begin
SetClass(h, ActiveClass);
h:= PrevSObj(h);
end;{while}
until LSActLayer = nil;
PopAttrs;
END;
Run(CustTool_3);

今のままだと、回転も伸縮もシンボルの中心を基点にしてしまうので、シンボルの挿入点がシンボル
の中心からずれていると、伸縮後に挿入点が移動してしまいます。
シンボル挿入点を移動させないためには、最初にシンボル挿入点の位置に基準点を打っておき、後で
グループ図形を元の位置に移動します。

procedure ScaleSymbol_3;
{ シンボルを拡大縮小する }
const
＿SymbolObj = 15;
var
＿h, ｈLocus＿:handle;
＿x0, y0, x, y, rot＿:real;
begin
＿h:= FSActLayer;
＿if (h <> nil) & (GetType(h) = SymbolObj) then begin
＿＿DSelectAll;
＿＿GetSymLoc(h, x0, y0);
＿＿SetSelect(h);
＿＿rot:= GetSymRot(h);
＿＿Locus(x0, y0);
＿＿ｈLocus:= LNewObj;
＿＿Rotate(-rot);
＿＿DoMenuTextByName('Symbol to Group', 0);
＿＿DoMenuTextByName('Scale Objects', 0);
＿＿Rotate(rot);
＿＿GetLocPt(ｈLocus, x, y);
＿＿MoveObjs(x0-x, y0-y, false, false);
＿＿DelObject(ｈLocus);
＿end
＿else begin
＿＿AlrtDialog('アクティブレイヤのシンボル図形を選択してください！');
＿end;
end;
Run(ScaleSymbol_3);

＞ＸとＹの倍率が同じなら、問題なく使えるはずです。
シンボルが回転していてＸとＹの倍率が異なると、形状が歪んでしまいます。
歪まないようにするために、一旦シンボルを水平に戻して、伸縮後に元通り回転させます。

procedure ScaleSymbol_2;
{ シンボルを拡大縮小する }
const
＿SymbolObj = 15;
var
＿h＿:handle;
＿rot＿:real;
begin
＿h:= FSActLayer;
＿if (h <> nil) & (GetType(h) = SymbolObj) then begin
＿＿DSelectAll;
＿＿SetSelect(h);
＿＿rot:= GetSymRot(h);
＿＿Rotate(-rot);
＿＿DoMenuTextByName('Symbol to Group', 0);
＿＿DoMenuTextByName('Scale Objects', 0);
＿＿Rotate(rot);
＿end
＿else begin
＿＿AlrtDialog('アクティブレイヤのシンボル図形を選択してください！');
＿end;
end;
Run(ScaleSymbol_2);

これでシンボルが回転していても大丈夫です。

＞幻のバックナンバーより
Q: シンボルを拡大縮小できますか？
A: 出来ません。一旦グループ図形に変換してから伸縮してください。

これをスクリプトでやるのは簡単です。２行のスクリプトで実現できます。

DoMenuTextByName('Symbol to Group', 0);
DoMenuTextByName('Scale Objects', 0);

エラーチェックをすると下のようになります。

procedure ScaleSymbol_1;
{ シンボルを拡大縮小する }
const
＿SymbolObj = 15;
var
＿h＿:handle;
begin
＿h:= FSActLayer;
＿if (h <> nil) & (GetType(h) = SymbolObj) then begin
＿＿DSelectAll;
＿＿SetSelect(h);
＿＿DoMenuTextByName('Symbol to Group', 0);
＿＿DoMenuTextByName('Scale Objects', 0);
＿end
＿else begin
＿＿AlrtDialog('アクティブレイヤのシンボル図形を選択してください！');
＿end;
end;
Run(ScaleSymbol_1);

アクティブレイヤのシンボル図形を選択して上のスクリプトを実行すると「伸縮...」ダイアログが開
くので、倍率を設定してください。
ＸとＹの倍率が同じなら、問題なく使えるはずです。

これはMacな人限定の話です...。
AppleScriptについての詳細は他のWeb上のサイトを参考にしてください。
まあ、こんな感じで埋め込みます。

tell application "VectorWorks"
DoScript "Procedure Test ;
Begin
SysBeep;
End;
Run(Test) ;"
end tell
tell application "VectorWorks"でVWに指示を出します。バージョンが違っていても
"VectorWorks"ですので注意が必要です。実際にはVWをアクティブにして置きます。
「DoScript" "」でVectorScriptを走らせます。ダブルクォーテーションの間にVSを
埋め込みます。で最後にend tellでVWを終わりにします。

VW談話室のほうでスクリプトの実行方法について質問がありましたので、こちらに書きます。

スクリプト、マクロ、コマンド、プログラムと呼び方はバラバラですが、全部同じものです。
スクリプトには以下の４種類があります。
(1)図面ファイルに保存するタイプ（VectorScriptコマンド）
(2)テキストファイルとして保存するタイプ（コマンドファイル）
(3)AppleScriptに埋め込むタイプ
(4)プラグイン（ツール、メニューコマンド、オブジェクト）

(1)手っ取り早いのはVectorScriptコマンドです。
図形選択マクロ、図形表示マクロ、ツールマクロはこのタイプになります。
新しいコマンドはリソースプラウザの「リソース」−「新規:<ファイル名>」−「VectorScript...」
で作ります。
パレット名とコマンド名を入力するとVectorScriptエディタが開くので、スクリプトをペーストします。
コンパイルボタン（上部右側のボタン）を押してエラーが出なければＯＫです。
スクリプトは他のコマンドと同様に、コマンドパレットから実行します。
VectorScriptコマンドは図面ファイルに保存するため、バージョン管理に難があります。

(2)コマンドファイルは、スクリプトをテキストファイルとして保存したものです。
実行は「階層」−「コマンドを実行...」か、「ファイル」−「取り込む」−「VectorScript...」です。
VW9.5までならリソースパレットからも実行できます。
コマンドをサーバに置けば厳密なバージョン管理が可能です。スクリプトの実行は少々煩雑です。

(3)AppleScriptについては、経験不足なので割愛します。

(4)スクリプトをプラグインにすると、スクリプトが手軽に実行でき、バージョン管理も簡単になります。
ただし、最初にプラグイン化してメニューやツールバーに登録する手間がかかります。

とりあえず(1)で作って、(2)でも保存しておき、使用頻度が高ければ(4)にするという感じです。

気に入ってもらえたようで嬉しいです。

PIOの中にはFInGroup(h)で入れるから寸法にも入れるのではと試したら、
FIn3D(h)で寸法の中身の図形ハンドルを取れました。

＞与太郎さん
なかなか良いものをありがとうございました。
位取りしても、そのまま寸法値が変更出来るのが良いですね。
標準で寸法値を位取りした後、訂正が面倒で辟易しておりました...。
この様なものを標準装備してもらいたいぐらいです。

位取りを解除するスクリプトです。

procedure Reset_Kuraidori_Sel_ActLayer;
{ アクティブレイヤ上で選択した寸法の位取りを解除する（VW9以降に対応） }
{$ DEBUG}
const
＿TextObj = 10;
＿GroupObj = 11;
＿DimObj = 63;
＿SQ = Chr(39);{ ' }
＿RecName = '寸法線-追加情報';
＿Fld1 = '位取り';
var
＿hL＿:handle;
＿sD, sL, sT, s0＿:string;
＿name, criteria＿:string;

function Kuraidori(s:string):string;
{ 位取りした文字列を返す }
var
＿i, ln＿:integer;
＿s0, s1, s2＿:string;
begin
＿ln:= Len(s);
＿i:= Pos('.', s);
＿if 0 < i then begin
＿＿s1:= Copy(s, 1, i - 1);
＿＿s2:= Copy(s, i, ln - i + 1);
＿end
＿else begin
＿＿s1:= s;
＿＿s2:= '';
＿end;
＿s0:= '';
＿ln:= Len(s1);
＿while (3 < ln) do begin
＿＿s0:= Concat(Copy(s1, ln - 2, 3), s0);
＿＿s1:= Copy(s1, 1, ln - 3);
＿＿ln:= Len(s1);
＿＿if ln <> 0 then
＿＿＿s0:= Concat(',', s0);
＿end;
＿Kuraidori:= Concat(s1, s0, s2);
end;{Kuraidori}

procedure DoInContainer(hP:handle);
var
＿h＿:handle;
＿s＿:string;
＿x1, y1, x2, y2＿:real;
＿x01, y01, x02, y02＿:real;
begin
＿case GetType(hP) of
＿＿DimObj: h:= FIn3D(hP);
＿＿GroupObj: h:= FInGroup(hP);
＿end;
＿while h <> nil do begin
＿＿case GetType(h) of
＿＿＿GroupObj: begin
＿＿＿＿DoInContainer(h);
＿＿＿end;
＿＿＿TextObj: begin
＿＿＿＿s:= Kuraidori(s0);
＿＿＿＿s:= Concat(sL, s, sT);
＿＿＿＿if GetText(h) = s then begin
＿＿＿＿＿GetBBox(h, x01, y01, x02, y02);
＿＿＿＿＿SetTextJust(h, 3);
＿＿＿＿＿GetBBox(h, x1, y1, x2, y2);
＿＿＿＿＿HMove(h, x01-x1, y01-y1);
＿＿＿＿＿SetText(h, sD);
＿＿＿＿end;
＿＿＿end;
＿＿end;
＿＿h:= NextObj(h);
＿end;
end;{DoInContainer}

procedure DoDimension(hD:handle);
{ 寸法の位取りを解除する }
var
＿h＿:handle;
begin
＿if GetType(hD) = DimObj then begin
＿＿sD:= GetDimText(hD);
＿＿sL:= GetObjectVariableString(hD, 9);
＿＿sT:= GetObjectVariableString(hD, 10);
＿＿sD:= Concat(sL, sD, sT);
＿＿s0:= GetDimText(hD);
＿＿DoInContainer(hD);
＿＿SetRField(hD, RecName, Fld1, 'False');
＿＿ReDraw;
＿end;
end;{DoDimension}

function AddSQ(s:string):string;
{ 名前の中の「'」を「'」+「'」 に直します。 }
var
＿result＿:string;
＿i, j, lng＿:integer;
begin
＿result:= s;
＿lng:= Len(result);
＿i:= 1;
＿while (i <= lng) do begin
＿＿if Copy(result, i, 1) = SQ then begin
＿＿＿if i < lng then
＿＿＿＿result:= Concat(Copy(result, 1, i), SQ, Copy(result, i+1, lng-i))
＿＿＿else
＿＿＿＿result:= Concat(Copy(result, 1, i), SQ);
＿＿＿lng:= lng + 1;
＿＿＿i:= i + 2;
＿＿end{if}
＿＿else begin
＿＿＿i:= i + 1;
＿＿end;{else}
＿end;{while}
＿AddSQ:= result;
end;{AddSQ}

begin{main}
＿name:= Concat(SQ, AddSQ(GetLName(ActLayer)), SQ);
＿criteria:= Concat('(L=',name, ')&(SEL=TRUE)');
＿ForEachObject(DoDimension, criteria);
end;{main}
Run(Reset_Kuraidori_Sel_ActLayer);

下の２つの書き込みのKuraidori関数は出鱈目でした。前から使ってるKuraidori関数と入れ替えときます。
勝手に解除される位取りを設定し直すのは面倒なので、１回設定したら解除されても後で一括して
位取り出来るようにします。
位取りの有無を保持するために寸法図形にレコードを割当てました。

procedure Kuraidori_Sel_ActLayer;
{ アクティブレイヤ上で選択した寸法の寸法値を位取りする（VW9以降に対応） }
{ 寸法を選択してなければ全ての寸法の位取りをやり直す }
{$ DEBUG}
const
＿TextObj = 10;
＿GroupObj = 11;
＿DimObj = 63;
＿SQ = Chr(39);{ ' }
＿RecName = '寸法線-追加情報';
＿Fld1 = '位取り';
var
＿hL＿:handle;
＿sD, sL, sT, s0＿:string;
＿name, criteria＿:string;

procedure AddRecord(h:handle);
{ 寸法線にレコードを割当てる }
begin
＿if GetObject(RecName) = nil then
＿＿NewField(RecName, Fld1, 'False', 2{boolean}, 0);
＿Record(h, RecName);
＿SetRField(h, RecName, Fld1, 'True');
end;{AddRecord}

function Kuraidori(s:string):string;
{ 位取りした文字列を返す }
var
＿i, ln＿:integer;
＿s0, s1, s2＿:string;
begin
＿ln:= Len(s);
＿i:= Pos('.', s);
＿if 0 < i then begin
＿＿s1:= Copy(s, 1, i - 1);
＿＿s2:= Copy(s, i, ln - i + 1);
＿end
＿else begin
＿＿s1:= s;
＿＿s2:= '';
＿end;
＿s0:= '';
＿ln:= Len(s1);
＿while (3 < ln) do begin
＿＿s0:= Concat(Copy(s1, ln - 2, 3), s0);
＿＿s1:= Copy(s1, 1, ln - 3);
＿＿ln:= Len(s1);
＿＿if ln <> 0 then
＿＿＿s0:= Concat(',', s0);
＿end;
＿Kuraidori:= Concat(s1, s0, s2);
end;{Kuraidori}

procedure DoInContainer(hP:handle);
var
＿h＿:handle;
＿s＿:string;
＿x1, y1, x2, y2＿:real;
＿x01, y01, x02, y02＿:real;
begin
＿case GetType(hP) of
＿＿DimObj: h:= FIn3D(hP);
＿＿GroupObj: h:= FInGroup(hP);
＿end;
＿while h <> nil do begin
＿＿case GetType(h) of
＿＿＿GroupObj: begin
＿＿＿＿DoInContainer(h);
＿＿＿end;
＿＿＿TextObj: begin
＿＿＿＿if GetText(h) = sD then begin
＿＿＿＿＿s:= Kuraidori(s0);
＿＿＿＿＿s:= Concat(sL, s, sT);
＿＿＿＿＿GetBBox(h, x01, y01, x02, y02);
＿＿＿＿＿SetTextJust(h, 3);
＿＿＿＿＿GetBBox(h, x1, y1, x2, y2);
＿＿＿＿＿HMove(h, x01-x1, y01-y1);
＿＿＿＿＿SetText(h, s);
＿＿＿＿end;
＿＿＿end;
＿＿end;
＿＿h:= NextObj(h);
＿end;
end;{DoInContainer}

procedure DoDimension(hD:handle);
{ 寸法の位取りをする }
var
＿h＿:handle;
begin
＿if GetType(hD) = DimObj then begin
＿＿sD:= GetDimText(hD);
＿＿sL:= GetObjectVariableString(hD, 9);
＿＿sT:= GetObjectVariableString(hD, 10);
＿＿sD:= Concat(sL, sD, sT);
＿＿s0:= GetDimText(hD);
＿＿DoInContainer(hD);
＿＿AddRecord(hD);
＿＿ReDraw;
＿end;
end;{DoDimension}

function AddSQ(s:string):string;
{ 名前の中の「'」を「'」+「'」 に直します。 }
var
＿result＿:string;
＿i, j, lng＿:integer;
begin
＿result:= s;
＿lng:= Len(result);
＿i:= 1;
＿while (i <= lng) do begin
＿＿if Copy(result, i, 1) = SQ then begin
＿＿＿if i < lng then
＿＿＿＿result:= Concat(Copy(result, 1, i), SQ, Copy(result, i+1, lng-i))
＿＿＿else
＿＿＿＿result:= Concat(Copy(result, 1, i), SQ);
＿＿＿lng:= lng + 1;
＿＿＿i:= i + 2;
＿＿end{if}
＿＿else begin
＿＿＿i:= i + 1;
＿＿end;{else}
＿end;{while}
＿AddSQ:= result;
end;{AddSQ}

begin{main}
＿name:= Concat(SQ, AddSQ(GetLName(ActLayer)), SQ);
＿criteria:= Concat('(SEL=TRUE)&(T=DIMENSION)&(L=', name, ')');
＿if Count(criteria) = 0 then
＿＿criteria:= Concat(SQ, AddSQ(RecName), SQ, '.', SQ, AddSQ(Fld1), SQ, '=True')
＿else
＿＿criteria:= Concat('(L=',name, ')&(SEL=TRUE)');
＿ForEachObject(DoDimension, criteria);
end;{main}
Run(Kuraidori_Sel_ActLayer);

一応完成版です。
アクティブレイヤの寸法を選択して実行します。

procedure Kuraidori_Sel_ActLayer;
{ アクティブレイヤ上で選択した寸法の寸法値を位取りする（VW9以降に対応） }
{$ DEBUG}
const
＿TextObj = 10;
＿GroupObj = 11;
＿DimObj = 63;
＿SQ = Chr(39);{ ' }
var
＿hL＿:handle;
＿sD, sL, sT, s0＿:string;
＿name, criteria＿:string;

function Kuraidori(s:string):string;
{ 位取りした文字列を返す }
var
＿i, iP＿:integer;
＿result＿:string;
begin
＿result:= '';
＿iP:= Pos('.', s);
＿if iP = 0 then iP:= Len(s) + 1;
＿if iP <= Len(s) then begin
＿＿result:= Copy(s, iP, Len(s)-iP+1);
＿＿s:= Copy(s, 1, iP-1);
＿end;
＿while 3 < Len(s) do begin
＿＿result:= Concat(',', Copy(s, Len(s)-3, 3), result);
＿＿s:= Copy(s, 1, Len(s)-3);
＿end;
＿if s <> '' then result:= Concat(s, result);
＿if Copy(result, 1, 1) = ',' then result:= Copy(result, 2, Len(result)-1);
＿Kuraidori:= result;
end;{Kuraidori}

procedure DoInContainer(hP:handle);
var
＿h＿:handle;
＿s＿:string;
＿x1, y1, x2, y2＿:real;
＿x01, y01, x02, y02＿:real;
begin
＿case GetType(hP) of
＿＿DimObj: h:= FIn3D(hP);
＿＿GroupObj: h:= FInGroup(hP);
＿end;
＿while h <> nil do begin
＿＿case GetType(h) of
＿＿＿GroupObj: begin
＿＿＿＿DoInContainer(h);
＿＿＿end;
＿＿＿TextObj: begin
＿＿＿＿if GetText(h) = sD then begin
＿＿＿＿＿GetBBox(h, x01, y01, x02, y02);
＿＿＿＿＿SetTextJust(h, 3);
＿＿＿＿＿GetBBox(h, x1, y1, x2, y2);
＿＿＿＿＿HMove(h, x01-x1, y01-y1);
＿＿＿＿＿s:= Kuraidori(s0);
＿＿＿＿＿s:= Concat(sL, s, sT);
＿＿＿＿＿SetText(h, s);
＿＿＿＿end;
＿＿＿end;
＿＿end;
＿＿h:= NextObj(h);
＿end;
end;{DoInContainer}

procedure DoDimension(hD:handle);
{ 寸法の位取りをする }
var
＿h＿:handle;
begin
＿if GetType(hD) = DimObj then begin
＿＿sD:= GetDimText(hD);
＿＿sL:= GetObjectVariableString(hD, 9);
＿＿sT:= GetObjectVariableString(hD, 10);
＿＿sD:= Concat(sL, sD, sT);
＿＿s0:= GetDimText(hD);
＿＿DoInContainer(hD);
＿＿ReDraw;
＿end;
end;{DoDimension}

function AddSQ(s:string):string;
{ 名前の中の「'」を「'」+「'」 に直します。 }
var
＿result＿:string;
＿i, j, lng＿:integer;
begin
＿result:= s;
＿lng:= Len(result);
＿i:= 1;
＿while (i <= lng) do begin
＿＿if Copy(result, i, 1) = SQ then begin
＿＿＿if i < lng then
＿＿＿＿result:= Concat(Copy(result, 1, i), SQ, Copy(result, i+1, lng-i))
＿＿＿else
＿＿＿＿result:= Concat(Copy(result, 1, i), SQ);
＿＿＿lng:= lng + 1;
＿＿＿i:= i + 2;
＿＿end{if}
＿＿else begin
＿＿＿i:= i + 1;
＿＿end;{else}
＿end;{while}
＿AddSQ:= result;
end;{AddSQ}

begin{main}
＿name:= Concat(SQ, AddSQ(GetLName(ActLayer)), SQ);
＿criteria:= Concat('(L=',name, ')&(SEL=TRUE)');
＿ForEachObject(DoDimension, criteria);
end;{main}
Run(Kuraidori_Sel_ActLayer);

ボックステキストにすると文字がはみ出るので、あらかじめ前記号に空白をいれて調整してください。

標準の位取りツールを使うと寸法を直しても寸法値が更新されないので、
他に方法がないか考えてみました。

procedure test;
{ 寸法値を位取りする（VW9以降に対応） }
{$ DEBUG}
const
TextObj = 10;
GroupObj = 11;
DimObj = 63;
var
hD, h:handle;
sD, sL, sT:string;

function Kuraidori(s:string):string;
var
i, iP:integer;
result:string;
begin
result:= '';
iP:= Pos('.', s);
if iP = 0 then iP:= Len(s) + 1;
if iP <= Len(s) then begin
result:= Copy(s, iP, Len(s)-iP+1);
s:= Copy(s, 1, iP-1);
end;
while 3 < Len(s) do begin
result:= Concat(',', Copy(s, Len(s)-3, 3), result);
s:= Copy(s, 1, Len(s)-3);
end;
if s <> '' then result:= Concat(s, result);
if Copy(result, 1, 1) = ',' then result:= Copy(result, 2, Len(result)-1);
Kuraidori:= result;
end;{Kuraidori}

procedure DoInContainer(h:handle);
var
s:string;
begin
while h <> nil do begin
case GetType(h) of
GroupObj: begin
h:= FInGroup(h);
DoInContainer(h);
end;
TextObj: begin
if GetText(h) = sD then begin
s:= Kuraidori(GetDimText(hD));
s:= Concat(sL, s, sT);
SetText(h, s);
end;
end;
end;
h:= NextObj(h);
end;
end;{DoInContainer}

begin
hD:= FSActLayer;
if GetType(hD) = DimObj then begin
sD:= GetDimText(hD);
sL:= GetObjectVariableString(hD, 9);
sT:= GetObjectVariableString(hD, 10);
sD:= Concat(sL, sD, sT);
h:= FIn3D(hD);
DoInContainer(h);
ReDraw;
end;
end;
Run(test);

寸法線の中に入って、無理やり寸法値を書き換えています。
ですから寸法線に変更を加えると位取りは無効になります。

気分転換にフリーハンドツールを書いてみました。
環境設定で「クリック-ドラッグ描画」にしてない場合は、標準のフリーハンドツールとほと
んど同じですが、「クリック-ドラッグ描画」の場合にマウスボタンを放しても終了しません。
終了するにはもう一度クリックします。

標準ツールは多角形の頂点を随時追加しているため、描画中に多角形全体がちらつきますが、
こちらは一旦直線を生成して最後に多角形を作っているので、画面はちらつきません。

procedure FreeHand;
{$ DEBUG}
var
＿h, hG＿:handle;
＿aPixcel＿:real;
＿x1, y1, x2, y2＿:real;
＿start, stop＿:boolean;
＿showAll＿:boolean;
＿
begin
＿DSelectAll;
＿showAll:= GetPref(14);
＿SetPref(14, true);
＿start:= false;
＿stop:= false;
＿Message('マウスボタンを押して、曲線を描いてください。');
＿SetCursor(SmCrossC);
＿BeginGroup;
＿repeat
＿＿if start then begin
＿＿＿GetMouse(x2, y2);
＿＿＿if not EqualPt(x1, y1, x2, y2) then begin
＿＿＿＿LineTo(x2, y2);
＿＿＿＿h:= LNewObj;
＿＿＿＿SetDSelect(h);
＿＿＿＿if hBtm = nil then
＿＿＿＿＿hBtm:= h;
＿＿＿＿ReDraw;
＿＿＿＿x1:= x2; y1:= y2;
＿＿＿end;
＿＿＿if MouseDown(x2, y2) then begin
＿＿＿＿stop:= true;
＿＿＿end;
＿＿end
＿＿else if MouseDown(x1, y1) then begin
＿＿＿Message('もう一度マウスボタンを押すと終了します。');
＿＿＿start:= true;
＿＿＿MoveTo(x1, y1);
＿＿end;
＿until stop;
＿EndGroup;
＿hG:= LNewObj;
＿SetPref(14, showAll);
＿ClrMessage;
＿if hG <> nil then begin
＿＿h:= FInGroup(hG);
＿＿if h <> nil then begin
＿＿＿OpenPoly;
＿＿＿BeginPoly;
＿＿＿GetSegPt1(h, x1, y1);
＿＿＿AddPoint(x1, y1);
＿＿＿repeat
＿＿＿＿GetSegPt2(h, x2, y2);
＿＿＿＿AddPoint(x2, y2);
＿＿＿＿h:= NextObj(h);
＿＿＿until h = nil;
＿＿＿EndPoly;
＿＿＿SetFPat(LNewObj, 0);
＿＿＿DelObject(hG);
＿＿end;
＿end;
＿ReDrawAll;
end;
Run(FreeHand);

気が付いたこと。
1. マウスを押しっぱなしにしてもGetMouseが２回目からはTrueを返さなかったので、マウ
スボタンを押して描き始め、ボタンを離して終了、という具合には出来ませんでした。
標準ツールでは出来ているので、何か方法はあるはずですが...。
2. 最初はBeginPolyとEndPolyの中で直線を一本ずつ消してましたが、上手くいきませんで
した。それで直線をグループ内で生成して、多角形生成後に削除するように修正しました。
3. BeginGroupとEndGroupの間で直線を生成すれば、グループ図形を一個削除すれば済むの
で、そのように修正したら描画中に背後の図形が消えてしまいました。これは環境設定の
「グループ編集時に他の図形を表示」をTrueにすれば直りました。
1〜3の原因がなかなか判らず、最初15分位で作れると思っていたのに何時間もかかってしま
いました。
また、実行中に画面のパンとズームが出来ません（出来てもほとんど無意味ですが）。

それから、今出来た図形にスムージングを掛けたら、頂点が減ったんでビックリしました。
これってVW11からでしたっけ？
単純に頂点を間引いてるだけなので、元の図形と全然重なってませんけど...

古いVWでのDXF/DWG書き出しで、一部の文字が半文字〜１文字分下にズレていることがあり
ました。変換プログラムが、文字基点が「上」であるのを前提に変換しているのが原因のよ
うなので、全ての文字を「上揃え」にすれば位置ズレはは起きません。（フォントの違いに
よるズレは別のはなしです。）

procedure ResetTextVertical;
{ 全ての文字を「上揃え」にする。 }
const
＿stepMessage = 50;
var
＿h＿:handle;
＿i, c, n, iD＿:longint;

procedure DoText(h:handle);
const
＿TextVertical_Top = 1;
var
＿y0, x1, y1, x2, y2＿:real;
begin
＿if GetTextVerticalAlign(h) <> TextVertical_Top then begin
＿＿GetBBox(h, x1, y0, x2, y2);
＿＿SetTextVerticalAlign(h, TextVertical_Top);
＿＿GetBBox(h, x1, y1, x2, y2);
＿＿HMove(h, 0, y0-y1);
＿＿c:= c + 1;
＿end;
＿i:= i + 1;
＿if i >= iD then begin
＿＿Message('文字を「上揃え」にする：', c, '/', i, '/', n);
＿＿iD:= iD + stepMessage;
＿end;
end;{DoText}

begin{main}
＿c:= 0; i:= 0; iD:= stepMessage;
＿n:= Count(T=TEXT);
＿ForEachObject(DoText, T=TEXT);
＿Message(n, '個中、', c, '個の文字を「上揃え」にしました。');
end;
Run(ResetTextVertical);

Vectorcriptの「警告」メッセージが出ますけど、無視して構いません。

JWCに変換するとき、行間隔が大きい文字のサイズが大きくなってしまいました。
他のCADのデータを読み込んだら勝手に行間隔が大きくなっていたようです。
私自身はラップ・テキストは使わないので、行間隔を変更する必要はありません。
ですから、ラップ・テキスト以外の文字の行間隔を全て「行間全角」に戻すスク
リプトを書いてみました。

procedure ResetTextSpace;
{ ラップ・テキスト以外の文字の行間隔をリセットする。 }
var
＿h＿:handle;
＿i, c, n＿:longint;

procedure DoText(h:handle);
const
＿SingleSpace = 2;
begin
＿if GetTextSpace(h) <> SingleSpace then begin
＿＿if not GetTextWrap(h) then begin
＿＿＿SetTextSpace(h, SingleSpace);
＿＿＿c:= c + 1;
＿＿end;
＿end;
＿i:= i + 1;
＿Message('行間隔をリセット：', c, '/', i, '/', n);
end;{DoText}

begin{main}
＿c:= 0; i:= 1;
＿n:= Count(T=TEXT);
＿ForEachObject(DoText, T=TEXT);
＿Message(n, '個中、', c, '個の文字の行間隔をリセットしました。');
end;
Run(ResetTextSpace);

文字が多いとき（数千〜）は、Messageを間引けば相当早くなると思います。

＞曲線を作る時に実際の半径を計算するのは面倒なので...
わたしの場合、曲線作る時は円弧と直線を交差させて「抜き取り」という要領が多いの
で。これで作ると「フィレットの設定」で再度設定しないと駄目なんです。
ただ、この再設定のデフォルト値が実際の半径に確かになっているのが、何か微妙な感
じがしますね。
＞NNAかA&Aに関数１個作ってもらえば解決ですね...
はい、その通りです...。

実際のフィレット半径を得る関数(GetVertRadius)を書いてみました。

5/16の書き込みのDoMenuTextByName のパラメータは、'Decompose' の間違いでした。
'Convert to Lines' だと全て直線に分解されてしまいます。
マニュアルには'Decompose Curve'とありますが、'Decompose'が正しいようです。

分解された図形は頂点番号と逆順に生成されているので、円弧の順番は、頂点を逆順に辿っ
て調べています。

複製図形も分解された図形も、元の曲線図形の階層の一番上に出来ます。
それで、複製した図形(hD)の下の図形のハンドル(hTop)をPrevObj(hD)で取っておくと、
分解された最初の図形のハンドル(h)はNextObj(hD);で得られます。
こうすると、曲線図形がどの階層にあってもGetVertRadiusは正常に動作します。

GetArcRadiu関数の中でDSelectAllを実行しているので、選択図形のハンドルを取って処理
するスクリプトだと、最初に全ての選択図形のハンドルを保存する必要があります。

PIOでは無理だと書きましたが、実際に試してはないので定かではありません。
PIOの中でDoMenuTextByNameを使えるのでしょうか？

procedure test;
{ クリックした曲線のフィレット半径を調べる }
const
＿Filet = 3;
＿ArcObj = 6;
＿CurveObj = 21;
var
＿err＿:boolean;
＿h＿:handle;
＿i, iA, n, tp＿:integer;
＿x0, y0, x, y, r, d, d0＿:real;

function GetArcRadius(h:handle):real;
{ 円弧図形の半径を返す。 }
var
＿x1, y1, x2, y2＿:real;
begin
＿Get2DPt(h, 1, x1, y1);
＿Get2DPt(h, 2, x2, y2);
＿GetArcRadius:= Distance(x1, y1, x2, y2);
end;{GetArcRadius}

function GetVertType(h:handle; i:integer):integer;
{ 曲線の頂点のタイプを返す。 }
var
＿result＿:integer;
＿x, y, r＿:real;
begin
＿GetPolylineVertex(h, i, x, y, result, r);
＿GetVertType:= result;
end;{GetVertType}
＿
function GetVertRadius(hC:handle; i:integer; var err:boolean):real;
{ 曲線hのi番目の頂点のフィレット半径（実径）を返す。 }
var
＿result＿:real;
＿h, hC2, hA, hD, hTop＿:handle;
＿iV, iA＿:integer;
begin
＿if (GetType(hC) <> CurveObj) | (GetVertType(hC, i) <> Filet) then begin
＿＿err:= true;
＿＿result:= 0;
＿end
＿else begin
＿＿err:= false;
＿＿{ 最後から何番目の円弧か調べる }
＿＿iA:= 0;
＿＿for iV:= GetVertNum(hC) downto i do begin
＿＿＿if GetVertType(hC, iV) = Filet then begin
＿＿＿＿iA:= iA + 1;
＿＿＿end;
＿＿end;
＿＿{ 曲線を分解 }
＿＿hC2:= HDuplicate(hC, 0, 0);
＿＿hTop:= PrevObj(hC2);
＿＿DSelectAll;
＿＿SetSelect(hC2);
＿＿DoMenuTextByName('Decompose', 0);
＿＿{ 円弧のハンドルを得る }
＿＿hA:= nil;
＿＿iV:= 1;
＿＿h:= NextObj(hTop);
＿＿while (h <> nil) do begin
＿＿＿hD:= h;
＿＿＿if GetType(h) = ArcObj then begin
＿＿＿＿if iV = iA then
＿＿＿＿＿hA:= h;
＿＿＿＿iV:= iV + 1;
＿＿＿end;{if}
＿＿＿h:=NextObj(h);
＿＿＿DelObject(hD);
＿＿end;{while}
＿＿result:= GetArcRadius(hA);
＿end;
＿GetVertRadius:= result;
end;{GetVertRadius}

begin{test}
＿DSelectAll;
＿ReDraw;
＿Message('曲線をクリックしてください。');
＿GetPt(x, y);
＿h:= PickObject(x, y);
＿if (h <> nil) & (GetType(h) = CurveObj) then begin
＿＿SetTool(-214);
＿＿SetSelect(h);
＿＿ReDraw;
＿＿n:= GetVertNum(h);
＿＿Message('半径を調べる頂点をクリックしてください。');
＿＿GetPt(x0, y0);
＿＿iA:= 0;
＿＿d0:= HPerim(h);
＿＿for i:= 1 to n do begin
＿＿＿GetPolylineVertex(h, i, x, y, tp, r);
＿＿＿d:= Distance(x0, y0, x, y);
＿＿＿if d < d0 then begin
＿＿＿＿iA:= i;
＿＿＿＿d0:= d;
＿＿＿end;
＿＿end;
＿＿if GetVertType(h, iA) = Filet then begin
＿＿＿Message('R(', iA, ') = ', GetVertRadius(h, iA, err));
＿＿end
＿＿else begin
＿＿＿AlrtDialog('半径を調べる頂点をクリックしてください。');
＿＿＿ClrMessage;
＿＿end;
＿end
＿else begin
＿＿AlrtDialog('曲線をクリックしてください。');
＿＿ClrMessage;
＿end;
end;
Run(test);

石男さんへ、
＞曲線図形のデータパレットのフィレット設定を再度設定すると
＞きちんと円弧半径が取得できます。
「フィレットの設定」を開くと半径のデフォルト値が実際の半径になってるので、「OK」
ボタンを押したらその値に再設定される理屈です。
曲線を作る時に実際の半径を計算するのは面倒なので、最大直径を指定する（またはゼロ
を指定する）ほうが合理的ですが、頂点の情報を調べる時には実際の半径のほうが知りた
いですね。

＞仕様なのでしょうがないかな。
データパレットには表示されるし、実際の半径が判らないと図形が生成できないので、VW
の内部では値を持ってる筈です。NNAかA&Aに関数１個作ってもらえば解決ですね...

PIOだと無理ですが、普通のスクリプトなら、

hC:= HDuplicate(hCurve, dx, dy);
DSelectAll;
SetSelect(hC);
DoMenuTextByName('Convert to Lines', 0);
で曲線を分解して、

n:= GetVertexNum(hCurve);
c:= 0;
for i:= 1 to 求める頂点番号 do begin
＿GetPolylineVertex(hCurve, i, x, y, tp, r);
＿if tp = 円弧頂点 then
＿＿c:= c + 1;
end;{for}
で何番目の円弧か調べて、

h:= FSActLayer; { もしかしたら LSActLayer かも }
hArc:= nil;
i:= 1;
while (h <> nil) & (i <= c) do begin
＿if GetType(h) = 円弧図形 then begin
＿＿if i = c then
＿＿＿hArc:= h;
＿＿i:= i + 1;
＿end;{if}
＿h:= NextSObj(h); { LSActLayer なら PredSObj(h); }
end;{while}
のような方法で円弧図形のハンドル(hArc)を取って、実際の半径を求められます。
グループや3D図形の中でも実行可能にしようとすると面倒になりますが...

VW11の裏の関数に、
ConvertToPolygon(h: HANDLE; resolution: INTEGER) : HANDLE;
というのがあるので、もしPIOの中で使えたら、３個の頂点を調べて半径を求めることも
不可能ではないと思います。

与太郎さんへ
＞GetPolylineVertex(h, i, x, y, tp, R);で返ってくるＲは設定値...
という曲線図形の円弧半径が取れない...ってお話がありましたが、曲線図形のデータ
パレットのフィレット設定を再度設定するときちんと円弧半径が取得できます。

これはどうやら曲線図形を作る際に、円弧を設定せず曲線をつくると上の現象が起きる
ようですが、普通曲線図形を作るのに円弧を指定しながら作る方が難しいと思うのです
が...、仕様なのでしょうがないかな。

訂正です。

{ 異なる種類の図形を選択解除します。 }begin の、beginの前の改行が消えています。
＿＿ForEachObj(DoObject, SEL=TRUE); は、
＿＿ForEachObject(DoObject, SEL=TRUE); の間違いです。

元のスクリプトはFInGroup, FInSymbol, FInLayerでハンドルを取って、whileループで全
部の図形にアクセスしてました。書き込む直前に、ForEachObject１行で済むことに気付い
て書き直しましたが、確認せずに書き込んでしまいました。

数種類のPIOを選択したとき、データパレットの挙動がMac版とWin版(デモ版)で異なります。
VW10,11/Mac → クラスとレイヤ以外表示されません。不便ではあるものの、問題はありません。
VW10,11/Win → 最初に選択されたPIO、または名前のコード番号が小さいPIOのパラメータが表
示され、変更もできます。ただし、データパレットに表示されていないPIOの、同じ位置のパラ
メータも変更されてしまいます。パラメータはPIOごとに異なるので、想定外の動作やエラーが
起きます。

PIOのパラメータが変な値で書き換えられると困るので、選択図形から目的外の種類の図形を選
択解除するスクリプトを書いてみました。
メニュー化して、コンテキストメニューに登録すると便利だと思います。
文字や寸法だけ選択したい場合も、選択マクロより早いです。

procedure DSelectOtherTypeObject;
{ クリック図形と異なるタイプの図形を選択解除します。 }
{ 種類が異なるPIO、シンボル選択解除します。 }
const
＿SymbolObj = 15;
＿PlugInObj = 86;
var
＿h＿:handle;
＿tp＿:integer;
＿symName,
＿recName＿:string;
＿x, y＿:real;

procedure DoObject(h:handle);
{ 異なる種類の図形を選択解除します。 }begin
＿if GetType(h) = tp then begin
＿＿case tp of
＿＿＿SymbolObj: begin
＿＿＿＿if symName <> GetSymName(h) then begin
＿＿＿＿＿SetDSelect(h);
＿＿＿＿end;
＿＿＿end;
＿＿＿PlugInObj: begin
＿＿＿＿if recName <> GetName(GetRecord(h, 1)) then begin
＿＿＿＿＿SetDSelect(h);
＿＿＿＿end;
＿＿＿end;
＿＿end;
＿end
＿else begin
＿＿SetDSelect(h);
＿end;
end;{DoObject}

begin{main}
＿Message('選択したままにするタイプの図形をクリックしてください。');
＿repeat
＿＿GetPt(x, y);
＿＿h:= PickObject(x, y);
＿until (h = nil) | Selected(h);
＿ClrMessage;
＿if h = nil then begin
＿＿AlrtDialog('選択したままにするタイプの図形をクリックしてください。');
＿end
＿else begin
＿＿tp:= GetType(h);
＿＿case tp of
＿＿＿SymbolObj: begin
＿＿＿＿symName:=GetSymName(h);
＿＿＿end;
＿＿＿PlugInObj: begin
＿＿＿＿recName:= GetName(GetRecord(h, 1));
＿＿＿end;
＿＿end;
＿＿ForEachObj(DoObject, SEL=TRUE);
＿end;
end;
Run(DSelectOtherTypeObject);

連続して3D多角形（三角形）を描くスクリプトです。
3D基準点をクリックして、3D多角形を作成します。
三斜を切るスクリプトにも応用できるはずです。

procedure Draw3DPolys;
{ 連続3D三角形作成 }
label
＿999;
const
＿Locus3DObj = 9;
＿Poly3DObj = 25;
var
＿result＿:boolean;
＿h, hL＿:handle;
＿xC, yC, x0, y0, x1, y1, x2, y2, x3, y3＿:real;
＿x, y, z＿:array[0..3] of real;
＿i, n＿:integer;
＿
procedure GetNext3DPoint(x0, y0:real; var x1, y1:real; var result:boolean);
var
＿h＿:handle;
＿hP＿:handle;
＿i, j＿:integer;
＿x4, y4＿:real;
＿x2, y2＿:array[0..3] of real;
＿x3, y3, z3＿:array[0..3] of real;
begin
＿result:= false;
＿repeat
＿＿GetPtL(x0, y0, x1, y1);
＿＿h:= PickObject(x1, y1);
＿＿if (h <> nil) then begin
＿＿＿if (GetType(h) = Locus3DObj) then begin
＿＿＿＿GetLocus3D(h, x[3], y[3], z[3]);
＿＿＿＿x[3]:= x[3] - xC; y[3]:= y[3] - yC;
＿＿＿＿if ((x[1] <> x[3]) | (y[1] <> y[3]) | (z[1] <> z[3])) &
＿＿＿ ＿ ((x[2] <> x[3]) | (y[2] <> y[3]) | (z[2] <> z[3])) then begin
＿＿＿＿＿result:= true;
＿＿＿＿end;
＿＿＿end
＿＿＿else if (GetType(h) = Poly3DObj) then begin
＿＿＿＿Tab(4);
＿＿＿＿for i:= 1 to 3 do begin
＿＿＿＿＿GetPolyPt3D(h, i-1, x3[i], y3[i], z3[i]);
＿＿＿＿＿x3[i]:= x3[i] - xC; y3[i]:= y3[i] - yC;
＿＿＿＿＿Locus3D(x3[i], y3[i], z3[i]);
＿＿＿＿＿hP:= LNewObj;
＿＿＿＿＿GetBBox(hP, x2[i], y2[i], x4, y4);
＿＿＿＿＿x2[i]:= (x2[i]+x4)/2; y2[i]:= (y2[i]+y4)/2;
＿＿＿＿＿DelObject(hP);
＿＿＿＿end;
＿＿＿＿x2[0]:= x2[1]; y2[0]:= y2[1];
＿＿＿＿j:= 1;
＿＿＿＿for i:= 2 to 3 do begin
＿＿＿＿＿if Distance(x1, y1, x2[i], y2[i]) < Distance(x1, y1, x2[0], y2[0]) then begin
＿＿＿＿＿＿x2[0]:= x2[i]; y2[0]:= y2[i];
＿＿＿＿＿＿j:= i;
＿＿＿＿＿end;
＿＿＿＿end;
＿＿＿＿x[3]:= x3[j]; y[3]:= y3[j]; z[3]:= z3[j];
＿＿＿＿x1:= x2[j]; y1:= y2[j];
＿＿＿＿result:= true;
＿＿＿end
＿＿＿else begin
＿＿＿＿SysBeep;
＿＿＿＿Message('3D基準点をクリックしてください。');
＿＿＿end;
＿＿end;
＿until result | (h = nil);
end;{GetNext3DPoint}
＿
begin{main}
＿GetOrigin(xC, yC);
＿ClosePoly;
＿Message('最初の3D基準点をクリックしてください。');
＿GetPt(x1, y1);
＿h:= PickObject(x1, y1);
＿if (h = nil) | (gETtYPE(H) <> Locus3DObj) then begin
＿＿AlrtDialog('3D基準点をクリックしてください。');
＿＿Goto 999;
＿end;
＿GetLocus3D(h, x[1], y[1], z[1]);
＿x[1]:= x[1] - xC; y[1]:= y[1] - yC;
＿Message('２番目の3D基準点をクリックしてください。');
＿GetPtL(x1, y1, x2, y2);
＿h:= PickObject(x2, y2);
＿if (h = nil) | (gETtYPE(H) <> Locus3DObj) then begin
＿＿AlrtDialog('3D基準点をクリックしてください。');
＿＿Goto 999;
＿end;
＿GetLocus3D(h, x[2], y[2], z[2]);
＿x[2]:= x[2] - xC; y[2]:= y[2] - yC;
＿if EqualPt(x[1], y[1], x[2], y[2]) then begin
＿＿Goto 999;
＿end;
＿MoveTo(x1, y1);
＿LineTo(x2, y2);
＿hL:= LNewObj;
＿ReDraw;
＿Message('３番目の3D基準点をクリックしてください。');
＿GetNext3DPoint(x2, y2, x3, y3, result);
＿DelObject(hL);
＿if not result then begin
＿＿AlrtDialog('3D基準点をクリックしてください。');
＿＿Goto 999;
＿end;
＿if EqualPt(x[1], y[1], x[3], y[3]) | EqualPt(x[2], y[2], x[3], y[3]) then begin
＿＿Goto 999;
＿end;
＿Poly3D(x[1], y[1], z[1], x[2], y[2], z[2], x[3], y[3], z[3]);
＿HMoveBackward(LNewObj, true);
＿ReDraw;
＿repeat
＿＿x0:= x3; y0:= y3;
＿＿x[0]:= x[3]; y[0]:= y[3]; z[0]:= z[3];
＿＿Message('次のポリゴンの頂点にする3D基準点をクリックしてください。空クリックで終了。');
＿＿GetNext3DPoint(x0, y0, x3, y3, result);
＿＿if result then begin
＿＿＿if Distance(x1, y1, x3, y3) < Distance(x2, y2, x3, y3) then begin
＿＿＿＿x[2]:= x[0]; y[2]:= y[0]; z[2]:= z[0];
＿＿＿＿x2:= x0; y2:= y0;
＿＿＿end
＿＿＿else begin
＿＿＿＿x[1]:= x[0]; y[1]:= y[0]; z[1]:= z[0];
＿＿＿＿x1:= x0; y1:= y0;
＿＿＿end;
＿＿＿if EqualPt(x[1], y[1], x[3], y[3]) | EqualPt(x[2], y[2], x[3], y[3]) then begin
＿＿＿＿result:= false;
＿＿＿end
＿＿＿else begin
＿＿＿＿Poly3D(x[1], y[1], z[1], x[2], y[2], z[2], x[3], y[3], z[3]);
＿＿＿＿HMoveBackward(LNewObj, true);
＿＿＿＿ReDraw;
＿＿＿end;
＿＿end;
＿until not result;
999:
＿ClrMessage;
end;
Run(Draw3DPolys);

＞素人さんは手を出しちゃいけねえよ（笑）。
確かに（笑）きっと、ある場所も分からないかも...。拡張子pのファイルよりhファイ
ルの方が確かです。ただ、Cで書かれてありますが。

自分で作るかとも思ったのですが、あるものは使おうという方針なので...。

＞裏の手続き／関数
素人さんは手を出しちゃいけねえよ（笑）。
どのバージョンでも使えるわけでなく、同バージョンでも使えるとは限らないですからねぇ。
プラグイン開発者が自分のプラグインで使うために作ってるんですから、まちがった使い方
をしてトラブっても文句を言ってゆくわけにもいかないし。
でも、手続き／関数の定義部（宣言部？）を見ただけで使い方が一目瞭然なのが多いので、
ついつい誘惑に負けてしまうと...

自分で関数を作るなら、点と線の座標を、線が水平になるように回転して、Y座標の差を比べます。
X座標を調べれば、実際に線上にあるか、延長線上にあるかも判ります。直線の公式（y=ax+b）
で求めるのと違って、条件分けを考える必要がありません。
実際に図形を書いて回転すれば、座標変換も不要です。

>このItemIDに何が定義されているか
>全て確認することは出来ますか？

VectorScript Language Guide
http://www.nemetschek.net/support/custom/vscript/docs.html

Online Function Reference
http://www.nemetschek.net/support/custom/vscript/functionref/VSFunctionReference.html

直線と直線の交点を調べる手続き／関数はあっても、直線上の点なのか調べる手続き／
関数はないんですね。裏の手続き／関数にこんなものがありました。
PtOnLine(ptX, ptY, ptZ: REAL; begPtX, begPtY, begPtZ: REAL; endPtX, endPtY,
endPtZ: REAL; tolerance: REAL) : BOOLEAN;
tolerance以外のReal型引数はVector型です。正確には
PtOnLine(pt, begpt, endpt : VECTOR; tolerance: REAL) : BOOLEAN;
toleranceは許容値でした。これをシビアにするとオンザラインになりません。
カスタマイズもほどほどと思う今日この頃...。

>SetupDialogC は VectorScript の内部で定義されているItem ID というふうに考えて
ください。
このItemIDに何が定義されているか
全て確認することは出来ますか？

>SetupDialogCは一見ラベルのようですけれどもこれも特殊だが決まり文句だと思えばいいのですか？

SetupDialogC は VectorScript の内部で定義されているItem ID というふうに考えて
ください。

返答ありがとうございます。
dataは気にしないで良いけれどは使われているのですね？
SetupDialogCは一見ラベルのようですけれどもこれも特殊だが決まり文句だと思えばいいのですか？
このようなラベルは他にもあるのですか？

> AandAのサンプルCreateListBoxNについて
では変数itemが意味しているのは「OK」=1、「Cancel」=2、「CreateListBoxN」=4になります。3は使っていません。変数dataは特に気にせずに。

>SetupdDialogCは何を意味するのか？
Drive_ListDialogScriptが呼ばれた時、言い換えればカスタムダイアログを呼び出した際、最初のダイアログ表示はどのアイテムをどのように表示するかという意味に理
解した方が分かりやすいです。
ですから、このサンプルではアイテム「CreateListBoxN」の中身をSetupdDialogCで
定義しています。

A&AのサンプルCreateListBoxNについて
PROCEDURE Drive_ListDialogScript( VAR item:LONGINT; data:LONGINT );
この手続きのitem,dataがどう扱われるのか？
CASE item OF　SetupDialogC:　BEGIN
このcase文は一般的なcase文は違うようですがSetupdDialogCは何を意味するのか？
教えてください。

早速の返答ありがとうございました。
使用することができました。
また何かありましたら　よろしくお願いします。

typeという変数名を使っているVW8用のPIO(Plug-in Object)は、VW9以降ではエラーが出て使え
ません。使えるようにするにはPIOのScriptを修正する必要があります。
VectorScriptエディタでは文字の検索／置換が出来ないので、一旦テキストエディタにコピー
してから修正します。

type ⇒ wyeTypeに変更する例：
1. 修正する前に、念の為プラグインの複製を作っておきます。
2. 「階層」―「プライングコマンド...」でプラグインを選択して、「コマンド編集...」ボタン
でVectorScriptエディタを開きます。
3. テキスト(Script)を全選択後コピーして、テキストエディタにペーストします。
4. 「wyeType」を単語検索してScriptで使われてないことを確認します。
5. 全ての「type」という単語を「wyeType」に置換えます。エディタで単語単位の検索が可能な
ら「全置換」で構いません。そうでなければ検索された「type」が単語か単語の一部か確認しな
がら、単語なら「置換えして次に」、単語の一部なら「次を検索」で最後まで進みます。
6. 修正したScriptをVectorScriptエディタにコピーします。
7. コンパイル・ボタン（VectorScriptエディタの左上）を押してエラーが出なければOKです。

自己レス
大変御丁寧なご返答ありがとうございます。
早速、自分でも練ってみたいと思います。

manabuさん、はじめまして。

寸法のフォントやサイズ設定専用のprocedureはありません。SetObjectVariable???という汎用
のprocedureで設定します。
SetObjectVariable???(図形ハンドル, セレクタ番号, 設定値); という要領です。

VectorScript 11.0 Function Reference ⇒ Additional Resources ⇒ VectorScript Appendix
⇒ Appendix G - Object Selectors ⇒ Dimensions に寸法図形のセレクタ番号が載っています。
VW11では、フォントIDのセレクタ番号が28、文字サイズのセレクタ番号が40になっています。
フォントIDはinteger型、文字サイズはreal型なので、
フォントIDは SetObjectVariableInt(objectHandle, 28, fontID);
文字サイズは SetObjectVariableReal(objectHandle, 40, textSize);
で設定出来ます。
たとえば、下のようになります。（＿はタブに変換、または削除して実行してください。）

procedure SetDimTextAttr;
{ 選択されている寸法のフォントと文字サイズを設定する。 }
const
＿FontName = 'ＭＳ ゴシック';
＿TextSize = 12;
var
＿c＿:longint;

procedure DoDimension(h:handle);
{ ForEachObjectから呼ばれるサブルーチン }
begin
＿c:= c + 1;
＿SetObjectVariableInt(h, 28, GetFontID(FontName));
＿SetObjectVariableReal(h, 40, TextSize);
＿ResetObject(h);
end;{DoDimension}

begin{main}
＿c:= 0;
＿ForEachObject(DoDimension, ((T=DIMENSION) & (SEL=TRUE)));
＿ReDrawAll;
＿if c = 0 then begin
＿＿AlrtDialog('寸法が選択されていません！');
＿end
＿else begin
＿＿AlrtDialog(Concat(c, '個の寸法のフォントと文字サイズを設定しました。'));
＿end;
end;{main}
Run(SetDimTextAttr);

SetObjectVariable???で設定しても、ResetObjectを実行しないと図形の表示は変わりません。

※ 今までConcat(Num2Str(0, c), 'XXX')と書いてましたが、Concat(c, 'XXX')でも問題ないよ
うです。

VectorWorks談話室の方から移動してきました
VW11 Plusに含まれる文字セットメニューの様なもので寸法線のフォントと文字サイズをまとめて変更するコマンドが作りたいのですが
SetTextFontやSetTextSizeといった関数はありますが
寸法線Dimensionsにはこのような関数はないようです
どうすればよいでしょうか

検索条件に「アクティブレイヤ」がないので、アクティブレイヤの名前で指定しますが、
SelectObj((L=ActLayer)&(T=Text)); も、 SelectObj((L=GetLName(ActLayer))&(T=Text));
もうまくゆきません。一旦変数にレイヤ名を入れて、変数で指定する必要があります。

procedure SelectActLayerText;
{ アクティブレイヤの文字を選択する }
var
layerName:string;
begin
layerName:= GetLName(ActLayer);
DSelectAll;
SelectObj((L=layerName)&(T=Text));
end;
Run(SelectActLayerText);

このスクリプトでは、本当にアクティブレイヤの文字しか選択されません。
編集可能なレイヤの文字を全て選択するには、
1. 全ての図形を選択解除。
2. Control(Command)＋Aで編集可能な図形を全て選択。
3. 文字以外を選択解除する。
でいいはずです。スクリプトにすると、

{ 編集可能なレイヤの文字を選択する }
DSelectALL;
DoMenuTextByName('Select All', 0);
DSelectObj(T<>Text);

となります。

フォントIDとフォント名のリストを Output.txt／Output File に書き出すスクリプトです。

procedure GetFontList;
var
＿i＿:longint;
＿ft＿:array[-32768..32767] of boolean;
＿fn＿:string;
begin
＿Message('配列を初期化中...');
＿for i:= -32768 to 32767 do
＿＿ft[i]:= false;
＿Message('フォントを調査中...');
＿for i:= -32768 to 32767 do begin
＿＿fn:= GetFontName(i);
＿＿if fn <> '' then
＿＿＿ft[GetFontID(fn)]:= true;
＿end;
＿Message('書き出し中...');
＿for i:= -32768 to 32767 do begin
＿＿if ft[i] | (i = 0) | (i=1) then begin
＿＿＿Write(i);
＿＿＿Tab(1);
＿＿＿WriteLn(GetFontName(i));
＿＿end;
＿end;
＿SysBeep;
＿Message('終わりました！');
end;
Run(GetFontList);

iをlongint型にしているのは、integer型だとforループが無限ループになるからです。
理由は、forループの最後でi(32767)に１を加算しますが、integerの範囲を超えるため、
32768ではなく-32768になってしまうからです。これは、forループの始めで i>32767 か
どうかでループの終了を判定しているからでしょう。forループの終わりで i=32767 を
終了条件としていればinteger型でも問題なかったはずですが、いまさら変更されても困
りますけど（forループの後でカウンタ変数を参照している場合もありますし）。

あと、Win2000のフォントIDでひとつ気付いたことがあります。
それは、ID=0 のフォントが「@HGP創英角ｺﾞｼｯｸUB」だったことです。
Win版のVWで時々みかける、文字が横向きに表示されちゃうという現象は、プログラム内
でフォントIDを入れ忘れて、IDがゼロになって縦書き用フォントになるのが原因ではない
かと想像出来ます。

自己レスです。どうやら、z軸ーx軸の回転順序で大丈夫みたいですね。
トトロさんとこの大学のwebにそんな記述をみつけました。偉大な担当教員がいました
ね。出来れば、任意軸廻り回転のみのサブルーチン化して欲しいです...。

頭の中がぐるぐる回っています...、バックナンバーにSet3DRotについてのトトロさん
の記述がありました。回転角度はデグリーで指定していますが、思ったようにxyz軸に
対して回転してくれません。一通りやってみたのですが、どの回転順序が正しいのか
わかりません。だれか分かる方いませんか？

縦罫線の不具合を修正しました。
リソースプラウザでVectorScriptコマンドを新規作成して、下のスクリプトをペーストしてください。
コピペする前に「＿」(全角下線)をタブに変換、または削除してください。

デスクトップにテキストファイルとして保存し、「階層」―「コマンドを実行...」でも実行できます。

使い方は、図形化したいワークシートを表示、またはワークシート図形を選択して、実行します。
一度に一個のＷＳが変換されます。
ワークシート図形を選択した場合は同じ位置に図形が出来ます。アクティブなワークシートを変換す
るときは、コマンド実行後、図形を作る位置（左上）をクリックしてください。
図形の種類別にクラスを分けているので、線の太さや色はクラス属性で変えられます。

procedure WS_to_GroupObj;
{ Version 0.999 }
{ ワークシートをグループ図形にします（var9以降に対応）}
{ by 与太郎 2004/04/03〜2004/04/03 }
{ 2004/04/12 ワークシート図形を選択しても実行するように修正}
{ 〃　ワークシート図形を選択したときは同位置にグループ図形を作成、ワークシート図形を削除する }
{ 〃　列幅がゼロのときは文字を表示しないように修正 }
{ 〃　グリッドの色をシアンに変更 }
{ 2004/8/26 データベースのサブ行も表示するように修正 }
{ 〃　非表示グリッドのクラスを定義 }
{ 2005/4/6 縦罫線のバグ修正 }
{ 図形化したいワークシートを表示、またはワークシート図形を選択して、実行する }
{ 属性はクラス属性で変更可能 }
{ クラス名、クラス属性、セルの余白は好みで書き換えてください。 }
{$ DEBUG}
const

{ クラス名とクラス属性 }
＿ClsWSText = 'WS-Text';
＿ClsWSGrid = 'WS-Grid';
＿ClsWSGridHd = 'WS-Grid_Hide';{ ----2004/8/26 追加 }
＿ClsWSOutLine = 'WS-Outline';
＿ClsWSBorder = 'WS-Border';
＿OutlineWidth = 21;{ 0.53ミリ }
＿OutlineColor = 15;{ 赤色 }
＿GridWidth = 1;{ 0.025ミリ }
＿GridColor = 2;{ シアン }
＿GridHdWidth = 1;{ 0.025ミリ }{ ----2004/8/26 追加 }
＿GridHdColor = 5;{ 黄色 }{ ----2004/8/26 追加 }
＿LnWidth = 11;{ 0.28ミリ }
＿LnColor = 4;{ 青色 }
＿txtColor = 15;{ 赤色 }
＿
{ セルの余白 }
＿LeftMargin = 3;{ 3ポイント=1.06ミリ }
＿RightMargin = 3;{ 3ポイント=1.06ミリ }

{ オブジェクト識別番号 }
＿ShowGrid = 83;{ ＷＳのグリッド表示 }{ ----2004/8/26 追加 }
＿
type
＿wsCell = structure
＿＿subAlign, { ----2004/8/26 追加 }
＿＿align＿:integer;{ 0=標準／1=左よせ／2=センタ／3=右よせ }
＿＿txt＿:string;{ セルの内容 }
＿＿fontID＿:integer;
＿＿size＿:integer;
＿＿Style＿:integer;{Plain:0／Bold:1／Italic:2／Underline:4／Outline:8／Shadow:16}
＿end;{structure}
＿
var
＿k＿:real;＿{ 描画倍率 }
＿hWS＿:handle;＿{ ＷＳのハンドル }
＿hTbl＿:handle;＿{ ＷＳ図形のハンドル }
＿maxRow, maxClm＿:integer;＿{ ＷＳの行数，列数 }
＿maxRowDB＿:integer;＿{ サブ行を含んだ行数 }{ ----2004/8/24 追加 }
＿indexRDB＿:dynArray[] of integer;＿{ 行番号→サブ行を含んだ行番号 }{ ----2004/8/24 追加 }
＿wd＿:dynArray[] of integer;＿{ セル幅 }
＿ht＿:dynArray[] of integer;＿{ セル高さ }
＿subRows＿:dynArray[] of integer;＿{ サブ行の数 }{ ----2004/8/24 追加 }
＿x＿:dynArray[] of real;＿{ セル境界のＸ座標 }
＿y＿:dynArray[] of real;＿{ セル境界のＹ座標 }
＿hLine＿:dynArray[,] of boolean;＿{ 横罫線の有無 }
＿vLine＿:dynArray[,] of boolean;＿{ 縦罫線の有無 }

procedure Set_k;{ 描画倍率を計算します。 }
var
＿scale＿:real;
＿upi＿:real;
＿fraction, display＿:longint;
＿format＿:integer;
＿name, squareName＿:string;
begin
＿scale:= GetLScale(ActLayer);
＿GetUnits(fraction, display, format, upi, name, squareName);
＿k:= upi * scale / 25.4 / 72 * 25.4;
end;{Set_k}

procedure GetWSHandle(var hWS, hTbl:handle);
{ ワークシートとワークシート図形のハンドルを返します。 }
begin
＿hWS:= ActSSheet;
＿if hWS = nil then begin
＿＿hTbl:= FSActLayer;
＿＿if (hTbl <> nil) & (GetType(hTbl) = 56) then begin
＿＿＿hWS:= GetWSFromImage(hTbl);
＿＿end;{if}
＿end;{if}
end;{GetWSHandle}

function Row2RowDB(row, subRow:integer):integer;
begin
＿Row2RowDB:= indexRDB[row] + subRow;
end;{Row2RowDB}

procedure Init_Vars;{ 変数を初期化します。 }
var
＿row, rowDB, clm＿:integer;{ ----2004/8/24 rowDBを追加 }
＿top, left, bottom, right＿:boolean;
＿
＿procedure Set_or(var source:boolean; dist:boolean);
＿begin
＿＿source:= source or dist;
＿end;{Set_or}
＿
＿begin{Init_Vars}
＿＿{ 配列を確保 }
＿＿GetWSRowColumnCount(hWS, maxRow, maxClm);
＿＿Allocate indexRDB[0..maxRow];{ ----2004/8/24 追加 }
＿＿Allocate subRows[0..maxRow];{ ----2004/8/24 追加 }
＿＿
＿{ ↓2004/8/24 追加 }
＿＿for row:= 1 to maxRow do
＿＿＿subRows[row]:= 0;
＿＿indexRDB[0]:= 0;
＿＿subRows[0]:= 0;
＿＿for row:= 1 to maxRow do begin
＿＿＿if IsWSDatabaseRow(hWS, row) then
＿＿＿＿GetWSSubrowCount(hWS, row, subRows[row]);
＿＿＿indexRDB[row]:= indexRDB[row-1] + subRows[row-1] + 1;
＿＿end;{for}
＿＿maxRowDB:= indexRDB[maxRow] + subRows[maxRow];
＿{ ↑2004/8/24 追加 }
＿＿
＿＿Allocate ht[1..maxRowDB];
＿＿Allocate wd[1..maxClm];
＿＿Allocate x[0..maxClm];
＿＿Allocate y[0..maxRowDB];
＿＿Allocate hLine[0..maxRowDB, 0..maxClm];
＿＿Allocate vLine[0..maxRowDB, 0..maxClm];
＿＿
＿＿{ セルの寸法を取得 }
＿＿for row:= 1 to maxRow do
＿＿＿GetWSRowHeight(hWS, row, ht[row]);
＿＿for clm:= 1 to maxClm do
＿＿＿GetWSColumnWidth(hWS, clm, wd[clm]);
＿＿
＿＿{ 罫線を取得 }
＿＿for row:= 0 to maxRow do begin
＿＿＿for clm:= 0 to maxClm do begin
＿＿＿＿hLine[row, clm]:= false;
＿＿＿＿vLine[row, clm]:= false;
＿＿＿end;{for}
＿＿end;{for}
＿＿
＿{ ↓2004/8/26 修正 }
＿＿for row:= 1 to maxRow do begin
＿＿＿for rowDB:= indexRDB[row]+0 to indexRDB[row]+SubRows[row] do begin
＿＿＿＿for clm:= 1 to maxClm do begin
＿＿＿＿＿GetWSCellBorder(hWS, row, clm, top, left, bottom, right);
＿＿＿＿＿Set_or(hLine[rowDB-1, clm], top);
＿＿＿＿＿Set_or(hLine[rowDB, clm], bottom);
＿＿＿＿＿Set_or(vLine[rowDB, clm-1], left);
＿＿＿＿＿Set_or(vLine[rowDB, clm], right);
＿＿＿＿end;{for}
＿＿＿end;{for}
＿＿end;{for}
＿{ ↑2004/8/24 修正 }
end;{Init_Vars}

procedure Set_XY;{ ＸＹ座標を計算します。 }
var
＿row, rowDB, clm＿:integer;{ ----2004/8/24 rowDBを追加 }
begin
＿for clm:= 1 to maxClm do
＿x[clm]:= x[clm-1] + k * wd[clm];

{ ↓2004/8/24 修正 }
＿for row:= 1 to maxRow do
＿＿for rowDB:= indexRDB[row]+0 to indexRDB[row]+SubRows[row] do
＿＿＿y[rowDB]:= y[rowDB-1] - k * ht[row];
{ ↑2004/8/24 修正 }
end;{Set_XY}

function BeClass(cls:string):boolean;
{ クラスの有無を返します。 }
var
＿i＿:integer;
＿be＿:boolean;
begin
＿i:= 1;
＿be:= false;
＿while (i <= ClassNum) & (not be) do begin
＿＿if cls = ClassList(i) then
＿＿be:= true;
＿＿i:= i + 1;
＿end;{while}
＿BeClass:= be;
end;{BeClass}

procedure SetClassAttrs;{ ----2004/8/26 修正 }
{ クラス属性を設定します。クラスがある場合は何もしません。 }
＿
＿procedure SetClsAttr(cls:string; col, wd:integer);
＿begin
＿＿if not BeClass(cls) then begin
＿＿＿NameClass(cls);
＿＿＿SetClPenFore(cls, col);
＿＿＿SetClLW(cls, wd);
＿＿end;{if}
＿end;{SetClsAttr}
＿
begin{SetClassAttrs}
＿SetClsAttr(ClsWSGrid, GridColor, GridWidth);
＿SetClsAttr(ClsWSGridHd, GridHdColor, GridHdWidth);
＿SetClsAttr(ClsWSOutline, OutlineColor, OutlineWidth);
＿SetClsAttr(ClsWSBorder, lnColor, lnWidth);
＿SetClsAttr(ClsWSText, txtColor, 14);
end;{SetClassAttrs}

procedure DrawGrid;{ ----2004/8/24 修正 }
{ グリッドを描きます。 }
var
＿rowDB, clm＿:integer;
begin
＿BeginGroup;
＿＿for rowDB:= 1 to maxRowDB-1 do begin
＿＿＿MoveTo(x[0], y[rowDB]);
＿＿＿LineTo(x[maxClm], y[rowDB]);
＿＿end;{for}
＿＿
＿＿for clm:= 1 to maxClm-1 do begin
＿＿＿MoveTo(x[clm], y[0]);
＿＿＿LineTo(x[clm], y[maxRowDB]);
＿＿end;{for}
＿EndGroup;
end;{DrawGrid}

procedure DrawOutline;{ ----2004/8/24 修正 }
{ 外枠を描きます。 }
begin
＿Rect(x[0], y[0], x[maxClm], y[maxRowDB]);
end;{DrawOutline}

procedure DrawHBorders;{ ----2004/8/24 修正 }
{ 水平線を書きます。 }
var
＿rowDB, c1, c2＿:integer;
＿
＿function StartClm(c:integer):integer;
＿begin
＿＿repeat
＿＿＿c:= c + 1;
＿＿until (maxClm <= c) | (hLine[rowDB, c]);
＿＿if (c <= maxClm) & (hLine[rowDB, c]) then
＿＿＿StartClm:= c
＿＿else
＿＿＿StartClm:= 0;
＿end;{StartClm}
＿
＿function EndClm(c:integer):integer;
＿begin
＿＿while (c < maxClm) & hLine[rowDB, c+1] do
＿＿＿c:= c + 1;
＿＿EndClm:= c;
＿end;{EndClm}
＿
begin{DrawHBorders}
＿for rowDB:= 0 to maxRowDB do begin
＿＿c1:= StartClm(0);
＿＿while (c1 <> 0) do begin
＿＿＿c2:= EndClm(c1);
＿＿＿MoveTo(x[c1-1], y[rowDB]);
＿＿＿LineTo(x[c2], y[rowDB]);
＿＿＿c1:= StartClm(c2);
＿＿end{while}
＿end;{for}
end;{DrawHBorders}

procedure DrawVBorders;{ ----2004/8/24 修正 }
{ 垂直線を描きます。 }
var
＿clm, r1, r2＿:integer;
＿
＿function StartRow(r:integer):integer;
＿begin
＿＿repeat
＿＿＿r:= r + 1;
＿＿until (maxRowDB <= r) | (vLine[r, clm]);
＿＿if (r <= maxRowDB) & (vLine[r, clm]) then
＿＿＿StartRow:= r
＿＿else
＿＿＿StartRow:= 0;
＿end;{StartRow}
＿
＿function EndRow(r:integer):integer;
＿begin
＿＿while (r < maxRowDB) & vLine[r+1, clm] do
＿＿＿r:= r + 1;
＿＿EndRow:= r;
＿end;{EndRow}

begin{DrawVBorders}
＿for clm:= 0 to maxClm do begin
＿＿r1:= StartRow(0);
＿＿while (r1 <> 0) do begin
＿＿＿r2:= EndRow(r1);＿{ ----2005/4/6 修正（行の入れ替え） }
＿＿＿MoveTo(x[clm], y[r1-1]);{ ----2005/4/6 修正（行の入れ替え） }
＿＿＿LineTo(x[clm], y[r2]);＿{ ----2005/4/6 修正（行の入れ替え） }
＿＿＿r1:= StartRow(r2);
＿＿end{while}
＿end;{for}
end;{DrawVBorders}

function CellAlign(h:handle; row, clm, subRow:integer):integer;{ ----2004/8/26 追加 }
{ セルの文字揃えを返します。 }
var
＿result＿:integer;
begin
＿GetWSCellAlignment(h, row, clm, result);
＿if result = 0 then begin
＿＿if subRow = 0 then begin
＿＿＿if CellHasNum(h, row, clm) then
＿＿＿＿result:= 3
＿＿＿else
＿＿＿＿result:= 1;
＿＿end{if}
＿＿else begin
＿＿＿if IsWSSubrowCellNumber(h, row, clm, subRow) then
＿＿＿＿result:= 3
＿＿＿else
＿＿＿＿result:= 1;
＿＿end;{else}
＿end;{if}
＿CellAlign:= result;
end;{CellAlign}

procedure DrawTexts;{ ----2004/8/26 修正 }
{ セルの文字を描きます。 }
var
＿row, rowDB, subRow, clm＿:integer;
＿cell＿:wsCell;
＿xT, yT＿:real;
begin
＿TextVerticalAlign(5);{ 下揃え }
＿for row:= 1 to maxRow do begin
＿＿for clm:= 1 to maxClm do begin
＿＿＿if (0 < wd[clm]) then begin
＿＿＿＿for subRow:= 0 to subRows[row] do begin
＿＿＿＿＿if subRow = 0 then
＿＿＿＿＿＿GetWSCellString(hWS, row, clm, cell.txt)
＿＿＿＿＿else
＿＿＿＿＿＿GetWSSubrowCellString(hWS, row, clm, subRow, cell.txt);
＿＿＿＿＿if (cell.txt <> '') then begin
＿＿＿＿＿＿GetWSCellTextFormat(hWS, row, clm, cell.fontID, cell.size, cell.style);
＿＿＿＿＿＿cell.align:= CellAlign(hWS, row, clm, subRow);
＿＿＿＿＿＿case cell.align of
＿＿＿＿＿＿＿0, 1: xT:= x[clm-1] + k * LeftMargin;
＿＿＿＿＿＿＿2: xT:= (x[clm-1] + x[clm]) / 2;
＿＿＿＿＿＿＿3: xT:= x[clm] - k * RightMargin;
＿＿＿＿＿＿end;{case}
＿＿＿＿＿＿rowDB:= row2rowDB(row, subRow);
＿＿＿＿＿＿yT:= y[rowDB];
＿＿＿＿＿＿TextJust(cell.align);
＿＿＿＿＿＿TextFont(cell.fontID);
＿＿＿＿＿＿TextSize(cell.size);
＿＿＿＿＿＿TextOrigin(xT, yT);
＿＿＿＿＿＿CreateText(cell.txt);
＿＿＿＿＿＿SetTextStyle(LNewObj, 0, GetTextLength(LNewObj), cell.style);
＿＿＿＿＿end;{if}
＿＿＿＿end;{for}
＿＿＿end;{if}
＿＿end;{for}
＿end{for}
end;{DrawTexts}

begin{main}
＿GetWSHandle(hWS, hTbl);
＿if hWS = nil then begin
＿＿AlrtDialog('ワークシートを開くか、選択してください。');
＿end{if}
＿else begin{ グループ図形を描く }
＿＿PushAttrs;
＿＿DSelectAll;
＿＿Set_k;
＿＿Init_Vars;
＿＿if hTbl = nil then begin
＿＿＿Message('図形を描く位置（左上）をクリックしてください。');
＿＿＿GetPt(x[0], y[0]);
＿＿end{if}
＿＿else begin
＿＿＿GetBBox(hTbl, x[0], y[0], x[maxClm], y[maxRow]);
＿＿end;{else}
＿＿Set_XY;
＿＿SetClassAttrs;
＿＿BeginGroup;
＿＿＿FillPat(0);
＿＿＿LSByClass;
＿＿＿LWByClass;
＿＿＿PenColorByClass;
＿＿＿NameClass(ClsWSText);
＿＿＿DrawTexts;
＿＿＿if GetObjectVariableBoolean(hWS, ShowGrid) then{ ----2004/8/26 追加 }
＿＿＿＿NameClass(ClsWSGrid)
＿＿＿else
＿＿＿＿NameClass(ClsWSGridHd);
＿＿＿DrawGrid;
＿＿＿NameClass(ClsWSBorder);
＿＿＿BeginGroup;
＿＿＿＿DrawHBorders;
＿＿＿＿DrawVBorders;
＿＿＿EndGroup;
＿＿＿NameClass(ClsWSOutline);
＿＿＿DrawOutline;
＿＿EndGroup;
＿＿if hTbl <> nil then
＿＿＿DelObject(hTbl)
＿＿else
＿＿＿ClrMessage;
＿＿PopAttrs;
＿＿ReDrawAll;
＿end;{else}
end;{main}
Run(WS_to_GroupObj);

＞VW11でも900〜1000は0〜500の倍の時間がかかってますが、
「VW11でも900〜1000は0〜100の倍の時間がかかってますが、」の間違いです。

いちおう図形のスライスは出来たので、3Dに変換して曲線に沿って曲げてみたいと
思いますが、２週間ほど手を付けられません。
そういうわけで、ご希望の方にスクリプトを完成させる権利を差し上げます。
とりあえず期限は3/31まで。

Winで時間を計ろうとしたら、VW9とVW10では切欠きが出来ませんでした。
MoveTo(x, y1);
LineTo(x, y2);
を、
MoveTo(x, yL);
LineTo(x, yU);
に直す必要があります。

私のショボイPC（Cel/1.1GHz/Win2000）で四角形を700分割するのに要した時間です。
（全部デモ版でやってます。）
取消し 　 ON 　OFF(0回)
VW9 　 　――　38.5
VW10　 　20.5　15.9
VW11　 　16.3　13.6

う〜ん、思った以上に時間がかかってます。やはりセレロンのせいでしょうか？
Appleの主張を裏付ける結果になってしまいました。

masafumiさん、おはようございます。
＞記憶が定かで有りませんが、環境設定の取消回数の数も比例していたような気がします。
回数は関係ないですが、取消回数をゼロにしたら700分割がそれぞれ13.9秒（VW8.5）、
9.6秒（VW9.5）、13.9秒（VW11）になりました。

こんばんは、与太郎さん。

>あと、VW8.5と9.5だと、最初は早くても後半は急激に遅くなるという、納得しがたい
>結果になりました。これは画面の書き換えが関係してるようです。

記憶が定かで有りませんが、環境設定の取消回数の数も比例していたような気がします。

procedure Slice2をいろんなバージョンで実行してみたら、予想外の結果でした。
まず、VW8.5（Classic環境）の場合、分割数が1,000でVWのメモリ割当が48MBだとメ
モリ不足でエラーになってしまいました。MaxNumの値は３か４で十分だと思います。
凸形状なら１でも構いません。
あと、VW8.5と9.5だと、最初は早くても後半は急激に遅くなるという、納得しがたい
結果になりました。これは画面の書き換えが関係してるようです。VW11ではReDrawし
ない限り、実行中の画面の書き換えは起こりません。

以下はPowerBookG3/400MHz OS10.3.7上で四角形をスライスした結果です。
実行する度に１割くらい変わることもあるので、何回か実行して、最短時間を計りま
した。１分以上は計測していません。
分割数　 100　 200　 300　 400　 500　 600　 700　 800　 900　1000
VW8.5 　 1.0　 2.6　 6.5　12.9　23.0　39.6　62.6　――　――　――
VW9.5 　 1.2　 2.8　 6.1　12.3　21.7　36.0　55.7　――　――　――
VW11　 　1.7　 3.8　 5.9　 8.2　10.7　13.4　16.2　19.5　22.5　25.9

VW11でも900〜1000は0〜500の倍の時間がかかってますが、このくらいの増加率なら
分割数に比例と言い切ってもいいでしょうか？
VW10.5では試していませんが、（たぶん）VW11と同じような傾向になると思います。

100分割以上ならこちらのほうが高速です。スクリプトも短くて簡単になりました。

procedure Slice2;
{ 図形を縦にスライスします。 }
label
＿999;
var
＿x1, y1, x2, y2＿:real;
＿x, dx, yL, yU＿:real;
＿numSlice, c＿:integer;
＿h＿:handle;

procedure CutObject(h0:handle; x:real);
const
＿MaxNum = 16;
var
＿hP＿:array[1..MaxNum] of handle;
＿h, hC＿:handle;
＿xc, yc＿:real;
＿i, n＿:integer;
begin
＿c:= c + 1;
＿Message('分割中...', c, '/', numSlice);
＿MoveTo(x, y1);
＿LineTo(x, y2);
＿hC:= LNewObj;
＿DSelectAll;
＿SetSelect(h0);
＿SetSelect(hC);
＿DoMenuTextByName('Clip Surface', 0);
＿DelObject(hC);
＿h:= FSActLayer;
＿n:= 0;
＿while (h <> nil) & (n < MaxNum)do begin
＿＿n:= n + 1;
＿＿hP[n]:= h;
＿＿h:= NextSObj(h);
＿end;
＿if MaxNum < n then begin
＿＿SysBeep;
＿＿AlrtDialog('図形が複雑すぎて，完全には分割できません。');
＿end;
＿for i:= 1 to n do begin
＿＿HCenter(hP[i], xc, yc);
＿＿if x < xc then begin
＿＿＿CutObject(hP[i], x+dx);
＿＿end;
＿end;
end;{CutObject}

begin{main}
＿h:= FSActLayer;
＿if h = nil then begin
＿＿AlrtDialog('図形を選択してください。');
＿＿Goto 999;
＿end;
＿numSlice:= IntDialog('分割数 = ', '25');
＿if DidCancel then
＿＿Goto 999;
＿GetBBox(h, x1, y1, x2, y2);
＿dx:= (x2 - x1) / numSlice;
＿x:= x1 + dx;
＿yU:= y1 + dx;
＿yL:= y2 - dx;
＿c:= 0;
＿CutObject(h, x);
＿Message('終わりました!!（', numSlice, '分割）');
999:
end;{main}
Run(Slice2);

下のような多角形（面属性なし）を作って「切り欠き」コマンドで図形をスライスしています。
┌┐┌┐┌┐
││││││
││││││
│└┘└┘│
そのため、分割数を増やすと実行時間が激増します。（「切り欠き」コマンドの仕様です。）
直線で(N-1)回切断するようにすれば、実行時間が分割数に比例するように出来ます。

procedure Slice;
{ 図形を縦にスライスします。 }
label
＿999;
const
＿MaxNum = 99;
＿LF = Chr(13);
var
＿x1, y1, x2, y2＿:real;
＿x, y, dx, lastY＿:real;
＿numSlice, i＿:integer;
＿h, h0, h1, h2, h3＿:handle;
begin
＿h1:= FSActLayer;
＿if h1 = nil then begin
＿＿＿AlrtDialog('図形を選択してください。');
＿＿＿Goto 999;
＿end;
＿h0:= PrevObj(h1);
＿h2:= NextObj(h1);
＿numSlice:= IntDialog('分割数 = ', '25');
＿if DidCancel then
＿＿Goto 999;
＿if MaxNum < numSlice then begin
＿＿if not YNDialog(Concat(Num2Str(0, numSlice), '分割って、マジっすか？', LF, '（時間が

かかります）')) then
＿＿＿Goto 999;
＿end;
＿if ((MaxNum * 3) div 2) < numSlice then begin
＿＿＿AlrtDialog(Concat('一度に分割すると時間がかかり過ぎます。', LF, '何回かに分けて、分割

してください。'));
＿＿＿Goto 999;
＿end;
＿GetBBox(h1, x1, y1, x2, y2);
＿dx:= (x2 - x1) / numSlice;
＿x:= x1 + dx;
＿y1:= y1 + dx;
＿y2:= y2 - dx;
＿y:= y1;
＿lastY:= y;
＿OpenPoly;
＿BeginPoly;
＿while x < x2 do begin
＿＿AddPoint(x, y);
＿＿if y = lastY then begin
＿＿＿if y = y1 then
＿＿＿＿y:= y2
＿＿＿else
＿＿＿＿y:= y1;
＿＿end
＿＿else begin
＿＿＿lastY:= y;
＿＿＿x:= x + dx;
＿＿end;
＿end;
＿EndPoly;
＿h3:= LNewObj;
＿SetFPat(h3, 0);
＿DSelectAll;
＿SetSelect(h1);
＿SetSelect(h3);
＿Message('分割中...');
＿DoMenuTextByName('Clip Surface', 0);
＿DelObject(h3);
＿h:= h0;
＿if h = nil then
＿＿h:= FActLayer
＿else
＿＿h:= NextObj(h0);
＿i:= 0;
＿repeat
＿＿i:= i + 1;
＿＿SetSelect(h);
＿＿h:= NextObj(h);
＿until h = h2;
＿Message('N = ', i);
999:
end;
Run(Slice);

h3 := IntersectSurface(h1, h2);とDoMenuTextByName('Intersect Surface', 0);を
使った場合、抜き取った図形が出来る位置（前後）が違いました。という訳で以下のサ
ブルーチンを...。h2がカッター図形となります。
{******* 抜き取り********}
Function Nukitori( h1 , h2 : Handle ) : Integer ;
Var
j : Integer ;
NewHand , h3 , h : Handle ;

Begin
h := NextObj( h2 ) ;
h3 := IntersectSurface( h1, h2 ) ;
ReDrawAll ;
NewHand := NextObj( h2 ) ;
While NewHand <> h Do
Begin
j := j + 1;
SetSelect( NewHand ) ;
SetLW( NewHand , 21) ;
ReDrawAll ;
NewHand := NextObj( NewHand ) ;
End ;
Nukitori := j ;
End ;

もう一個思い付きました。こちらのほうが簡単です。
抜き取り後、SetDSelectで元の図形を選択解除すれば、抜き取った図形だけが選択状
態になってるはず。

h3 := IntersectSurface(h1, h2);こちらで抜き取りを行っていたもので、思いつきま
せんでした。なるほど参考になりました。
＞（文字コードのせい？）
どうも文字コードの問題のようです、OS XではOSの操作によってUnicodeだったり、そ
うでなかったりするみたいです。半角英数なら問題ないみたいです。

抜き取った図形が一番上に出来るのではないみたいです。
カッター図形とその上の図形の間に、抜き取った図形が出来るので、
「抜き取り前にLSActLayerでハンドルh1を, NextObj(h1)でh2を取っておいて、
抜き取った後でNextObj(h1)をh1がh2になるまで続けます。」
が正解のようです。

procedure test;
var
＿i＿:integer;
＿h1, h2＿:handle;
begin
i:= 0;
h1:= LSActLayer;
h2:= NextObj(h1);
DoMenuTextByName('Intersect Surface', 0);{ 図形の抜き取り }
h1:= NextObj(h1);
while h <> h2 do begin
＿i:= i + 1;
＿SetLW(h1, 21);{ 線を太くします }
＿h1:= NextObj(h1);
end;{while}
Message('N=', i);
end;
Run(test);

＞やはり、図形の作成前と後での比較しかないでしょうか？
数を知りたいだけなら、それが一番早いと思います。

抜き取った図形のハンドルを取るには、抜き取り前にLActLayerでハンドルhを取って
おいて、抜き取った後でNextObj(h)をhがnilになるまで続けます。そのついでに数も
数えられます。

procedure test;
var
＿i＿:integer;
＿h＿:handle;
begin
i:= 0;
h:= LActLayer;
DoMenuTextByName('Intersect Surface', 0);{ 図形の抜き取り }
h:= NextObj(h);
while h <> nil do begin
＿i:= i + 1;
＿SetLW(h, 21);{ 線を太くします }
＿h:= NextObj(h);
end;{while}
Message('N=', i);
end;
Run(test);

自己レスです、やはり作成の前後で図形の数を比較するしかなそうです。
＞与太郎さん
OS Xのファイルパスでの日本語使用の問題は10.3あたりから直ったはずです。ちょっと
記憶が定かではありませんが...。

VW11のVWPluginLibraryRoutines.pの中に色々使えそうな関数があったので、ファイル
一覧を表示するスクリプトを書いてみました...が、
悲しいかなOSXでは日本語の文字化けのため、まともに動きません。VWが固まってしま
います。（文字コードのせい？）
何千個もファイルがあるフォルダを選択した場合は、終わるまでに数分かかります。
早くするにはMessage表示を間引く必要があります。

procedure Dir;
{ フォルダー内のファイル一覧を「Output.txt」書き出します。 }
const
Sep = '\';
var
i, c:integer;
dirPath:string;
t, t0:longint;
major, minor, maintenance, platform :integer;

procedure SubDir(path:string; tb:integer);
var
j:integer;
s, s0:string;
begin
tb:= tb + 1;
j:= 0;
repeat
j:= j + 1;
s0:= GetFilesInFolder(path, j);
if (s0 <> '') & (s0 <> '.') & (s0 <>'..') then begin
c:= c + 1;
s:= Concat(path, Sep, s0);
Tab(tb); WriteLn(s0);
Message(c, ': ', s);
SubDir(s, tb);
end;
until s0 = '';
end;{SubDir}

begin
t0:= GetTickCount;
GetVersion(major, minor, maintenance, platform);
if platform = 1 then begin
AlrtDialog('Macでは正常に動作しません。');
end
else begin
c:= 0;
i:= GetFolder('フォルダーを選択してください。', dirPath);
if copy(dirPath, Len(dirPath), 1) = Sep then
dirPath:= Copy(dirPath, 1, Len(dirPath)-1);
WriteLn(dirPath);
SubDir(dirPath, 0);
t:= GetTickCount;
Message('Finished!! (', (t-t0)/60, 'sec.)'); SysBeep;
end;
end;
Run(Dir);

図形の数を数えるには、Count、NumObj等色々やり方があると思いますが、スクリプト
で新しく作成した図形の数を把握するにはどうしたら良いでしょうか？カウンタを付け
てという手も考えましたが、抜き取りで図形を作成するため、何個図形が出来るのかが
分かりません。やはり、図形の作成前と後での比較しかないでしょうか？

＞与太郎さん
早速ありがとうございました。昔、与太郎さんとmasafumiさんのやりとりの中でソー
トがあったので、お勉強していましたがさっぱりわかりませんでした。ソートや再帰
は苦手です。
＞ループから呼ばれるのにAllocateしてますし...
全然問題ありません、メモリーの食う呪文は私の得意のするところです。これで、一
気に進みます。特殊業務のせいか、わたしの作るものはみなさんのお役にたてないも
のばかりです。

こんな感じで出来ます。
procedure SortXは全く最適化してません。
ループから呼ばれるのにAllocateしてますし...
でも、千個くらいなら数秒で終わります。

procedure SetNumber;
{ 選択した基準点に番号を打つ }
{$ DEBUG}
type
＿locusInfo = structure
＿＿x, y＿:real;
＿＿h＿:handle;
＿end;
var
＿loc＿:dynArray[] of locusInfo;
＿i, st, ed＿:integer;
＿num＿:longint;
＿lastY＿:real;
＿name＿:string;

procedure GetLocus(h:handle);
begin
＿i:= i + 1;
＿GetLocPt(h, loc[i].x, loc[i].y);
＿loc[i].h:= h;
end;{GetLocus}

procedure SortX(iSt, iEd:integer);
{ Xでソート }
var
＿i＿:integer;
＿temp＿:dynArray[] of locusInfo;
begin
＿Allocate temp[iSt..iEd];
＿for i:= iSt to iEd do
＿＿temp[i]:= loc[i];
＿SortArray(temp, iEd, 1);
＿for i:= iSt to iEd do
＿＿loc[i]:= temp[i];
end;{SortX}

begin{main}
＿name:= GetLName(ActLayer);
＿num:= Count((L=name)&(T=LOCUS)&(SEL=TRUE));
＿if (num < 1) | (32767 < num) then begin
＿＿AlrtDialog('32767個以下の基準点を選択してください。');
＿end
＿else begin
＿＿Allocate loc[1..num];
＿＿i:= 0;
＿＿ForEachObject(GetLocus, (L=name)&(T=LOCUS)&(SEL=TRUE));
＿＿if i <> num then begin
＿＿＿AlrtDialog('何故かiとnumが一致しません。');
＿＿end
＿＿else begin
＿＿＿SortArray(loc, num, 2);＿{ Yでソート }
＿＿＿
＿＿＿{ Xでソート }
＿＿＿st:= 1;
＿＿＿i:= 1;
＿＿＿lastY:= loc[1].y;
＿＿＿while i <= num do begin
＿＿＿＿if loc[i].y = lastY then begin
＿＿＿＿＿ed:= i;
＿＿＿＿end
＿＿＿＿else begin
＿＿＿＿＿if st < ed then
＿＿＿＿＿＿SortX(st, ed);
＿＿＿＿＿st:= i;
＿＿＿＿＿ed:= i;
＿＿＿＿＿lastY:= loc[i].y
＿＿＿＿end;
＿＿＿＿i:= i + 1;
＿＿＿end;
＿＿＿if st < ed then
＿＿＿＿SortX(st, ed);
＿＿＿
＿＿＿{ 番号を打つ }
＿＿＿for i:= 1 to num do begin
＿＿＿＿TextOrigin(loc[i].x, loc[i].y);
＿＿＿＿CreateText(Num2Str(0, i));
＿＿＿end;
＿＿end;
＿end;
end;{main}
Run(SetNumber);


SortArray(loc, num, 1); { Xでソート }
SortArray(loc, num, 2); { Yでソート }
で上手くいくかと思いましたが、やっぱりダメでした。
SortArrayすると、同じ値内で順番が前後します。

　　　　　　　　　*B　例えば左の様にバラバラに配置された座標点で点Aから点Bにか
*　**　*　　*　　*　けて番号を振っていきたいのです。条件としてはy座標の昇順、
　　*　　　　　　　　x座標の昇順という感じだと思うのですが...。
　*　　　　　*　　　イメージとしては座標を配列に入れてソートしていくのでしょう
　　*　　　*　　　*が...。
　*A

確かにですね、取りあえず配列作ってなんでも入れちゃえと思っている私の場合、配列
を整理する配列が欲しくなったりしますから...。もっとも最近は構造体の配列使って
ドツボというパターンもあります。ただ、テキストを扱うとやっぱりIntegerでは足ら
ないと思います。

＞小細工が必要
ちょうど今、小細工が必要になりそうなスクリプトを書いてるんですが、
とりあえずは普通の配列でやってみて，完成してから小細工を施そうと思ってます。今のまま
だと配列の制限で１万個強のデータしか処理できないのです。
おそらく処理時間がデータ数の1.5乗に比例して増えると思うので，配列を大きくし過ぎるのも
考え物ですが、データを分けたり結果をまとめたりの手間を考えたら，どちらが得とも言い切
れないですね。処理中はほっとけばいいので、大きくするに越したことはないですが。

＞時代は大容量
ですが、容量に処理速度が追いついて行かないのが現実ですね。（うちだけ？）
データのバックアップの時間もなかなか取れません。昔は昼休憩の間に出来たのに。

> 配列範囲が-32768〜32767までというのは少なすぎます。
はい、確かに少ないです。
NumObj( h:HANDLE ) :LONGINT ; なんかで配列を決めようとしても、小細工が必要に
なってきますからね。時代は大容量なんですから何とかして欲しいですね。

配列範囲が-32768〜32767までというのは少なすぎます。
いまどき、ちょっとした図面でも図形数が３万個を超えてしまいます。かといって，配列の下
限をマイナス値にするとスクリプトが判りにくくなってしまいます。
また、付随する変数の配列が、図形数の何倍も必要なこともあります。
そろそろ配列の範囲をINTEGER（16bit）からLONGINT（32bit）に変えてもいいというか、必要
だと思いません？

メモリ量から見ると、LONGINT型変数の配列範囲を0〜2,147,483,647にした場合でも8MBです。
現実にはそこまで大きな必要ないので、たとえば10万個のBoundBoxの座標（x1,y1,x2,y2）の
配列を作ると場合、100,000 x 4 x 8 = 3,200,000ですから、必要なメモリは3MB程度です。
10年前ならともかく、現在では全く問題にならない量でしょう。
CPU性能にしても10年前と比べれば１桁以上違います。100万回の空ループが１秒かかりません。

データを全て配列に入れなくても、必要な都度読み込めば出来ないことはないけど、配列変数
なってると、処理が簡単になったり、（場合によっては）早くなったりするんです。

どもっ、石男さん。お久しぶりです。
私は半年ぶりに重複図形削除の Script を修正していたので、こちらの関係と同様のことか
と思いこんでいました。それと UP する時に下のメッセージを見落としていました。m(_ _)m

＞masafumiさん
こちらこそ、ご容赦を...。幾何アルゴリズムかと思い、あれこれ思い悩んだ末の書き
込みだったものですから。構造体やら配列やらと大掛かりにしたらって感じでした。
試しに四角形と曲線の重なった図形もやってみたら、簡単に出来てしまいました。
なんだか、うれしいやら恥ずかしいやら...。

う〜ん、なんか間の抜けたレスになってしまった。(^_^;)
ご容赦を・・・。

こんにちは、masafumiです。

四角形と多角形が重なっているかを判断するんですよねぇ。
こんな感じでどうでしょうか。

- {先に四角形の頂点の座標と辺の角度を取得}
- {次に多角形の頂点の座標と辺の角度を取得}
- i:=1;
- endFlg:=False; {終了フラグを初期化}
- repeat
- i:=i+1; { i は四角形の頂点数}
- j:=1;
- repeat
- j:=j+1; { j は多角形の頂点数}
- if ((四角形の i の角度 = 多角形の j の角度) = ( 0 or 180 )) then
- begin
- if (四角形の i のＹ座標 = 多角形の j のＹ座標) then
- begin
- if ((四角形の i-1 のＸ座標) <= (多角形(j-1) and (j) のＸ座標) <= (四角形の i のＸ座標)）or
- ((四角形の i-1 のＸ座標) >= (多角形(j-1) and (j) のＸ座標) >= (四角形の i のＸ座標)）then
- begin
- {この状態の時、四角形の１辺と多角形の１辺は重なっている}
- endFlg:=True;
- end else endFlg:=False;
- end;
- end else if ((四角形の i の角度 = 多角形の j の角度) = ( 90 or -90 )) then
- begin
- if (四角形の i のＸ座標 = 多角形の j のＸ座標) then
- begin
- if ((四角形の i-1 のＹ座標) <= (多角形(j-1) and (j) のＹ座標) <= (四角形の i のＹ座標)）or
- ((四角形の i-1 のＹ座標) >= (多角形(j-1) and (j) のＹ座標) >= (四角形の i のＹ座標)）then
- begin
- {この状態の時も四角形の１辺と多角形の１辺は重なっている}
- endFlg:=True;
- end else endFlg:=False;
- end;
- end;
- until((endFlg=False) or (j=多角形の頂点数));
- until((endFlg=False) or (i=5));

{endFlg:=True の時、四角形と多角形は重なっていると判断できる}

※注意
上記の場合ですと四角形が多角形より小さい時には重なっていると認識しないので、先に四角形から
多角形を複製して、その図形と多角形の大きさを GetBBox で比較し、大きい図形の方を最初の repeat
に入れると上手くいくと思います。

事故レスです、難しいことを考え過ぎていました...。
重なった図形 := IntersectSurface(多角形, 四角形);で返ってきました。
無駄に2日も考えていました。

を導き出す呪文を考えているのですが、どうも考えがまとまりません。
四角形の中にある多角形の頂点、多角形の中にある四角形の頂点、これらを全て拾い
出し、それぞれの頂点を含む辺同士の交点を求めてつなぎ合わせれば良い気がする
のですが...。

「原点指示...」コマンドで「用紙の中心」を設定したのに、原点(0,0)が用紙の中心に
ならない場合があります。理由は用紙の位置が移動しているからです。しかし、用紙が
元の位置からどれだけ移動しているかは、後からでは判りません。
また、用紙の位置を初期値に戻すコマンドもありません。
それで、原点と用紙中心を数字で表示／指定したり、初期値に戻すスクリプトを書いて
みました。

procedure GetPrintCenter;
{ 用紙の中心座標を表示（VW9以降） }
var
x, y, x0, y0, xc, yc :real;
upi :real;
fraction,
display :longint;
format :integer;
name, squareName :string;
begin{main}
GetOrigin(xc, yc);
GetUnits(fraction, display, format, upi, name, squareName);
x0:= GetPrefReal(68)*GetLScale(ActLayer)*upi - xc;
y0:= -GetPrefReal(69)*GetLScale(ActLayer)*upi - yc;
Message('用紙中心= ', x0, ', ', y0);
end;{main}
Run(GetPrintCenter);


procedure SetPrintCenter;
{ 用紙の中心を設定（VW9以降） }
var
x, y, x0, y0, xc, yc :real;
upi :real;
fraction,
display :longint;
format :integer;
name, squareName :string;
begin{main}
GetOrigin(xc, yc);
GetUnits(fraction, display, format, upi, name, squareName);
x0:= GetPrefReal(68)*GetLScale(ActLayer)*upi - xc;
y0:= -GetPrefReal(69)*GetLScale(ActLayer)*upi - yc;
PtDialog('用紙の中心 = ', Num2Str(9, x0), Num2Str(9, y0), x, y);
if not DidCancel then begin
SetPrefReal(68, (x+xc)/GetLScale(ActLayer)/upi);
SetPrefReal(69, -(y+yc)/GetLScale(ActLayer)/upi);
end;{if}
end;{main}
Run(SetPrintCenter);


procedure ResetPrintCenter;
{ 用紙の中心を初期状態に戻す（VW9以降） }
begin
SetPrefReal(68, 0);
SetPrefReal(69, 0);
end;
Run(ResetPrintCenter);


procedure GetVWOrigin;
{ 原点の設定値（本来の原点を中心とした座標）を表示 }
var
x, y :real;
begin
GetOrigin(x, y);
Message('原点= ', x, ', ', y);
end;
Run(GetVWOrigin);


procedure SetVWOrigin;
{ 原点を設定（本来の原点を中心として） }
var
x, y, x0, y0 :real;
begin{main}
GetOrigin(x0, y0);
PtDialog('原点 = ', Num2Str(9, x0), Num2Str(9, y0), x, y);
if not DidCancel then begin
SetOrigin(x-x0, y-y0);
end;{if}
end;{main}
Run(SetVWOrigin);


procedure ResetVWOrigin;
{ 原点を初期状態に戻す＝「原点指示...」コマンドの「用紙の中心」と同じ }
var
x, y :real;
begin
GetOrigin(x, y);
SetOrigin(-x, -y);
end;
Run(ResetVWOrigin);

紅芋さん、はじめまして。
＞scriptを用いて座標から線を引いて図形を描くことができるようなので
＞その逆も可能かと思われるのですが、どうでしょうか。
一部を除いてほとんどの情報をスクリプトで取り出せます。
やり方は、図形の種類、図形の指定方法、情報の書き出し先によって違います。

＞古いバージョンではできるが、新しいのではできないという噂を聞いたこともあります。
そんなことはありません。基本的に、新しいバージョンほど制限は少ないです。

それから、VectorScript形式で書き出して、Excelなどで数値だけ取り出す方法もあります。
Layer(XXX);　から次の Layer(YYY); までがそのレイヤ(XXX)内の記述で、
{Object Creation Code}　から下が図形生成コマンドです。
属性指定コマンドが混じっていますが、どの行がどの図形（種類）かは判ると思います。
（コマンドの説明は、Vector Script Reference.pdf にあります）

はじめまして。
vector worksでどうしても分からないことがあり、
検索しているうちにここに行き着きました。

質問内容ですが
２次元の図形を描いた後、各点の座標を取り出したいのですが
やり方が分かりません。
scriptを用いて座標から線を引いて図形を描くことができるようなので
その逆も可能かと思われるのですが、どうでしょうか。
現在vector works 9.5を使用しています。
古いバージョンではできるが、新しいのではできないという噂を聞いたこともあります。

もし何かわかることがありましたら、どなたかよろしくお願いします。

円弧の建物はいやだ...と思いながらこんなの作ってみました...。Tool Plugin用に
なっています。

{*******************************************
半径と弦の長さ、もしくは円弧の長さを指定して
傾いた円弧を書きます

1点目と2点目で円弧の傾きを指示します。
*******************************************}

Procedure CGREnko ;

Var
struct_2DMatrix , struct_2DMatrix2 , rm : ARRAY[ 1..2 , 1..2 ] of Real ;
radius , gen , enko , angular , tawami , startangle , ag : Real ;
cp , cp1 , p1 , p2 , kcp , cv : Vector ;
genorko : Boolean ;
{-----------半径＆弦で円弧を求める-------------}
Procedure GR_Enko( G , R : Real ; Var C , Q , T : Real ) ;
Begin
C := ( PI*R*( Rad2Deg( ArcSin( G/( 2*R ) ) ) ) )/ 90 ;
Q := 2*( Rad2Deg( ArcSin( G/( 2*R ) ) ) ) ;
T := R*( 1-Cos( Deg2Rad( Rad2Deg( ArcSin( G/( 2*R ) ) ) ) ) ) ;
End ;

{-----------半径＆弧長で円弧を求める-------------}
Procedure CR_Enko( C , R : Real ; Var G , Q , T : Real ) ;
Begin
G := 2*R*Sin( Deg2Rad( ( 90*C)/( PI*R ) ) ) ;
Q := ( 180*C )/( PI*R ) ;
T := R*( 1-Cos( Deg2Rad( ( 90*C)/( PI*R ) ) ) ) ;
End ;

FUNCTION directD ( x0, y0, x1, y1 : REAL ) : REAL;
LABEL
9999;
VAR
dx, dy : REAL;
anan : REAL;
BEGIN
dx := x1 - x0;
dy := y1 - y0;
IF ( dx = 0 ) and ( dy = 0 ) THEN
BEGIN
anan := -1;
GOTO 9999;
END;
IF Abs ( dx ) > abs ( dy ) THEN
BEGIN
anan := ArcTan ( dy / dx ) * 180.0 / PI;
IF dx < 0 THEN
anan := anan + 180.0;
END
ELSE
BEGIN
anan := 90.0 - ArcTan ( dx / dy ) * 180.0 / PI;
IF dy < 0 THEN
BEGIN
anan := anan + 180.0;
END;
END;
IF anan < 0 THEN
BEGIN
anan := anan + 360.0;
END
ELSE IF anan >= 360.0 THEN
BEGIN
anan := anan - 360.0;
END;
9999:
directD := anan;
END;

{-----------Init_2DMatrix ２Ｄマトリックス初期化--------}
Procedure Init_2DMatrix( m2DMat : ARRAY[ 1..2 , 1..2 ] of Real ; Var initm2DMat : ARRAY[ 1..2 , 1..2 ] of Real ) ;
Begin
m2DMat[ 1 , 1 ] := 1 ; m2DMat[ 1 , 2 ] := 0 ;
m2DMat[ 2 , 1 ] := 0 ; m2DMat[ 2 , 2 ] := 1 ;
initm2DMat := m2DMat ;
End ;
{----------Apply2DVec2DMat 2Dマトリックスとベクトルの掛け算------}
Procedure Apply2DVec2DMat( p2D : Vector ; m2DMat : ARRAY[ 1..2 , 1..2 ] of Real ; Var p2DApp : Vector ) ;
Begin
p2DApp.x := m2DMat[ 1 , 1 ]*p2D.x + m2DMat[ 1 , 2 ]*p2D.y ;
p2DApp.y := m2DMat[ 2 , 1 ]*p2D.x + m2DMat[ 2 , 2 ]*p2D.y ;
End ;
{----------Multi2DMat 2Dマトリックスと同志の掛け算------}
Procedure Multi2DMat( m1 , m2 : ARRAY[ 1..2 , 1..2 ] of Real ; Var m3 : ARRAY[ 1..2 , 1..2 ] of Real ) ;
Begin
m3[ 1 , 1 ] := m1[ 1 , 1 ]*m2[ 1 , 1 ] + m1[ 1 , 2 ]*m2[ 2 , 1 ] ;
m3[ 2 , 1 ] := m1[ 2 , 1 ]*m2[ 1 , 1 ] + m1[ 2 , 2 ]*m2[ 2 , 1 ] ;
m3[ 1 , 2 ] := m1[ 1 , 1 ]*m2[ 1 , 2 ] + m1[ 1 , 2 ]*m2[ 2 , 2 ] ;
m3[ 2 , 2 ] := m1[ 2 , 1 ]*m2[ 1 , 2 ] + m1[ 2 , 2 ]*m2[ 2 , 2 ] ;

End ;
{---------Rot2DMat 2Dの回転マトリックス----------------------}
Procedure Rot2DMat( Ag : Real ; Var mr2DMat : ARRAY[ 1..2 , 1..2 ] of Real ) ;
Begin
mr2DMat[ 1 , 1 ] := Cos( Deg2Rad( Ag ) ) ;
mr2DMat[ 1 , 2 ] := -Sin( Deg2Rad( Ag ) ) ;
mr2DMat[ 2 , 1 ] := Sin( Deg2Rad( Ag ) ) ;
mr2DMat[ 2 , 2 ] := Cos( Deg2Rad( Ag ) ) ;
End ;


{-----------------Rot2DVec 回転角度、座標で回転後の座標を返す------------------------}
Procedure Rot2DVec( Ag : Real ; v0 : Vector ; Var v1 : Vector ) ;
Var
rotate2DM : ARRAY[ 1..2 , 1..2 ] of Real ;
Begin
Rot2DMat( Ag , rotate2DM ) ;
Apply2DVec2DMat( v0 , rotate2DM , v1 ) ;
End ;

{*******ベクトル上に長さの違うベクトルを作る*****}
Function VecOnVec( s_dp , dp : Vector ; mov : Real ) : Vector ;
Var
myNorm , vecAngle : Real ;
pp : Vector ;
Begin
myNorm := Norm( dp ) ;
vecAngle := Vec2Ang( dp ) ;
pp := Ang2Vec( vecAngle , mov ) ;
VecOnVec := pp + s_dp ;
End ;

{=================Main===================}
Begin
radius := PRADIUS{80} ;
genorko := PGENORKO ;{--true=弦指定 false=円弧指定---}
enko := PENKO{50} ;
gen := PGEN{50} ;
GetPt( cp1.x , cp1.y ) ;{-----------空クリック----------}

GetPt( cp1.x , cp1.y ) ;
GetPtL( cp1.x , cp1.y , kcp.x , kcp.y ) ;
cv := kcp-cp1 ;

cp := VecOnVec( cp1 , cv , radius ) ;
cv := cp1-cp ;
If genorko = true Then
Begin
enko := 0 ;
GR_Enko( gen , radius , enko , angular , tawami ) ;
End Else
If genorko = false Then
Begin
gen := 0 ;
CR_Enko( enko , radius , gen , angular , tawami ) ;
End ;
Init_2DMatrix( struct_2DMatrix , struct_2DMatrix ) ;{-----------2Dマトリックス初期化--------}
Rot2DVec( -angular/2 , cv , p1 ) ;{---------回転角度、座標で回転後の座標を返す--------------}
Init_2DMatrix( struct_2DMatrix , struct_2DMatrix ) ;{-----------2Dマトリックス初期化--------}
Rot2DVec( angular/2 , cv , p2 ) ;{---------回転角度、座標で回転後の座標を返す--------------}
p1 := p1 + cp ;
p2 := p2 + cp ;
startangle := directD ( cp.x , cp.y , p1.x , p1.y ) ;
ArcByCenter( cp.x , cp.y , radius , startangle , angular ) ;
MoveTo( cp.x , cp.y ) ;{--------------弦-------------}
LineTo( cp1.x , cp1.y ) ;
MoveTo( p1.x , p1.y ) ;{--------------半径-------------}
LineTo( p2.x , p2.y ) ;


End ;
Run( CGREnko ) ;

directDはA+AのOpenTipsです、これを利用して商売してはいけません。

（先週からのつづき）
ポリゴンが四角形では不都合なので、三角形に分割する必要もあります。
四角形の分割は、下のように色々なパターンが考えられますが、

・─・─・─・　・─・─・─・　・─・─・─・　・─・─・─・　・─・─・─・
│／│／│／│　│＼│＼│＼│　│／│／│／│　│／│＼│／│　│／│＼│／│
・─・─・─・　・─・─・─・　・─・─・─・　・─・─・─・　・─・─・─・
│／│／│／│　│＼│＼│＼│　│＼│＼│＼│　│／│＼│／│　│＼│／│＼│
・─・─・─・　・─・─・─・　・─・─・─・　・─・─・─・　・─・─・─・
│／│／│／│　│＼│＼│＼│　│／│／│／│　│／│＼│／│　│／│＼│／│
・─・─・─・　・─・─・─・　・─・─・─・　・─・─・─・　・─・─・─・

面倒なので、真ん中に点を作って４分割することにしました。

・─・─・─・
│×│×│×│×
・─・─・─・─・
│×│×│×│×│×
・─・─・─・─・─・
│×│×│×│×│×
・─・─・─・─・

中心の高さは周りの４点の高さの平均です。中心の座標も簡略化のため、対角線の交点では
なく、４点の平均にしました。周りに３点しかない場合は、対角線の中心の座標と高さにし
ます。本当は３点のときは分割する必要はありませんが、スクリプトを単純にするために分
割します。

５
１─────２
│＼　・　／│
│　＼　／　│
│・　０　・│
│　／　＼　│
│／　・　＼│
４─────３

具体的には１〜４の配列要素のハンドルをカウントして、３個以上あれば処理し、それ以下
なら無視します。
3D基準点から3D多角形を生成するスクリプトは下のような感じになります。
（記憶頼りで書いてるので，細かいところは違うかも）

var
＿h＿:array[1..5] of handle;{ コード単純化のため、１のデータを５にも入れる }
＿x, y, z＿:array[0..5] of real;
・
・
・
GetOrigin(xc, yc);
for iX:= 0 to MaxArrayX-1 do begin
＿for iY:= 0 to MaxArrayY-1 do begin
＿＿h[1]:= hP[iX, iY];
＿＿h[2]:= hP[iX+1, iY];
＿＿h[3]:= hP[iX+1, iY+1];
＿＿h[4]:= hP[iX, iY+1];
＿＿h[5]:= h[1];
＿＿n:= 0;
＿＿for i:= 1 to 4 do
＿＿＿if h[i] <> nil then
＿＿＿＿n:= n + 1;
＿＿if 3 <= n then begin
＿＿＿for i:= 1 to 5 do
＿＿＿＿if h[i] <> nil then begin
＿＿＿＿＿GetLocus3D(h[i], x[i], y[i], z[i]);
＿＿＿＿＿x[i]:= x[i] - xc;
＿＿＿＿＿y[i]:= y[i] - yc;
＿＿＿＿end;{if}
＿＿＿end;{for}
＿＿＿
＿＿＿{ 中心座標を計算 }
＿＿＿if (h[1] <> nil) & (h[3] <> nil) then begin
＿＿＿＿x[0]:= (x[1] + x[3])/2;
＿＿＿＿y[0]:= (y[1] + y[3])/2;
＿＿＿＿z[0]:= (z[1] + z[3])/2;
＿＿＿＿if (h[2] <> nil) & (h[4] <> nil) then begin
＿＿＿＿＿x[0]:= (2 * x[0] + x[2] + x[4])/4;
＿＿＿＿＿y[0]:= (2 * y[0] + y[2] + y[4])/4;
＿＿＿＿＿z[0]:= (2 * z[0] + z[2] + z[4])/4;
＿＿＿＿end;{if}
＿＿＿end{if}
＿＿＿else if (h[2] <> nil) & (h[4] <> nil) then begin
＿＿＿＿x[0]:= (x[2] + x[4])/2;
＿＿＿＿y[0]:= (y[2] + y[4])/2;
＿＿＿＿z[0]:= (z[2] + z[4])/2;
＿＿＿end;{else}
＿＿＿
＿＿＿{ 3D多角形を生成 }
＿＿＿for i:= 1 to 4 do begin
＿＿＿＿if (h[i] <> nil) & (h[i+1] <> nil) then begin
＿＿＿＿＿BeginPoly3D;
＿＿＿＿＿＿Add3DPt(x[0], y[0], z[0]);
＿＿＿＿＿＿Add3DPt(x[i], y[i], z[i]);
＿＿＿＿＿＿Add3DPt(x[i+1], y[i+1], z[i+1]);
＿＿＿＿＿EndPoly3D;
＿＿＿＿end;{if}
＿＿＿end;{for}
＿＿end;{if}
＿end;{for}
end;{for}

最初のデータ（文字と円）からの変換でも、実行時間は１分以内でした。
このデータから切断面を作るのは手作業になりますが、他の方法で断面を切るよりは簡単で
しょう。法線の他に適当な角度を持たせた補助線も3D化しておけば、断面の作り忘れや重複
の発見も容易です。

今回は基準点がほぼ整列していたので、単純なスクリプトで済みましたが、基準点がランダムに
並んでいた場合は、全然別のアプローチが必要でしょう。
（おわり）

まだ試してはいませんが、大丈夫でしょうから先にお礼を述べさせていただきます。

与太郎さん。早速の回答ありがとうございます。

私もがんばって、与太郎さんのように上達したいと思います。
（VSで四角形だけ書くことができる程度の腕前ですので・・・）

機会がありましたら、また助けてください。
ありがとうございました。

tuckyさん、はじめまして。
図形を数える方法は何種類かあります。

まずは図形選択コマンドを改造する方法です。
Altキーを押しながらコマンドをダブルクリックするとスクリプト編集画面になるので、
SelectObj(( を Message(Count( に変えます。

SelectObj((T=LINE));　→　Message(Count(T=LINE));

文章も付け加えたいときは下のようにします。

Message('ファイル内の直線は ' , Count(T=LINE), ' 個です。');


Count関数でアクティブレイヤを指定するには、変数を使わないといけません。

procedure count2;
var
＿name＿:string;
＿c＿:longint;
begin
＿name:= GetLName(ActLayer);
＿c:= Count((L=name) & (SEL=TRUE));
＿Message('アクティブレイヤの選択図形は ' , c, ' 個です。');
end;
Run(count2);


Count関数を使うと、グループ内の図形も数えてしまいます。
グループ内の図形を数えたくなければ、下のようにします。

procedure count3;
const
＿LineObj = 2;
var
＿h＿:handle;
＿c＿:longint;
begin
＿c:= 0;
＿h:= ActLayer;
＿while h <> nil do begin
＿＿if GetType(h) = LineObj then begin
＿＿＿c:= c + 1;
＿＿end;{if}
＿＿h:= NextObj(h);
＿end;{while}
＿Message('アクティブレイヤの直線は ' , c, ' 個です。');
end;
Run(count3);


procedure count4;
const
＿LineObj = 2;
var
＿h, hL＿:handle;
＿c＿:longint;
begin
＿c:= 0;
＿hL:= FLayer;
＿while hL <> nil do begin
＿＿h:= ActLayer;
＿＿while h <> nil do begin
＿＿＿if GetType(h) = LineObj then begin
＿＿＿＿c:= c + 1;
＿＿＿end;{if}
＿＿＿h:= NextObj(h);
＿＿end;{while}
＿＿hL:= NextLayer(hL);
＿end;{while}
＿Message('ファイル内のの直線は ' , c, ' 個です。');
end;
Run(count4);

だいたい上のような感じです。
それから、スクリプトの"＿"（全角下線）は、タブか空白に置き換えないと実行できません。

winXP VW8（古くてすみません）
VW(miniCAD)暦、７年。VS初心者です。

図形をカウントし、画面にメッセージボックスとして表示させる（" "個あります。みたいな・・・）scriptを何度か挑戦してみましたが、全くできそうにありません。

どなたか、助けていただけませんでしょうか。

（先週からのつづき）
翌日の日曜日はお休みして、月曜日にリロードしました。
方針を変更して、自分でポリゴン（3D多角形）を作るしかないようです。どうやって隣同士
の点を結んでばポリゴンを作ればいいのでしょうか？

１─２─３─４
│　│　│　│
５─６─７─８
│　│　│　│
９─10─11─12
│　│　│　│
13─14─15─16

たとえば点(1)を基準にして(1)-(2)-(6)-(5)の四角形を作る場合、点(2),(6),(5)を見つける
必要があります。要するに、隣の点を探すのですが、
1. GetPtでマウスクリックして、PickObjectで点を取る。
2. 全ての点の座標を調べて、目的の点を探す。
3. 基準となる点からPickObjectで点を取る。
4. あらかじめ点のハンドルを２次元配列に入れておく。
などの方法を考えましたが、
1.はコードは簡単そうですが、点の数が多いと実用的とはいえません。
2.は実行時間がかかりそうです。
3.は確実に点が取れるか自信が持てません。また実行時間も早いとはいえません。
というわけで、4.の方法が適しているようです。これなら隣り合った点を見つけるのは簡単
です。ある点(1)のハンドルがh[x,y]だとすると、点(2),(6),(5)のハンドルは、h[x+1,y]、
h[x+1,y+1]、h[x,y+1]で求まり、事実上時間はかからないでしょう。

Y＼X（０)(１)(２)(３）
（０）１─２─３─４
・・・│　│　│　│
（１）５─６─７─８
・・・│　│　│　│
（２）９─10─11─12
・・・│　│　│　│
（３）13─14─15─16

配列に3D基準点のハンドルを入れるのは、幸い点がほぼ等間隔に並んでいるので簡単です。
XとYの最小値と最大値、XとYの配列の大きさを、インターフェースを省略するために定数に
しておきます（自分が使うだけですし）。点が配列のどこに入るかは、簡単に計算できます。

dX:= (MaxX-MinX)/MaxArrayX;
dY:= (MaxY-MinY)/MaxArrayY;
・
・
{ 3D基準点を配列に格納 }
h:= FActLayer;
while h <> nil do begin
＿GetLocus3D(h, x, y, z);
＿iX:= Round((x-MinX)/dX);
＿iY:= Round((y-MinY)/dY);
＿hP[iX, iY]:= h;
＿h:= NextObj(h);
end;

同様にして、最初のデータから3D基準点を作ってみました。

{ 円と文字のハンドル＆中心座標を配列に格納 }
h:= FActLayer;
while h <> nil do begin
＿HCenter(h, xc, yc);
＿iX:= Round((xc-MinX)/dX);
＿iY:= Round((yc-MinY)/dY);
＿Case GetType(h) of
＿＿PolylineObj: begin
＿＿＿hP[iX, iY]:= h;
＿＿＿x[iX, iY]:= xc;
＿＿＿y[iX, iY]:= yc;
＿＿end;
＿＿TextObj: begin
＿＿＿Case GetTextSize() of
＿＿＿＿6: hTR[iX, iY]:= h;
＿＿＿＿8: hTL[iX, iY]:= h;
＿＿＿end;
＿＿end;
＿end;
＿h:= NextObj(h);
end;
{ 3D基準点を生成して配列に格納 }
for iX:= 0 to MaxArrayX do begin
＿for iY:= 0 to MaxArrayY do begin
＿＿if (hP[iX,iY] <> nil) & (hTL[iX,iY] <> nil) & (hTR[iX,iY] <> nil) then begin
＿＿＿s:= Concat(GetText(hTL[iX, iY]), '.', GetText(hTR[iX, iY]));
＿＿＿Locus3D(x[iX, iY], y[iX, iY], Str2Num(s));
＿＿＿DelObject(hP[iX, iY]); DelObject(hTL[iX, iY]); DelObject(hTR[iX, iY]);
＿＿end;
＿end;
end;

今回は十数秒で出来てしまいました。そして最初のスクリプトとは違って、3D基準点は左上
から順番に生成されます。結果的にはビン・ソートを実行したのと同じことになりました。
ビン・ソートは、一定の条件内では最も速いソートです。この問題は図らずもビン・ソート
に適していたようです。なんで最初に思い付かなかったかなぁ。

仕事の合間にチョコチョコやって、ここまで進みました。配列にハンドルを入れてしまえば
あとは簡単（な筈）です。残りは帰ってからにしましょう。
（つづく）

ランドマークだけではなくアーキテクトも当然持ってませんので、その実力を窺い知る
ことは叶いませんが...
人間が目で見れば、どの点とどの点を結んで三角形にすればいいかは一目瞭然なのに、
それをプログラムで勝手にやらせるのは物凄く大変なんですよね。OCRやラス→べク変
換にもいえることですが、人間のパターン認識能力って本当に凄いですね。
不完全にしろ、それをプログラムで書いちゃう人がいるっていうのも凄いですけど。

＞与太郎さん
これは実は禁断の果実？だったりします。以前に確かVW8あたりに地形を作成するもの
があったと思いますが、頂点が多いと確実に死にます。マニュアル程度に書かれている
くらいのものは出来ましたが...。
同じ様なものを自作した記憶がありますが、配列の壁にぶち当たり不完全でした。
それと頂点が多いからといって分割してみると思いのほか面倒です。
という訳で途中で挫折しました...。
ちなみにランドマークだけではなくアーキテクトでも地形生成ができたはずです。
ただどこまで出来るのかは定かではありません！

シンボルの反転は、SDKではGetEntityMatrixで調べるようですが、Matrixなんて判らないし、
そもそもSDKをやらないので意味がないし。
ところでMatrixといえば...

（以下独り言です）
■メッシュ状の平面データから断面の地盤線を作れないかと訊かれたんで、断面がメッシュに
重なってれば簡単に出来ますと答えたけど、詳しく聞くとメッシュと断面は重なってなくて、
角度が直角（平行）でない箇所もあるらしい。しかもデータを見たら3Dデータではなく、数値
で高さを表してる平面図で、小数点以上の数字、小数点、小数点以下の数字に分解されていま
した。（「10」「.」「6」のような具合。小数点は文字でなく円。下のようなかんじで1万個
以上並んでいます。しかも各々の間隔が微妙に違います。データが重くてAutoCADの画面がな
かなか表示されません。よくみたら文字がTrueTypeフォントでした。）

12.5 12.8 13.1 13.6

12.7 13.0 13.4 13.8

12.9 13.3 13.7 14.0

13.2 13.6 13.9 14.2

このデータを見て、正直、あんまりやりたくないなぁと思いました。
■別にコンターのデータもあるらしいので、そっちのデータを使ったほうが早いです、手作業
ですけどって言ったら、ちょっと考えてみますという返事。たぶん社内でやってしまうんだな
と思いましたが、週末なのでとっとと帰りました。
■でも休日に考えました。VWでコンターから断面を作る方法は判るけど、AutoCADやJW-CAD
ではどうやるんだろうかと。しかしAutoCADやJW-CADは詳しく知らないので、良い方法は思い
付きませんでした。いずれにしても、何十箇所も手作業でやるのは大変だと思い、実際に作業
する人がちょっと気の毒になりました。
■しかし、もしかしたら自分がやる羽目になる可能性もあります。気の毒な人になりたくない
ので、簡単に出来る方法はないか考えることにしました。
■結局、3D地盤を作って切断面を作るのが単純でミスも少ないだろうということに落ち着いた
のですが、問題は3D地盤をどう作るかです。ランドマークなど持っていないのでスクリプトで
やるつもりでしたが、方針は決まりません。とりあえず3D基準点に変換することにしました。
データが順番に並んでいるとは期待できないので、ハンドルを順番に3個ずつ取って...という
のは問題外です。X,Y座標は円の中心でいいのですが、Y座標を求めるには、円の左右の文字を
調べる必要があります。そのためには、円の左右の文字を見つけないといけません。
■円と文字の距離は決まってるようなので、円の中心から一定の範囲内にある文字を見つけれ
ばいいのですが、片っ端から調べていくと何十分（何時間か？）も掛かってしまいます。一度
しか実行しないのでそれでも構わないとはいえません。デバッグのことを考えれば必ず何回か
実行することになります。かといって、データのハンドルを座標でソートするのも気が進みま
せんでした。使い捨てのスクリプトなのでソート・コードを調べるたりするのが面倒だし、並
びが微妙に水平・垂直でないので、ソートするにも一工夫必要な気がしたので。それで、円の
中心から一定の距離で、PickObjectで文字のハンドルを取ることにしました。この方法だとス
クリプトがとても簡単になります。思ったとおり10分くらいで書きあがりました。

h:= LActLayer;
while h <> nil do begin
＿if GetType = PolyLineObj then begin
＿＿HCenter(h, x, y);
＿＿hL:= PickObject(x-3.0, y+1.0);
＿＿hR:= PickObject(x+2.0, y);
＿＿if (hL<>nil) & (hR<>nil) & (GetType(hL)=TextObj) & (GetType(hR)=TextObj) then begin
＿＿＿s:= Concat(GetText(hL), '.', GetText(hR));
＿＿＿Locus3D(x, y, Str2Num(s));
＿＿＿DelObject(h);
＿＿＿DelObject(hL);
＿＿＿DelObject(hR);
＿＿end;
＿end;
＿h:= PrevObject(h);
end;

■ですが、実行してみて判ったのは、PickObjectを１万回も実行すると結構時間がかかるとい
うことでした。G4/500で20分くらいかかりましたが、１回目は単位を間違えていたため何も変
換されませんでした。２回目は距離の設定が悪かったのか、完全には変換されませんでした。
何度か距離を調節しながら実行して、なんとか全部3D基準点に返還できました。
■変換したデータで、試しにVW8.5で3D化に挑戦してみましたが、計算が終わる前にVWが落ちま
した。データを半分にしても、1/4にしても、まだ落ちました。これ以上分割しても面倒になる
だけだと思い、
とりあえずあきらめて寝ました（爆）。
（来週につづく）

＞シンボルの反転を区別する方法
シンボルを分解して、シンボル定義の中身と比べてみれば、判断できる場合もあるでしょうね。
（中のデータによります。いえ、もちろんそこまでやる気はないですよ。）

>シンボルの反転までは再現できませんでした。（あぁ悲しい。）
ミラー反転、ミラー反転複写は手動のみですよ、きっと。確かデータ表示が元図形と
一緒で区別が出来ないはずです。この件で答えにならない返事を貰った記憶があります

図形をシンボルに置き換えるスクリプトです。
置き換えるシンボルは、実行前にリソースプラウザ(パレット)で指定しておきます。

データパレットの「置き換え...」のように、シンボルの置き換えも出来ます。
データパレットで置き換えると、レコード情報が消えてしまって悲しい思いをしますが、
下のスクリプトだとレコード情報は保持されます。
でも、シンボルの反転までは再現できませんでした。（あぁ悲しい。）

procedure Obj_To_Sym;
{ クリックした図形をデフォルトのシンボルと置き換える。 }
{ 置き換えの基準点は図形の中心。ただしシンボルの場合はシンボル基点を合わせる。 }
const
＿SymObj = 15;
var
＿hS, h＿:handle;
＿symName＿:string;
＿x, y＿:real;

procedure Obj2Sym(h, hS:handle);
{ 図形(h)をシンボル(hS)に置き換えます。 }
var
＿name＿:string;
＿lName, cName＿:string;
＿x, y, xc, yc, rot＿:real;
＿x1, y1, x2, y2＿:real;
＿
＿procedure CopyRec(h1, h2:handle);
＿var
＿＿hRec＿:handle;
＿＿nRec, nFld＿:integer;
＿＿recName, fldName, value＿:string;
＿＿i, j＿:integer;
＿begin
＿＿nRec:= NumRecords(h1);
＿＿for i:= 1 to nRec do begin
＿＿＿hRec:= GetRecord(h1, i);
＿＿＿recName:= GetName(hRec);
＿＿＿SetRecord(h2, recName);
＿＿＿nFld:= NumFields(hRec);
＿＿＿for j:= 1 to nFld do begin
＿＿＿＿fldName:= GetFldName(hRec, j);
＿＿＿＿value:= GetRField(h1, recName, fldName);
＿＿＿＿SetRField(h2, recName, fldName, value);
＿＿＿end;{for}
＿＿end;{for}
＿end;{CopyRec}
＿
begin
＿name:= GetName(h);
＿lName:= GetLName(GetLayer(h));
＿cName:= GetClass(h);
＿if GetType(h) = SymObj then begin
＿＿GetSymLoc(h, xc, yc);
＿＿rot:= GetSymRot(h);
＿end{if}
＿else begin
＿＿GetBBox(h, x1, y1, x2, y2);
＿＿xc:= (x1 + x2) / 2; yc:= (y1 + y2) / 2;
＿＿Rot:= 0;
＿end;{else}
＿Layer(lName);
＿NameClass(cName);
＿Symbol(symName, xc, yc, rot);
＿hS:= LNewObj;
＿SetDSelect(hS);
＿if GetType(h) <> SymObj then begin
＿＿GetBBox(hS, x1, y1, x2, y2);
＿＿x:= (x1 + x2) / 2; y:= (y1 + y2) / 2;
＿＿HMove(hS, xc-x, yc-y);
＿end;{if}
＿CopyRec(h, hS);
＿DelObject(h);
＿SetName(hS, name);
end;{Obj2Sym}

begin{main}
＿PushAttrs;
＿hS:= ActSymDef;
＿if (hS = nil) then begin
＿＿AlrtDialog('リソースパレット（プラウザ）でシンボルを指定してから実行して下さい。');
＿end{if}
＿else begin
＿＿symName:= GetName(hS);
＿＿Message('シンボルに置き換える図形をクリックしてください。');
＿＿GetPt(x, y);
＿＿h:= PickObject(x, y);
＿＿while h <> nil do begin
＿＿＿Obj2Sym(h, hS);
＿＿＿ReDraw;
＿＿＿GetPt(x, y);
＿＿＿h:= PickObject(x, y);
＿＿end;{while}
＿end;{else}
＿ClrMessage;
＿PopAttrs;
end;
Run(Obj_To_Sym);


procedure SelObj_To_Sym;
{ 選択された図形をデフォルトのシンボルと置き換える。 }
{ 置き換えの基準点は図形の中心。ただしシンボルの場合はシンボル基点を合わせる。 }
const
＿SymObj = 15;
var
＿hS, h, hN＿:handle;
＿symName＿:string;
＿lName＿:string;

{ 上のスクリプトの procedure Obj2Sym 〜 end;{Obj2Sym} をここにコピーします。}

begin{main}
＿PushAttrs;
＿lName:= GetLName(ActLayer);
＿if Count((L=lName)&(SEL=TRUE)) = 0 then begin
＿＿AlrtDialog('アクティブレイヤの図形を選択してから実行して下さい。');
＿end{if}
＿else begin
＿＿hS:= ActSymDef;
＿＿symName:= GetName(hS);
＿＿if (hS = nil) then begin
＿＿＿AlrtDialog('シンボルが指定されていません。');
＿＿end{if}
＿＿else begin
＿＿＿h:= FSActLayer;
＿＿＿while h <> nil do begin
＿＿＿＿hN:= NextSObj(h);
＿＿＿＿Obj2Sym(h, hS);
＿＿＿＿h:= hN;
＿＿＿end;{while}
＿＿＿ReDrawAll;
＿＿end;{else}
＿end;{else}
＿PopAttrs;
end;
Run(SelObj_To_Sym);

上書きでも支障ありませんが、
元のフォルダを退避しとくほうが望ましいかと。

＞ なんだか凄く高度なことをされてるような気が...
以前から3D版のものさしツールを自作しています。CallToolで3D基準点を2つ打たせて
そのx,y,zの差を求めるだけのものなのですが、10.5あたりからTool PlugIn内で
やるとバグが発生しまして...。そのため、CallTool(3D基準点)に代わる3次元入力方法
を考えると、3Dシンボルを配置するしかないのです。かなり、面倒になりましたが
このツールがないと仕事に支障？をきたすものですから（笑い）

ありがとうございます
「VectorScript Reference」を上書きしてしまったのですが､問題あるのでしょうか？

上書きしなくてもVSFunctionReference.htmlを直接開けばいいのでは？
私はDockやタスクバーに登録しています。

なんだか凄く高度なことをされてるような気が...

A&Aのホームページから以下のﾌｧｲﾙを上書きしたのですが日本語化になりません｡
対策をどなたか教えて下さい

「VectorWorks11J」アプリケーションフォルダ内の「VWHelp」にある「VectorScript Reference」を和訳したHTML形式のファイルです。ファイルを上書きするとヘルプを選択した際に、日本語のマニュアルでご覧頂けます。

ファイル名 Vers. 作成日
VectorScript Reference 改訂第1版 04.07.30 ダウンロード
（vsref.zip/468KB）

＞たびたびすみません、与太郎さん
リロードせず書き込みしたら、与太郎さんの方が先でした...。
バグ回避のため苦肉の策で3Dシンボル生成しなきゃならないため、痕跡を残さないため
その3Dシンボルを削除といった仕掛けなのでタイプの調査はなしで大丈夫です。
3D用GetPtを作って欲しい...、そうすれば苦肉の策をせずに済むのに。

＞石男さん
どういたしまして。

＞procedure DelSymDef
ハンドルがNILかどうかと、ハンドルのタイプを調べるのを忘れてます。

＞与太郎さん
ありがとうございました。
GetObject( 'シンボル定義の名前' )でハンドルを取ってDelObjectにそのハンドルを渡
したら、無事登録シンボルが削除出来ました。DelObjectの説明には登録シンボルがな
かったので試していませんでした...。ちなみにDelNameは必要ないみたいです。
やりたいことはちょっとなのにバグ回避のため仕掛けが大きくなってしまいました。

登録シンボルを削除するスクリプトは、下のようになります。
シンボル名はVWが削除してくれるので、ユーザーが削除する必要はありません。
使用中の登録シンボルを削除すると、シンボルが3D基準点に置き換わります。
（リソースパレット／プラウザから削除したときと同じでした。）

procedure test;

procedure DelSymDef(name:string);
{ 登録シンボルを削除する。使用中なら削除しない。 }
var
＿h＿:handle;
begin
＿if (Count(S=name) = 0) then begin
＿＿h:= GetObject(name);
＿＿DelObject(h);
＿＿AlrtDialog(Concat('「', name, '」を削除しました。'));
＿end{if}
＿else begin
＿＿AlrtDialog(Concat('「', name, '」は使用しているので削除しません。'));
＿end;{else}
end;{DelSymDef}

begin{test}
＿DelSymDef('Symbol1');
end;
Run(test);

GetObject('シンボル定義の名前')でハンドルを取って消せませんか？
確認はしてませんけど。
削除したら、DelNameで名前を消す必要もあるかも。
使用中のシンボル定義を削除したらまずいでしょうね。
（どうなるか興味はありますが）

アクティブドキュメントに登録されているシンボルをVSを使って削除する方法ってあり
ますか？登録や変更は可能なのですが、削除が出来ません。

procedure test;
{ Command(Ctrl)+「.」か「Esc」で終了します。 }
var
x,y:real;
i:integer;
begin
i:= -32768;
SetCursor(i);
Message('i=', i);
while (i < 32767) do begin
i:= i + 1;
SetCursor(i);
Message(i);
end;{while}
end;
Run(test);

上のスクリプトを走らせると、i=1307〜1312でカーソルが（一瞬ですが）変わります。
（確認するなら、i=1000あたりから始めたほうがいいです）
単純なリソース参照なら、他にもカーソルが変わる箇所があるはずですが、そうではないので、SetCursorは1307〜1312以外の引数をは受け付けない仕様だと思われます。
それから、SetCursorの内部で1307〜1312を本当のリソースIDに変換している可能性はありますね。
何故、引数が0〜5とか1〜6でないのかは判りませんが、初期のバージョンではリソースIDだった
のかも知れません。

やはりVectorScriptでは無理のようです。

＞これもSDKの領分ですね。
SDKでPlugInを作る時絶対にリソースが必要になるので、こちらのが手軽？ですね。
それにしてもVW本体のカーソルIDとHandC等のIDらしきものが違う番号なのだろうか。
どこかにあるのかな...。

だめですか...
これもSDKの領分ですね。

SetCursorの引数に自作のカーソルIDを渡してみたところ、やはり駄目でした。
SetCursorの引数自体はリソースIDのようですが、決まったところにあるリソースを参
照している感じです。でもそのリソースが見つかりませんでした...。VW本体をResEdit
で開いたところカーソルリソースは存在するのですが、IDが違いました。
他のリソースらしきものを調べてみましたが、カーソルリソース自体がありませんでし
た。以上、念のため...。

AutoCAD風に基点コピー＆ペースト＆移動をするスクリプトです。

procedure BCopy;
{ 基点コピー }
const
tempFile = 'BCopy.temp';
var
x, y:real;
begin
Message('コピーの基点をクリックしてください。');
GetPt(x, y);
ReWrite(tempFile);
Writeln(x);
Writeln(y);
Close(tempFile);
DoMenuTextByName('Copy', 0);
ClrMessage;
end;
Run(BCopy);


procedure BPaste;
{ 基点ペースト }
const
tempFile = 'BCopy.temp';
var
x, y, xc, yc:real;
begin
UseDefaultFileErrorHandling(false);
Open(tempFile);
if GetLastFileErr <> 0 then begin
AlrtDialog('コピー基点が一度も設定されていません。');
end
else begin
Message('ペーストの基点をクリックしてください。');
GetPt(x, y);
Readln(xc);
Readln(yc);
Close(tempFile);
DoMenuTextByName('Paste In Place', 0);
MoveObjs(x-xc, y-yc, false, false);
ClrMessage;
end;
end;
Run(BPaste);


procedure BMove;
{ 基点移動 }
var
x1, y1, x2, y2:real;
begin
Message('移動の始点をクリックしてください。');
GetPt(x1, y1);
Message('終点をクリックしてください。');
GetPt(x2, y2);
MoveObjs(x2-x1, y2-y1, false, false);
ClrMessage;
end;
Run(BMove);

選択図形がないのにコピーしたり、クリップボードが空なのにペーストすると、エラーメッセージ
が出ますが、選択図形の有無はともかく、クリップボードの状態はスクリプトでは調べられません。

スクリプトを書いてみましたが、やはりパンカーソル＆ショートカットキーのほうが早いです。
それに、画面上の図形が少ないときはスムーズに動きますが、図形が多いときはパンが遅くて、
図形が少ない部分で急に早くなるので使いにくい。（マシンが遅いのもあるでしょうが）

ところで、SetCursorで自分が作ったカーソルを使えるのでしょうか？
パンの方向によってカーソルが変わったほうが面白いので。
Winなので調べようがなかったのですが、SetCursorの引数はカーソルリソースIDのような気が
します。（Messageで表示すると、1307とか1308でした。）
一応リソースつながりということで。

procedure AutoPanZoom;
{ オートパン＆ズーム }
{ クリックで200%ズーム、Option(Alt)キーを押しながらだと50%縮小。 }
{ Escで終了する。 }
{ VW9(デモ版)だとKeyDownで文字が返って来ない。 }
const
＿Esc = 27;
＿LF = Chr(13);
var
＿fraction,display＿:longint;
＿format＿:integer;
＿upi＿:real;
＿name, squareName＿:string;
＿scale＿:real;
＿zm, diagonal＿:real;
＿x1, y1, x2, y2, wd, ht＿:integer;
＿x, y, xc, yc, dx, dy, d＿:real;
＿ch＿:＿integer;
＿k＿:real;
＿dmy＿:boolean;

procedure Pan;
begin
＿zm:= GetZoom;
＿GetMouse(x, y);
＿GetVCenter(xc, yc);
＿k:= 2 * (Distance(x, y, xc, yc)/(100*diagonal/zm))^1.5;
＿dx:= x - xc; dy:= y - yc;
＿d:= Abs(dx);
＿if d < Abs(dy) then
＿＿d:= Abs(dy);
＿d:= d * k;
＿if (diagonal/Sqrt(wd*wd+ht*ht)) < d then begin
＿＿SetVCenter(xc-dx*k, yc-dy*k);
＿＿SetCursor(HandC);
＿＿ReDrawAll;
＿end{if}
＿else begin
＿＿SetCursor(LgCrossC);
＿end;{else}
end;{Pan}

procedure Zoom(k:real);
begin
＿zm:= GetZoom;
＿GetVCenter(xc, yc);
＿if k = 0 then begin
＿＿if Option then
＿＿＿k := 0.5
＿＿else
＿＿＿k:= 2;
＿end;{if}
＿zm:= zm * k;
＿dx:= x - xc; dy:= y - yc;
＿x:= x - dx/k; y:= y - dy/k;
＿SetVCenter(x, y);
＿SetZoom(zm);
＿ReDrawAll;
end;{Zoom}

begin{main}
＿Message('1,C:拡大／2,V:縮小／3:原寸／4:用紙全体／5:図形全体／Esc:終了');
＿GetScreen(x1, y1, x2, y2);
＿wd:= x2 - x1; ht:= y2 - y1;
＿GetUnits(fraction,display, format, upi, name, squareName);
＿scale:= GetLScale(ActLayer);
＿diagonal:= Sqrt(wd*wd+ht*ht)/72*upi*scale;
＿AlrtDialog(Concat('オートパン＆ズーム', LF, 'Escで終了します。'));
＿dmy:= KeyDown(ch);
＿while ch <> Esc do begin
＿＿case ch of
＿＿＿Ord('1'), Ord('c'), Ord('C'): Zoom(2);
＿＿＿Ord('2'), Ord('v'), Ord('V'): Zoom(0.5);
＿＿＿Ord('3'): begin DoMenuTextByName('Normal Scale', 0); ReDrawAll; end;
＿＿＿Ord('4'): begin DoMenuTextByName('Fit to Window', 0); ReDrawAll; end;
＿＿＿Ord('5'): begin DoMenuTextByName('Fit To Objects', 0); ReDrawAll; end;
＿＿＿otherwise begin
＿＿＿＿if MouseDown(x, y) then
＿＿＿＿＿Zoom(0)
＿＿＿＿else
＿＿＿＿＿Pan;
＿＿＿end;{otherwise}
＿＿end;{case}
＿＿dmy:= KeyDown(ch);
＿end;{while}
＿ClrMessage;
end;{main}
Run(AutoPanZoom);

管理人さん、下の書き込み削除願います、きちんとまとめていませんでした。

//リソースファイルの作成
VectorScriptではMac形式のリソースファイルを使用します。このリソースファイルの
中に文字列（STR#）やピクトイメージ（PICT）といったリソースを格納します。
ダイアログに表示させたい画像がPICTです。
リソースファイルを作成するにはResEdit(Mac OS 9)もしくはResorcerer(OS X)が必要
です。
//リソースファイルの利用
リソースファイルは必ず「Plug-Ins」フォルダ内に保存してください。
この時、リソースファイルにはMacなら".rsrc"、Windows版の場合は".rsr"という拡
張子をつけます。なお、Winでリソースファイルを使う場合、A+Aサイトの開発室に
ResDresというプログラムがあります。これを使ってリソースファイルを加工してください。これでWinでも読めるリソースファイルになります。これを行わないと読め
ないはずです。以上が準備段階です。

//ソースコード内
SetVSResourceFile(fileName)を一度実行すると、スクリプトが終了するまでリソー
スファイルにアクセス出来ます。fileNameは拡張子を除いたファイル名です。
実際にリソースを呼び出すにはCreateControl()、SetControlData()を使用します。

文字列のリソースはVWでも作れるみたいですが、使い方がよくわかりません。
という訳でリソースを扱う場合、Macが必要です。

以前(2001/09)メーリングリストで教えて頂いた事が有ります。
その時は、Macで作成したリソースファイルでしたら Windows版でも表示出来ました。
Windows版の場合、リソースファイルの拡張子は"***.rsr"とします。
このリソースファイルは Mac 専用のフォーマットでなければならないらしいです。
当時、私はリソースファイルを作成するために中古の iMac を購入しました。

与太郎さん、ありがとうございます。
詳しい説明の仕方がわからず、端的な質問しましたが、さすが与太郎さん
そうなんです、リソース部分で全く分からなくなっています。
よろしく、お願いいたします。

リソースファイルから画像を読み込んでモダンダイアログに表示出来ます。

if SetVSResourceFile(fileName) then begin
CreateControl(dialogID, itemID, controlKind, name, data);
end;{if}

fileName : リソースファイルのファイル名前
dialogID : ダイアログID
itemID : アイテムID
controlKind : コントロールの種類(1=画像／2=システムカラーパレット／3=スライダー)
name : コントロールの名前(何でも構いません)
data : コントロールのデータ(PICTリソースのリソースID)

SetVSResourceFileでリソースファイルを開いて、CreateControlで画像をセットします。
Macなら、ResEditでリソースファイルを作れるのですが、Winでリソースファイルを作る
方法が判りません。MacのファイルをWinで読んでも、リソース部分は無視されると思い
ます。そもそも、SetVSResourceFileがWin版で有効かどうかも知りません。(^^;)
ご存知の方、宜しくおねがいします。

ダイアログに画像を入れることは可能でしょうか。（windows)

均等配列文字のスクリプトを書き終えて、休み前には燃え尽きてしまいましたが、
休み中に、縮尺／単位が異なるファイルで試したら、バグが発覚してしまいました。
211行目の if (0 < i) & (i < (lng-1)) then begin が、
if (0 < i) & (i < (numText-1)) then begin の間違いです。

ACTさん、
VectorWorks 談話室のほうにレスしました。

どうもドラフターの感覚が抜けません。
ダブルラインではなくて、平行線はどう書きますか。

バックナンバーもご利用下さい。
本当は使いやす整理すべきなのですが…

皆さんのおかげでScript談話室がおおいに盛り上がりました。
大盛況につきメンテナンスです。