連載 コラムへ
重なった直線の検出と処理:VectorScript
*

<2011.7/28>
*
ゴンスケ殿の、
簡単と思えるひとつの問いかけが、
一ヶ月を超える五十数回のやり取りを発生させました。

惜しげも無く公開される開発のポイント、
山のような洞察とノウハウと実験は、緻密に解かれる推理小説を連想させます。
ちなみに、参加者全員、プログラムが
本職ではない方たちです。

Scriptがわからなくても、
この一連の物語りは非常に貴重で教育的です。
単なる技術にとどまらないプログラミングの醍醐味が魅力です。
強調表示
Scriptの威力に管理人が感嘆した所です)
ぜひ、ご一読下さい。
*
完成したScriptは下記のページにあります。
与太郎さんがHTMLにして下さいました。
(開発過程をご覧になれます)



 重なった直線の検出と処理    ゴンスケ
Thu Apr 14 18:36:00 2011

下記のような作業をスクリプトで自動化できる可能性があるかどうか、
ご教示いただければ幸いです。

異なるレイヤ(もしくはクラス)にある直線どうしが、一部あるいは全部
重なっているかどうかを検出し、重なっている直線をすべて選択する。


RE1:重なった直 線の検出と処理   masafumi
Fri Apr 15 17:12:49 2011

こんにちはゴンスケさん。

>異なるレイヤ(もしくはクラス)にある直線どうしが、一部あるいは全部
>重なっているかどうかを検出し、重なっている直線をすべて選択する。

基本的に出来ると思います。
以前作った「重複図形を削除」のスクリプトでは同一レイヤ上の選択した図形を
検索していましたが、すべてのレイヤー上の図形を検索・比較すれば良いと思います。

一部あるいは全部重なっているかの判断は、直線の座標と角度で判定していたと思います。


 RE2:重なった直線の検出と処理    ゴンスケさん
Sat Apr 16 11:27:05 2011

masafumiさん、ご無沙汰しています。また、ありがとうございました。
私のプログラミング能力でできるかどうかはなはだ不安ですが、過去ログを
参考に挑戦してみます。数千本の直線の処理なので、目視+手作業で十分可能な
範囲ですが、自動化した方が見落としが少ないですよね。完全一致か、1端点が
一致し長さが異なる重なり方だけなので、重なりの判断は、端点の座標、直線の
角度と長さでいけそうですね。

実はこれ、時代の異なる地籍図の比較のひとつとして、間口変化だけを強調した
表現を行いたいということが始まり。地籍は多角形で描き、字名や地番、あるいは
変化状況などのデータを与えています。この多角形の道路境界線に相当する辺に、
他の辺と異なる属性を与えられたら話はかなり簡単なのですが、できないので、
多角形をいったん直線に変換して、2つの時代の前面道路側で変化した部分だけを
抜き出して、強調表示するための属性を設定しようという目論んでいる次第です。


RE2:重なった直線の検出と処理(訂正)    ゴンスケ
Sat Apr 16 11:28:03 2011

自分のハンドル名に「さん」つけてどうする!? →たいへん失礼しました。


 RE3:重なった直線の検出と処理    与太郎
Sat Apr 16 13:28:38 2011

なかなか興味深い作業ですね。
新旧データを別レイヤにしておいて、
新しいレイヤに新、旧、共通部分をクラス
別に生成すればいいんでしょうか?


 RE4:重なった直線の検出と処理   masafumi
Sat Apr 16 14:15:06 2011

角度はVectorWorksの内部計算でも計算誤差・丸め誤差等で微妙に違うときが出ていました ので、厳密な判断をせずに
適当な位置で丸めて比較した方が良いように思います。(Ver10.5の時です。Ver2011ではまだ検証していません)

>実はこれ、時代の異なる地籍図の比較のひとつとして、間口変化だけを強調した
>表現を行いたいということが始まり。

んっ、昔の京都の間口税くらいしか思いつきません・・・?


 RE5:重なった直線の検出と処理    ゴンスケ
Sat Apr 16 20:30:49 2011

与太郎さん、地図の場所は、たぶんご近所ですよ。
現状では、3つの時代を別レイヤにして、変化あり、なしでクラス分けしています。
プレゼンのため、各時代ごとに数枚のレイヤがあります。たとえば敷地境界線など
同じ意味の図形を重ねて作っているので、精神衛生上とってもよろしくないです。
前の書き込みで書いたように、多角形の一辺一辺など、図形の構成要素ごとに
レコードを与えたり、レコードフィールド値に応じてグラフィック属性を与えられる
仕様になったら嬉しいですね。建具なんかは、構成要素ごとに属性をもてる訳だから、
自分で作ればよいのでしょうか。

masafumiさん、アドバイスありがとうございます。
今回は、端点が一致して角度が微妙に違う、という図形がほぼゼロなので、
厳密さはいりません。アドバイスいただいてなかったら、丸めればよいことに
気づかなかったかも。

ところで、僕が育った町は、間口で町内会費が差別化されていましたが、
あれって間口税の名残だったんでしょうね。喫茶室ネタになってしまって失礼!


RE6:重なった直線の検出と処理    与太郎
Sun Apr 17 15:36:54 2011

>与太郎さん、地図の場所は、たぶんご近所ですよ。
あらま、そうなんですか。

EqualPtだと座標値が微妙に違うとTrueになりません。
だからNereEqualPtみたいな関数を作ったりします。
許容誤差は関数パラメータかグローバル変数にします。

2本の線が部分的に重なっているかどうかの判定は、
どちらかの線が水平になるように2本の線を回転して、
Y座標の差を調べればいいと思います。
例えば次のような関数を考えます。
function IsOverlapped(pt11, pt12, pt21, pt22,:vector; prec:rea; var pt31, pt32:vector):boolean; 
pt11とpt12が線1、pt21とpt22が線2、pt31とpt32は重なる部分の線の座標です。
pt11を基点にすると回転角度は rot:=Vec2Ang(pt12-pt11); になるので、
pt12:= pt11 + Ang2Vec(0, Norm(pt12 - pt11);
pt21:= pt11 + Ang2Vec(Vec2Ang(pt21-pt11) - rot, Norm(pt21-pt11));
pt22:= pt11 + Ang2Vec(Vec2Ang(pt22-pt11) - rot, Norm(pt22-pt11);
で、線(pt11 - pt12)が水平になるように座標変換します。
pt21.xとpt22.xの両方がpt11.x以下か、
pt21.xとpt22.xの両方がpt12.x以上なら2本の線は重ならないので、
関数の戻り値としてFalseを返して終了します。
それ以外なら重なっている範囲を計算します。
つまり、pt11.x〜pt12.x と pt21.x〜pt22.x が重なる範囲です。
これは、手続きUnionRectでY座標に適当な値を入れて求められます。
求めた2つのX座標はpt31.xとpt32.xに入れます。
線(pt21-pt22)の、X=pt31.xとX=pt32.xでのY座標を計算して、
pt11.yとの差がどちらも許容誤差以下なら、
2本の線は重なっているので関数の戻り値としてTtueを返します。
一方でも許容誤差を超えていれば、関数の戻り値としてFalseを返します。
重なっている部分の線の座標は、pt31.y:=0; pt32.y:=0; として、
最初とは逆方向に座標を回転して求めます。
pt31:= pt11 + Ang2Vec(Vec2Ang(pt31-pt11) + rot, Norm(pt31-pt11));
pt32:= pt11 + Ang2Vec(Vec2Ang(pt32-pt11) + rot, Norm(pt32-pt11));

と、文章で書いてみましたが、これじゃあまるで暗号だ。
素直にスクリプトを書いたほうが判りやすかったですかね。


 RE7:重なった直線の検出と処理    与太郎
Mon Apr 18 18:09:07 2011

昨日のレスは判りにくく、タイプミスや勘違いもあったので、スクリプトを書いてみました。
UnionRectは重なった領域ではなく、2つの四角形を包括する領域を返す手続きだったので、
今回は使えませんでした。
IsOverlapped関数の最初の4個のパラメータ(pt11, pt12, pt21, pt22)は、本当は「var」を付け
るべきではないのですが、VectorScriptの仕様で「var」を付けたほうが簡単なのでそうしました。
GetOverlapp手続きも同様です。

procedure test;{ 直線の部分重複テスト }
{$ DEBUG}
const
__Precision = 0.001;{許容誤差}
__LineObj = 2;
var
__h1, h2__:handle;
__v11, v12, v21, v22, v31, v32__:vector;
__
__function IsOverlapped(var pt11, pt12, pt21, pt22:vector; prec:real; var pt31, pt32:vector):boolean;
__{ 2本の直線が重なっていたらTrueを返す。pt31とpt32には重なった部分の座標が入る。 }
__var
____result__:boolean;
____rot__:real;
____
____procedure SwapR(var d1, d2:real);
____var
______tmp__:real;
____begin
______tmp:= d1;
______d1:= d2;
______d2:= tmp;
____end;{SwapR}
____
____procedure GetOverlapp(var x11, x12, x21, x22:real; var x31, x32:real);
____begin
______if x12 < x11 then SwapR(x11, x12);
______if x22 < x21 then SwapR(x21, x22);
______if x11 < x21 then x31:= x21 else x31:= x11;
______if x12 < x22 then x32:= x12 else x32:= x22;
____end;{GetOverlapp}
____
__begin
____result:= false;
____rot:= Vec2Ang(pt12 - pt11);
____pt12:= pt11 + Ang2Vec(0, Norm(pt12 - pt11));
____pt21:= pt11 + Ang2Vec(Vec2Ang(pt21 - pt11) - rot, Norm(pt21 - pt11));
____pt22:= pt11 + Ang2Vec(Vec2Ang(pt22 - pt11) - rot, Norm(pt22 - pt11));
____if ((pt21.x < pt11.x) & (pt22.x < pt11.x)) | ((pt12.x < pt21.x) & (pt12.x < pt22.x)) then begin
______result:= false;
____end
____else begin
______GetOverlapp(pt11.x, pt12.x, pt21.x, pt22.x, pt31.x, pt32.x);
______pt31.y:= pt21.y + (pt21.x - pt11.x) / (pt22.x - pt21.x) * (pt22.y - pt21.y);
______pt32.y:= pt21.y + (pt22.x - pt11.x) / (pt22.x - pt21.x) * (pt22.y - pt21.y);
______result:= (Abs(pt31.y - pt11.y) < prec) & (Abs(pt32.y - pt12.y) < prec);
______if result then begin
________pt31:= pt11 + Ang2Vec(Vec2Ang(pt31 - pt11) + rot, Norm(pt31 - pt11));
________pt32:= pt11 + Ang2Vec(Vec2Ang(pt32 - pt11) + rot, Norm(pt32 - pt11));
______end;
____end;
____IsOverlapped:= result;
__end;{IsOverlapped}
__
begin{test}
__h1:= FSActLayer;
__if (h1 = nil) | (GetType(h1) <> LineObj) then begin
____AlrtDialog('アクティブレイヤの直線を2本選択してください。');
__end
__else begin
____h2:= NextSObj(h1);
____if (h2 = nil) | (GetType(h2) <> LineObj) then begin
______AlrtDialog('アクティブレイヤの直線を2本選択してください。');
____end
____else begin
______GetSegPt1(h1, v11.x, v11.y); GetSegPt2(h1, v12.x, v12.y);
______GetSegPt1(h2, v21.x, v21.y); GetSegPt2(h2, v22.x, v22.y);
______if IsOverlapped(v11, v12, v21, v22, Precision, v31, v32) then begin
________MoveTo(v31.x, v31.y);
________LineTo(v32.x, v32.y);
________SetLW(LNewObj, 42);
________SetPenBack(LNewObj, 32767, 0, 0);
________SetPenFore(LNewObj, 32767, 0, 0);
________SetDSelect(h1);
________SetDSelect(h2);
________ReDrawAll;
______end
______else begin
________AlrtDialog('直線を2本の線は重なっていません。');
______end;
____end;
__end;
end;
Run(test);


 RE8:重なった直線の検出と処理    ゴンスケ
Tue Apr 19 17:14:20 2011

与太郎さん、ありがとうございます。試してみました。
重なり部分に新たに線を引くアイディアに特に感心しました。
他のレイヤ&クラスに書いて、ついでにレコードフィールド値を与えれば、
私のやりたいことができます。とりあえず選択だけして、後は手動でやろうと
思っていたのですが、与太郎さん方式はとてもスマートです。
与太郎さんの開発速度には全くかなわないので、参考にさせていただきながら、
ぼちぼちやってみます。(締め切りに間に合うかどうかという別問題もあるが、、。)


 RE9:重なった直線の検出と処理    与太郎
Tue Apr 19 21:53:18 2011

>ゴンスケさん
確認のために線を描いたのですが、役に立ったようで何よりでした。

細かいことだと思っていたのですが、やはりまずいと思うので以下の修正をお願いします。
線(pt11〜pt12)が水平になるように座標を回転した時点で x11 < x12 は保証されているので、
if x12 < x11 then SwapR(x11, x12); は不要です。消して下さい。
if x22 < x21 then SwapR(x21, x22);はSwapRを展開して,
if x22 < x21 then begin tmp:= x11; x11:= x12; x12:= tmp; end;としてください。
GetOverlappの中でSwapRを実行するとx21とx22の値が入れ替わり、
その影響でpt21.xとpt22.xの値も変わってしまうのです。
もしも重複してない部分の線を描かせたら、結果がおかしくなるでしょう。
そういう副作用を避けるために、
function IsOverlapped(var pt11, pt12...の最初の「var」と、
procedure GetOverlapp(var x11, x12...の最初の「var」は、消して下さい。
修正したIsOverlapped関数は以下のようになります。

__function IsOverlapped(pt11, pt12, pt21, pt22:vector; prec:real; var pt31, pt32:vector):boolean;
__{ 2本の直線が重なっていたらTrueを返す。pt31とpt32には重なった部分の座標が入る。 }
__var
____result__:boolean;
____rot__:real;
____
____procedure GetOverlapp(x11, x12, x21, x22:real; var x31, x32:real);
____{ x11〜x12とx21〜x22の重なる範囲を返す。 }
____var
______tmp__:real;
____begin
______if x22 < x21 then begin
________tmp:= x21;
________x21:= x22;
________x22:= tmp;
______end;
______if x11 < x21 then x31:= x21 else x31:= x11;
______if x12 < x22 then x32:= x12 else x32:= x22;
____end;{GetOverlapp}
____
__begin{IsOverlapped}
____result:= false;
____rot:= Vec2Ang(pt12 - pt11);
____pt12:= pt11 + Ang2Vec(0, Norm(pt12 - pt11));
____pt21:= pt11 + Ang2Vec(Vec2Ang(pt21 - pt11) - rot, Norm(pt21 - pt11));
____pt22:= pt11 + Ang2Vec(Vec2Ang(pt22 - pt11) - rot, Norm(pt22 - pt11));
____if ((pt21.x < pt11.x) & (pt22.x < pt11.x)) | ((pt12.x < pt21.x) & (pt12.x < pt22.x)) then begin
______result:= false;
____end
____else begin
______GetOverlapp(pt11.x, pt12.x, pt21.x, pt22.x, pt31.x, pt32.x);
______pt31.y:= pt21.y + (pt21.x - pt11.x) / (pt22.x - pt21.x) * (pt22.y - pt21.y);
______pt32.y:= pt21.y + (pt22.x - pt11.x) / (pt22.x - pt21.x) * (pt22.y - pt21.y);
______result:= (Abs(pt31.y - pt11.y) < prec) & (Abs(pt32.y - pt12.y) < prec);
______if result then begin
________pt31:= pt11 + Ang2Vec(Vec2Ang(pt31 - pt11) + rot, Norm(pt31 - pt11));
________pt32:= pt11 + Ang2Vec(Vec2Ang(pt32 - pt11) + rot, Norm(pt32 - pt11));
______end;
____end;
____IsOverlapped:= result;
__end;{IsOverlapped}

以前masafumiさんが、10万個の図形を総当たりで重複チェックするのに5時間掛かったと
書かれてました。千個だとその1/10000なので数秒ということになります。
部分重複のほうが時間がかかりますが、CPUが早くなった分でチャラですかね。
これなら数千個までは総当たりでも構わないかも知れません。
それでもチェック回数を減らしたいときは、
最初に線の角度(0〜180ー)でソートして、角度の近い線だけチェックすると良いでしょう。


 RE10:重なった直線の検出と処理    与太郎
Fri Apr 22 23:40:32 2011

>いっかいこっきりの、それも腕力でなんとかなる仕事でそこまでやるかどうかも
>悩ましいですね。腕力仕事より、スクリプト書きの方が楽しいし。

同感です。行程表と競争するスリルも、腕力仕事の比ではありません。
傍から見たら「うさぎと亀」かも知れませんが。


 RE9:重なった直線の検出と処理    ゴンスケ
Thu Apr 21 18:10:07 2011

与太郎さん、たびたびありがとうございます。
与太郎さんとmasafumiさんのスクリプトとにらめっこしていたら、欲が出てきて、、、、。

要するに時代間の相違を複数の指標で示した図を作っているわけですが、
その中の1つの指標について、結果を表示させるところだけをスクリプトに
手伝ってもらおうと考えていたのだけれど、お二人のスクリプトを応用すれば、
表示に先立つ分析作業も、ある程度スクリプトに肩代わりさせられそうだと
思い始めました。そんな訳で、自動化させる作業を再考、整理しはじめています。
(いっかいこっきりの、それも腕力でなんとかなる仕事でそこまでやるかどうかも
 悩ましいですね。腕力仕事より、スクリプト書きの方が楽しいし。)


RE11:重なった直線の検出と処理   masafumi
Sun Apr 24 1:42:56 2011

ゴンスケさん、うまくいきそうで良かったですね。

たまにですが、腕力仕事では納期に間に合わないから何とかならないか?
といった仕事が有ります。
そんな時、スクリプトに助けられています。やってて良かったと思う瞬間ですね。


 RE12:重なった直線の検出と処理    石男
Sun Apr 24 9:28:29 2011

後だしですが、ひとつ書き込みます。

線分同士を比較して平行なら、重なる可能性があるので、線分の始点、終点のそれぞれを
もう一つの線分上にあるかを判定して重複の判定とします。

外部関数を使用していますが、ver.10.5以上なら問題ないはずです。
平行判定に外積を使います、外積=0なら平行ですが、この辺の許容誤差はVWの内部精度任せ
になります。
PROCEDURE xxxxx;
CONST
Precision = 0.001;{許容誤差}
VAR
v, v1, v2, v3, v4, v5 : VECTOR;
IntValue : INTEGER;
gValue, gValue2 : REAL;
onLine, onLine2 : BOOLEAN;
{線分の始点と終点をベクトルで}
{////////////////////////////// V_GetSegPt ////////////////////////////}
PROCEDURE V_GetSegPt( seg_h : HANDLE; VAR st_v, ed_v : VECTOR );
BEGIN
GetSegPt1( seg_h, st_v.x, st_v.y );
GetSegPt2( seg_h, ed_v.x, ed_v.y );
END;

{外積を求める--REAL値}
{///////////////////////////// V_CrossProduct2D ////////////////////////////}
FUNCTION V_CrossProduct2D( vec1, vec2 : VECTOR ): REAL;
BEGIN
V_CrossProduct2D := ( vec1.x*vec2.y ) - ( vec1.y*vec2.x );
END;

{////////////////////////////// Main ////////////////////////////}
BEGIN
V_GetSegPt( FSActLayer, v, v1 );
V_GetSegPt( NextSObj( FSActLayer ), v2, v3 );
gValue := V_CrossProduct2D( ( v1-v ), ( v3-v2 ) );
IF gValue = 0 THEN BEGIN{ 0= 平行}
onLine := PtOnLine( v2, v, v1, Precision );
onLine2 := PtOnLine( v3, v, v1, Precision );
Message( Concat( onLine, '&', onLine2 ) );
IF NOT( ( onLine = FALSE ) & ( onLine2 = FALSE ) ) THEN BEGIN
IF OverlapLineLine( v, v1, v2, v3, v4, v5, Precision) THEN BEGIN
Locus( v4.x, v4.y );
Locus( v5.x, v5.y );
END;
END ELSE BEGIN
Message( '重複なし' );
END;
END ELSE BEGIN
Message( '平行ではない' );
END;
END ;

RUN( xxxxx ) ;

すっきりしたやり方を考えたつもりなんですが、その割ではないかもしれません。


 RE13:重なった直線の検出と処理   masafumi
Mon Apr 25 10:52:04 2011

私は先にすべての直線の角度を取得してソートしています。ソー トすることで2直線が平行か
検索するときに、検索する角度より大きい(又は小さい)角度になったら検索をストップするこ
とができます。(以前、与太郎さんに教えていただいた方法です。)
多角形の各辺との比較にも使用したためです。

その後は石男さんと同様に、平行な直線の時は、基準直線の始点座標と平行な直線の始点座標から
角度を出して、角度が同一、又は座標が同一の時は2直線は同一線上にあると判断しています。

直線の重なり具合は2直線の始点・終点のX座標を比較して判断しています。角度が90度の時は
X座標はすべて同一になりますから、そのときはY座標で判断します。
(う〜ん、なんか・・・アナログ的な発想のような感じですねぇ)


 RE14:重なった直線の検出と処理    ゴンスケ
Tue Apr 26 8:47:18 2011

石男さんにまでご登場いただいて、、、、テーマとしてはきっと面白いものなんですね。
外積を使う方法、すっきりした「やり方」かどうかを言える力は私にはありませんが、
「考え方」がかっこいいですね、憧れます。

処理の流れはほぼ見えてきているけれど、過去Pascalだけは避けて通ったので、
細かなお決まりの部分でコケてばかり、挫折寸前です。BASICだったらなぁ、、、。

ところで、masafumiさん、ソートする大きな理由はパフォーマンスアップだと思いますが、
線分数が数千本くらいだと、そのルーチンを組み込んだ方がよいのか、なくてもがまん
できるくらいなのか、直感的な印象を教えていただければありがたいです。 

与太郎さん、
> 行程表と競争するスリルも、腕力仕事の比ではありません。
スリルを楽しむ境地に至るには、私にはまだまだ修練が必要です、、、。(^^;)

※力量のなさを喫茶室ネタでごまかしているような書き込みで失礼!


RE15: 重なった直線の検出と処理   masafumi
Tue Apr 26 10:49:53 2011

>線分数が数千本くらいだと、そのルーチンを組み込んだ方がよいのか、なくてもがまん
>できるくらいなのか、直感的な印象を教えていただければありがたいです

数千本ではソートの必要はないと思います。


RE16:重なった直線の検出と処理   masafumi
Wed Apr 27 13:35:54 2011

ゴンスケさん

かなりいい加減な感覚で答えていましたので確認のためチェックしてみました。
約5000点の直線を総当たりで検索しますと、5 分〜6分かかります。
角度をソートしますと、30秒以下で した。m(_ _)m

この差をどう感じるかは個人の感覚ですね。

ソートは下記のようにしています。角度をすべてプラスの値に変更してからソートしています。
同一直線上の図形を調べるところまでしかやっていません。


{**************************** 直線の重複を知る ******************************}
procedure DelEqual_Test;
var
lineCo :LongInt; {直線の数}
lineAngle :ARRAY [0..30000] OF Real; {直線の角度}
lineHandle :ARRAY [0..30000] OF Handle; {直線のハンドル}
SX,SY :ARRAY [0..30000] OF Real; {直線の始点座標}
EX,EY :ARRAY [0..30000] OF Real; {直線の終点座標}
chkFlg :ARRAY [0..30000] OF Boolean; {同一直線上のフラグ}
chkCO :Integer;
msg1,msg2:String;
k:integer;


{****************************** 2点の角度を計算 **********************************}
function GetAngle(ax,ay,bx,by:Real):Longint;
var
pV1,pV2:Vector;
begin
pV1.x:=ax;
pV1.y:=ay;
pV2.x:=bx;
pV2.y:=by;
{比較するための角度なので小数点2位までを整数にする}
GetAngle:=Round(Vec2Ang(pV2-pV1)*1000)/1000;
end;

{***************************** 直線の角度をソート *********************************}
procedure Q_Sort_Angle(left,right:Longint);
var
i, j :Longint;
pivot :Real;
tmpAng :Real;
tmpH :Handle;
msg :String;
begin
msg:='直線を角度でソート中! ';
Message(msg,' / ',right);
if left < right then
begin
pivot:= (lineAngle[left]+lineAngle[right])/2;
i:= left;
j:= right;
repeat
while (lineAngle[i] < pivot) do i:= i+1;
while (lineAngle[j] > pivot) do j:= j-1;
if (i <= j) then
begin
tmpAng:=lineAngle[i]; tmpH:=lineHandle[i];
lineAngle[i]:=lineAngle[j]; lineHandle[i]:=lineHandle[j];
lineAngle[j]:=tmpAng; lineHandle[j]:=tmpH;
i:= i+1;
j:= j-1;
end;
until (i > j);
Q_Sort_Angle(left, j);
Q_Sort_Angle(i, right);
end;
end;

{************************************* 比較 *************************************}
procedure Get_Find;
var
i,j:integer;
LAngle:Real;
x1,y1,x2,y2:Real;

begin
msg1:=' 同一線上の 図形数検索中 ';

i:=0;
j:=0;
chkCO:=0;
repeat
i:=i+1;
j:=i;
repeat
j:=j+1;

{同一角度かをチェック}
if (lineAngle[i]=lineAngle[j]) then
begin
{先に座標を比較}
x1:=Round(SX[i]/1000); y1:=Round(SY[i]/1000);
x2:=Round(SX[j]/1000); y2:=Round(SY[j]/1000);

{基準線と検索図形の始点座標から角度を取得}
if EqualPt(x1,y1,x2,y2) then LAngle:=lineAngle[i]
else begin
LAngle:=GetAngle(SX[i], SY[i],SX[j], SY[j]);
if LAngle < 0 then LAngle:=LAngle+180;
if LAngle=180 then LAngle:=0;
end;

{2直線が同一線上に有るとき}
if (lineAngle[i]=LAngle) then
begin

if chkFlg[i]=False then
begin
chkCO:=chkCO+1;
chkFlg[j]:=True;
{---------------------------------------------------------}

{ ここでX座標をチェックして2直線の重なり具合をチェック}

{---------------------------------------------------------}
end;
end;
end;

if (i mod 50)=0 then Message(msg1,chkCO,' / 検索済み図形数 ',(i));

until (j=lineCO) or (lineAngle[i] < lineAngle[j]);
until (i=(lineCO-1));
end;


{************* 角度を取得してソート。始点座標・終点座標取得 ******************}
procedure GetLine_Zahyou_Angle;
var
i:integer;
begin
for i:=1 to lineCO do
begin
chkFlg[i]:=False; {初期化}
lineAngle[i]:=Round(HAngle(lineHandle[i])*1000)/1000; {直線の角度}
if lineAngle[i] < 0 then lineAngle[i]:=Round(lineAngle[i]+180);
if lineAngle[i]=180 then lineAngle[i]:=0;
end;

Q_Sort_Angle(1,lineCO); {直線の角度でソート}
Clrmessage;

for i:=1 to lineCO do
begin
GetSegPt1(lineHandle[i], SX[i], SY[i]); {直線の始点の座標}
GetSegPt2(lineHandle[i], EX[i], EY[i]); {直線の終点の座標}
end;
end;

{************************ すべての直線のハンドルを取得 **********************}
procedure GetLineHandle;
var
layerH :Handle; {レイヤのハンドル}
objH :Handle; {図形のハンドル}
Typ :Integer;
begin
lineCO:=0;
layerH:=FLayer; {最上位のレイヤのハンドル}
repeat
objH:=FInLayer(layerH); {レイヤ上の最上位の図形のハンドル}
repeat
Typ:=GetType(objH);
{図形タイプが直線の時の処理}
if Typ=2 then
begin
lineCO:=lineCO+1;
lineHandle[lineCO]:=objH; {各直線のハンドル}
end;
objH:=NextObj(objH);
Until (objH=NIL);
layerH:=NextLayer(layerH);
until (LayerH=NIL);
end;

{******************************** スタート ***********************************}
begin
GetLineHandle; {先にすべての直線のハンドルを取得}
GetLine_Zahyou_Angle; {角度・角度ソート・座標を取得}
{
msg1:='D:\VS重複図形削除\作業用\chkList.txt';
Rewrite(msg1);
for k:=1 to lineCO do
begin
msg2:=Concat('lineHandle[',k,']= ',lineHandle[k],' lineAngle[',k,']= ',lineAngle[k]);
Writeln(msg2);
end;
Close(msg1);
}
Get_Find; {比較する}
msg1:=concat('同一直線上の数 = ',chkCO,' 全直線数 = ',lineCO);
AlrtDialog(msg1);
end;
run(DelEqual_Test);

{--------------------------------- ここまで -------------------------------------}


RE17:重なった直線の検出と処理    石男
Wed Apr 27 19:58:08 2011

masafumiさん、ゴンスケさん

角度のソートもそうですが、masafumiさん方式が圧倒的に早いです
比較の方法でかなり時間の短縮が出来るものですね、ちなみに私の方法では1000本の線分で
15分しかも、途中で強制的にやめました。同じものでmasafumiさん方式は30秒以下で完了で
す。
これは笑うしかありません。


RE18:重なった直線の検出と処理    ゴンスケ
Thu Apr 28 9:43:45 2011

masafumiさん、石男さん、貴重な情報をありがとうございます。
、、、みなさん凄すぎて、いまはお礼を書くぐらいしかできないです。


RE19:重なった直線の検出と処理    与太郎
Thu Apr 28 10:21:28 2011

masafumiさん、おひさしぶりです。
重複チェックのスクリプトがサラッと書ける時代になったんですねえ。
わたしも書いてみようという気になりましたよ。

ところで角度の扱いがおかしいところがありました。
まず、GetAngle関数の戻り値はlongint型なので角度は1000倍にして返さないといけないのですが、
GetAngle:=Round(Vec2Ang(pV2-pV1)*1000)/1000; で最後に1/1000にしているので、
結果が整数値の角度(0ー,1ー, 2ー…)になっています。
これは最初に定数 RoundFactor = 1000; で定義しておいて、
GetAngle:=Round(Vec2Ang(pV2-pV1)*RoundFactor); と直した方がいいでしょう。

それに関連して、
if LAngle < 0 then LAngle:= LAngle + 180;
if LAngle = 180 then LAngle:= 0;
も、
if LAngle < 0 then LAngle:= LAngle + 1800*RoundFactor;
if 180*RoundFactor <= LAngle then LAngle:= LAngle - 180*RoundFactor;
と変わります。

でも実は角度を丸めてしまうのはまずいと思います。
値を丸めると、浮動小数点数の最小桁程度しか違わなくても別々の値になることがあるからです。
たとえれば、となり家との間に県境があるようなもので、税金を納める先も違ってきます。
だから角度のデータはそのままにして、
角度の差が一定値以下なら処理するというやり方に変えたほうが良いでしょう。
ただ、最小値と最大値付近で余計な手間がかかってしまいますが。
これは座標値の場合も同じです。


 「RE19:重なった直線の検出と処理」の訂正    与太郎
Thu Apr 28 10:27:11 2011

if LAngle < 0 then LAngle:= LAngle + 1800*RoundFactor;は、
if LAngle < 0 then LAngle:= LAngle + 180*RoundFactor;が正しいです。


 RE19:重なった直線の検出と処理   masafumi
Thu Apr 28 10:28:29 2011

石男さん

角度をソートした後、

procedure Get_Find;

の repeat のなかで石男さんの方法を取り入れれば、もっと簡単に重複部分が検索できると思っています。
今回は自分で使っている方法が検証が簡単だったのでこの方法にしただけです。


RE20:重なった直線の検 出と処 理   masafumi
Thu Apr 28 10:56:18 2011

与太郎さん

>まず、GetAngle関数の戻り値はlongint型なので角度は1000倍にして返さないといけないのですが、
>GetAngle:=Round(Vec2Ang(pV2-pV1)*1000)/1000; で最後に1/1000にしているので、
>結果が整数値の角度(0ー,1ー, 2ー…)になっています。
>これは最初に定数 RoundFactor = 1000; で定義しておいて、
>GetAngle:=Round(Vec2Ang(pV2-pV1)*RoundFactor); と直した方がいいでしょう。

はっはっはぁ〜!(笑)

さすが与太郎さんですね。付け焼き刃がすっかりバレしまいました。
元々は検索を少しでも早くしようと Longint 型で使っているのですが、サンプルを書くときに real の
方が分かりやすいかと思い変更したのです。

GetAngle:=Round(Vec2Ang(pV2-pV1)*10000);

ってな感じですね。チェックしたようでもミスがでてしまいますねぇ。

>角度の差が一定値以下なら処理するというやり方に変えたほうが良いでしょう。

これも参考になります。ありがとうございます。 


 RE21:重なった直線の検出と処理   masafumi
Thu Apr 28 15:53:44 2011

なんか・・・いっぱい書き込んでますねぇ(自分)
与太郎さんにご指摘いただいた部分を少し変更して、石男さんの関数を組み込んでみました。
実行速度は問題ないようです。5000点の直線の検索で 30秒かかりません。

Precision:=0.001 の基準単位がわかりませんので、とりあえず「ミリメートル」を基準にしました。
Locus が微妙にずれるのが気になりますが、Locus のルーチンを通過するときは v, v1, v2, v3
の座標を使うようにすれば問題ないですね。

それにしても・・・
PtOnLine 関数と OverlapLineLine 関数・・・あやしい関数を使っていますねぇ。(笑)



{**************************** 直線の重複を知る ******************************}
procedure DelEqual_Test;
const
Err=9999;
kRound1=10000;
kRound2=180*kRound1;
var
gUnit :Integer; {単位}
lineCo :LongInt; {直線の数}
lineAngle :ARRAY [0..30000] OF LongInt; {直線の角度}
lineHandle :ARRAY [0..30000] OF Handle; {直線のハンドル}
SX,SY :ARRAY [0..30000] OF Real; {直線の始点座標}
EX,EY :ARRAY [0..30000] OF Real; {直線の終点座標}
chkCO :Integer;
msg1,msg2:String;
k:integer;

{********************************* 設定単位を取得 *********************************}
PROCEDURE Get_Fixed_Vlue;
VAR
upi:Real;
fraction,display:LONGINT;
format :INTEGER;
name,squareName :STRING;
Begin
gUnit:=Err;
{単位及び単位(平方)を取得}
GetUnits( fraction,display,format,upi,name,squareName);
if squareName = ' sq mm' then gUnit:=1 {ミリメートル}
else if squareName = ' sq cm' then gUnit:=100 {センチメートル}
else if squareName = ' sq m' then gUnit:=1000; {メートル}
End;

{****************************** 2点の角度を計算 **********************************}
function GetAngle(ax,ay,bx,by:Real):Longint;
var
pV1,pV2:Vector;
begin
pV1.x:=ax;
pV1.y:=ay;
pV2.x:=bx;
pV2.y:=by;
{比較するための角度なので小数点2位までを整数にする}
GetAngle:=Round(Vec2Ang(pV2-pV1)*kRound1);
end;

{***************************** 直線の角度をソート *********************************}
procedure Q_Sort_Angle(left,right:Longint);
var
i, j :Longint;
pivot :Real;
tmpAng :Real;
tmpH :Handle;
msg :String;
begin
msg:='直線を角度でソート中! ';
Message(msg,' / ',right);
if left < right then
begin
pivot:= (lineAngle[left]+lineAngle[right])/2;
i:= left;
j:= right;
repeat
while (lineAngle[i] < pivot) do i:= i+1;
while (lineAngle[j] > pivot) do j:= j-1;
if (i <= j) then
begin
tmpAng:=lineAngle[i]; tmpH:=lineHandle[i];
lineAngle[i]:=lineAngle[j]; lineHandle[i]:=lineHandle[j];
lineAngle[j]:=tmpAng; lineHandle[j]:=tmpH;
i:= i+1;
j:= j-1;
end;
until (i > j);
Q_Sort_Angle(left, j);
Q_Sort_Angle(i, right);
end;
end;

{**************************** 座標をベクトルに変換 *****************************}
procedure V_Convert(Var vec1,vec2:Vector; ax,ay,bx,by:Real);
begin
vec1.x:=ax; vec1.y:=ay;
vec2.x:=bx; vec2.y:=by;
end;

{外積を求める--REAL値}
{///////////////////////////// V_CrossProduct2D ////////////////////////////}
FUNCTION V_CrossProduct2D( vec1, vec2 : VECTOR ): REAL;
BEGIN
V_CrossProduct2D := ( vec1.x*vec2.y ) - ( vec1.y*vec2.x );
END;


{************************************* 比較 *************************************}
procedure Get_Find;
var
i,j:Integer;
LAngle:Real;
x1,y1,x2,y2:Real;
v,v1,v2:Vector;
v3,v4,v5:Vector;
IntValue : INTEGER;
gValue, gValue2 : REAL;
onLine, onLine2 : BOOLEAN;
Precision:Real;
begin
msg1:=' 重複図形の数を検索中 ';
Precision:=0.001/gUnit;{許容誤差}
i:=0;
j:=0;
repeat
i:=i+1;
j:=i;
repeat
j:=j+1;
V_Convert(v,v1,SX[i],SY[i],EX[i],EY[i]);
{同一角度かをチェック}
if (lineAngle[i]=lineAngle[j]) then
begin
V_Convert(v2,v3,SX[j],SY[j],EX[j],EY[j]);
gValue := V_CrossProduct2D( ( v1-v ), ( v3-v2 ) );

IF gValue = 0 THEN BEGIN{ 0= 平行}
onLine := PtOnLine( v2, v, v1, Precision );
onLine2 := PtOnLine( v3, v, v1, Precision );
IF NOT( ( onLine = FALSE ) & ( onLine2 = FALSE ) ) THEN BEGIN
IF OverlapLineLine( v, v1, v2, v3, v4, v5, Precision) THEN BEGIN
Locus( v4.x, v4.y );
Locus( v5.x, v5.y );
chkCO:=chkCO+1;
END;
END;
END;
end;

if (i mod 50)=0 then Message(msg1,chkCO,' / 検索済み図形数 ',(i));

until (j=lineCO) or (lineAngle[i] < lineAngle[j]);
until (i=(lineCO-1));
Clrmessage;
end;


{************* 角度を取得してソート。始点座標・終点座標取得 ******************}
procedure GetLine_Zahyou_Angle;
var
i:integer;
begin
for i:=1 to lineCO do
begin
lineAngle[i]:=Round(HAngle(lineHandle[i])*kRound1); {直線の角度}
if lineAngle[i] < 0 then lineAngle[i]:=Round(lineAngle[i]+ kRound2);
if lineAngle[i]= kRound2 then lineAngle[i]:=0;
end;

Q_Sort_Angle(1,lineCO); {直線の角度でソート}
Clrmessage;

for i:=1 to lineCO do
begin
GetSegPt1(lineHandle[i], SX[i], SY[i]); {直線の始点の座標}
GetSegPt2(lineHandle[i], EX[i], EY[i]); {直線の終点の座標}
end;
end;

{************************ すべての直線のハンドルを取得 **********************}
procedure GetLineHandle;
var
layerH :Handle; {レイヤのハンドル}
objH :Handle; {図形のハンドル}
Typ :Integer;
begin
lineCO:=0;
layerH:=FLayer; {最上位のレイヤのハンドル}
repeat
objH:=FInLayer(layerH); {レイヤ上の最上位の図形のハンドル}
repeat
Typ:=GetType(objH);
{図形タイプが直線の時の処理}
if Typ=2 then
begin
lineCO:=lineCO+1;
lineHandle[lineCO]:=objH; {各直線のハンドル}
end;
objH:=NextObj(objH);
Until (objH=NIL);
layerH:=NextLayer(layerH);
until (LayerH=NIL);
end;

{******************************** スタート ***********************************}
begin
Get_Fixed_Vlue;
if gUnit=Err then
begin
msg1:='単位を変更してください。';
AlrtDialog(msg1);
end else begin
GetLineHandle; {先にすべての直線のハンドルを取得}
GetLine_Zahyou_Angle; {角度・角度ソート・座標を取得}
{
msg1:='D:\VS重複図形削除\作業用\chkList.txt';
Rewrite(msg1);
for k:=1 to lineCO do
begin
msg2:=Concat('lineHandle[',k,']= ',lineHandle[k],' lineAngle[',k,']= ',lineAngle[k]);
Writeln(msg2);
end;
Close(msg1);
}
Get_Find; {比較する}
msg1:=concat('重複図形の数 = ',chkCO,' 全直線数 = ',lineCO);
AlrtDialog(msg1);
end;
end;
run(DelEqual_Test);


RE22: 重なっ た直線の検出と処理    石男
Thu Apr 28 18:20:22 2011

このネタ、完全にオモチャになっていますね(笑)

>procedure Get_Find;の中のchkCO:=chkCO+1;ですが、一度前の方で初期 化しないと
変な数になってしまいます。ついでにSetSelectも付けました。

{************************************* 比較 *************************************}
procedure Get_Find;
var
i,j:Integer;
LAngle:Real;
x1,y1,x2,y2:Real;
v,v1,v2:Vector;
v3,v4,v5:Vector;
IntValue : INTEGER;
gValue, gValue2 : REAL;
onLine, onLine2 : BOOLEAN;
Precision:Real;
begin
msg1:=' 重複図形の数を検索中 ';
Precision:=0.001/gUnit;{許容誤差}
i:=0;
j:=0;
chkCO:=0;
repeat
i:=i+1;
j:=i;
repeat
j:=j+1;
V_Convert(v,v1,SX[i],SY[i],EX[i],EY[i]);
{同一角度かをチェック}
if (lineAngle[i]=lineAngle[j]) then
begin
V_Convert(v2,v3,SX[j],SY[j],EX[j],EY[j]);
gValue := V_CrossProduct2D( ( v1-v ), ( v3-v2 ) );

IF gValue = 0 THEN BEGIN{ 0= 平行}
onLine := PtOnLine( v2, v, v1, Precision );
onLine2 := PtOnLine( v3, v, v1, Precision );
IF NOT( ( onLine = FALSE ) & ( onLine2 = FALSE ) ) THEN BEGIN
IF OverlapLineLine( v, v1, v2, v3, v4, v5, Precision) THEN BEGIN
SetSelect(lineHandle[i]);
SetSelect(lineHandle[j]);
Locus( v4.x, v4.y );
Locus( v5.x, v5.y );
chkCO:=chkCO+1;
END;
END;
END;
end;

if (i mod 50)=0 then Message(msg1,chkCO,' / 検索済み図形数 ',(i));

until (j=lineCO) or (lineAngle[i] < lineAngle[j]);
until (i=(lineCO-1));
Clrmessage;
end;

>PtOnLine 関数と OverlapLineLine 関数...
あるものは使う主義なので探し出してでも使います(笑)

それと完全に蛇足なのですが、複数のレイヤにまたがる直線のハンドルの取り方がわから
なくなり、レファレンスを眺めて思いついたやり方なのですが...

サブルーチン
{線分のハンドルを取得}
{////////////////////////////// GetLine2Handle ////////////////////////////}
FUNCTION GetLine2Handle( objH :HANDLE): BOOLEAN;
BEGIN
IF GetType( objH ) = 2 THEN BEGIN
lineCO := lineCO+1;
lineHandle[lineCO] := objH;
END;
END;

として、メインの中で
lineCO := 0;
ForEachObjectInLayer( GetLine2Handle, 0, 0, 1);
というやり方はどうでしょう、何かあなた任せのような感じですが(笑)


 RE23:重なった直線の検出と処理   masafumi
Thu Apr 28 21:50:40 2011

>このネタ、完全にオモチャになっていますね(笑)

いえいえ、お勉強です。(笑)

>>procedure Get_Find;の中のchkCO:=chkCO+1;ですが、一度前の方で初期化しないと
>変な数になってしまいます。ついでにSetSelectも付けました。

あっ、完全に忘れていました。m(_ _)m

SetSelect もいいですが、2つの Locus の代わりに MoveTo・LineTo としてレイヤ情報
によって色分けすれば、当初の目的に近づけそうですね。


>ForEachObjectInLayer( GetLine2Handle, 0, 0, 1);

使ったことがないので何とも言えないのですが、今回の条件の中にレイヤ・クラスと
図形の関係を知る必要が有ったような・・・。
レイヤ名(ハンドルでもいいのですが)と図形との関係は取得出来るのでしょうか?
図形のハンドルだけを取得するには良さそうですね。


 RE24:重なった直線の検出と処理    ゴンスケ
Thu Apr 28 23:24:19 2011

いやぁ、もう、どんどんオモチャにしてくださいな。(笑)
完成させられなくても(と逃げ口上)、とても良い勉強になっています。
でもGWはお外で遊びましょ!

> 2つの Locus の代わりに MoveTo・LineTo としてレイヤ情報
> によって色分けすれば、当初の目的に近づけそうですね。

そうなんです。で、すでにやってみてました。
(動作チェックのためには、SetSelectで十分。)

ForEach...は、レコードフィールドに書いてある地番を多角形上に書くスクリプトで
重宝していて、今回のもForEach...でいけるのかなと思っていました。
masafumiさんが使っていないのは、何か理由があるんだろうと考えていますが、、、
自ら結論を出せる知識がないのでした、、、。


 RE25:重なった直線の検出と処理    石男
Thu Apr 28 23:49:41 2011

過去最長のレスかな?

試してはいませんが、図形のハンドルを頼りにGetClassとGetLayer&GetLNameを使えば
図形のどのクラスとレイヤに所属しているかが分かると思いますが...

{////////////////////////////// GetLine2Handle ////////////////////////////}
FUNCTION GetLine2Handle( objH :HANDLE): BOOLEAN;
BEGIN
IF GetType( objH ) = 2 THEN BEGIN
lineCO := lineCO+1;
lineHandle[lineCO] := objH;
ClName[lineCO]:=GetClass(objH);
LName[lineCO]:=GetLName( GetLayer(objH) );
END;
END;
こんな感じにすれば、多分大丈夫なのでは...

>でもGWはお外で遊びましょ!
はい、観光地はどこも閑古鳥が鳴いています、みんな遊びに行きましょう(笑)


 RE26:重なった直線の検出と処理   masafumi
Fri Apr 29 10:13:31 2011

石男さんのレスを見て初めて気がつきました。目から鱗です。

ForEach...

最初の引数は図形のハンドルを返すものとばかり思い込んでいました。
「関数型サブルーチンの名前」なんですねぇ。
(リファレンスをどのように読んだらそうなるのか? 自分)

ありがとうございます。


 RE27:重なった直線の検出と処理   masafumi
Fri Apr 29 22:15:32 2011

今、いろいろ見直していましたら、またまたミスを発見。

function GetAngle(ax,ay,bx,by:Real):Longint;

このルーチンは必要ないですね。(涙)
石男さんのガイセキを取り入れたことによって、まったく必要にないモノになっていす。
お騒がせいたしました。これ上は見ないことにしましょう!。(フゥ〜!)

連休は温泉にでも行ってきます。


 RE28:重なった直線の検出と処理    ゴンスケ
Sat Apr 30 2:02:23 2011

外積を求めて平行を判定する部分ですが、CrossProductというのを見つけました。
試したところ、こんな感じで同じ結果になりました。

gValue := Norm (CrossProduct( ( v1-v ), ( v3-v2 ) ));

CrossProductは3次元ベクトルを戻すので、Normを合わせて使ってみてます。

ただし、全体としてうまく結果がでてくれてないので、、、GW明けにしよう、、、。。


 RE29:重なった直線の検出と処理    石男
Sun May 1 17:29:49 2011

やはり気になりましたのでいじってみました...
構造体の動的配列を使っていますが、オバーフローの処理はしていません。

以前のままですと重複線分の数があってないようなのでフラグを立ててチェックしました。
レイヤ名とクラス名をついでに取るようにしました。

PROCEDURE DelEqual_Lines;
CONST
Err = 9999;
kRound1 = 10000;
kRound2 = 180*kRound1;
TYPE
myLines = STRUCTURE
Lh : HANDLE;
Lang : REAL;
clName, layName : STRING;
flg : BOOLEAN;
END;

VAR
gUnit : INTEGER; {単位}
v, v1, v2, v3, v4, v5 : VECTOR;
gValue : REAL;
onLine, onLine2 : BOOLEAN;
lineArray: DYNARRAY[ ] OF myLines;
gLine : LONGINT;
chkCO : INTEGER;
i, j : LONGINT;
msg1, msg2 : STRING;

{設定単位を取得}
{////////////////////////////// Get_Fixed_Vlue ////////////////////////////}
PROCEDURE Get_Fixed_Vlue;
VAR
upi : REAL;
fraction, display : LONGINT;
format : INTEGER;
name, squareName : STRING;
BEGIN
gUnit:=Err;
{単位及び単位(平方)を取得}
GetUnits( fraction, display, format, upi, name, squareName );
IF squareName = ' sq mm' THEN gUnit:=1 {ミリメートル}
ELSE IF squareName = ' sq cm' THEN gUnit:=100 {センチメートル}
ELSE IF squareName = ' sq m' then gUnit:=1000; {メートル}
End;

{線分の始点と終点をベクトルで}
{////////////////////////////// V_GetSegPt ////////////////////////////}
PROCEDURE V_GetSegPt( seg_h : HANDLE; VAR st_v, ed_v : VECTOR );
BEGIN
GetSegPt1( seg_h, st_v.x, st_v.y );
GetSegPt2( seg_h, ed_v.x, ed_v.y );
END;

{2D基準点をベクトルで}
{////////////////////////////// V_DrawLocPt ////////////////////////////}
PROCEDURE V_DrawLocPt( vec : VECTOR );
BEGIN
Locus( vec.x, vec.y );
END;

{線分のハンドルを取得}
{////////////////////////////// GetLineHandle ////////////////////////////}
FUNCTION GetLineHandle( hd :HANDLE): BOOLEAN;
BEGIN
IF GetType( hd ) = 2 THEN BEGIN{GetTypeN--2011}
i := i+1;
lineArray[ i ].Lh := hd;
lineArray[ i ].Lang := Round( HAngle( lineArray[ i ].Lh )*kRound1 ); {直線の角度}
IF lineArray[ i ].Lang < 0 THEN lineArray[ i ].Lang := Round( lineArray[ i ].Lang+kRound2 );
IF lineArray[ i ].Lang = kRound2 THEN lineArray[ i ].Lang := 0;
lineArray[ i ].clName := GetClass( lineArray[ i ].lh );{クラス取得}
lineArray[ i ].layName := GetLName( GetLayer( lineArray[ i ].lh ) );{レイヤ取得}
lineArray[ i ].flg := FALSE;{チェックカウンターのためのフラグの初期化}
END;
END;

{外積を求める--REAL値}
{///////////////////////////// V_CrossProduct2D ////////////////////////////}
FUNCTION V_CrossProduct2D( vec1, vec2 : VECTOR ): REAL;
BEGIN
V_CrossProduct2D := ( vec1.x*vec2.y ) - ( vec1.y*vec2.x );
END;

{直線の角度をソート}
{////////////////////////////// Q_Sort_Angle ////////////////////////////}
PROCEDURE Q_Sort_Angle( left, right : LONGINT );
VAR
pivot : REAL;
tmpAng : REAL;
tmpH : HANDLE;
msg : STRING;
temp2 : myLines;
BEGIN
msg :='直線を角度でソート中! ';
Message( msg, ' / ', right );
IF left < right THEN
BEGIN
pivot := ( lineArray[ left ].Lang+lineArray[right].Lang )/2;
i := left;
j := right;
REPEAT
while ( lineArray[ i ].Lang < pivot ) DO i:= i+1;
while ( lineArray[ j ].Lang > pivot) DO j:= j-1;
IF ( i <= j ) THEN BEGIN
tmpAng := lineArray[ i ].Lang; tmpH := lineArray[ i ].Lh;
temp2 := lineArray[ i ];
lineArray[ i ].Lang := lineArray[ j ].Lang; lineArray[ i ].Lh := lineArray[ j ].Lh;
lineArray[ j ].Lang := tmpAng; lineArray[ j ].Lh := tmpH;
lineArray[ j ] := temp2;
i := i+1;
j := j-1;
END;
UNTIL ( i > j );
Q_Sort_Angle( left, j );
Q_Sort_Angle( i, right );
END;
END;

{////////////////////////////// Get_Find ////////////////////////////}
PROCEDURE Get_Find;
VAR
Precision : REAL;
BEGIN
Precision := 0.001/gUnit;{許容誤差}
msg1:=' 同一線上の 図形数検索中 ';
i := 0;
j := 0;
chkCO := 0;
REPEAT
i := i+1;
j := i;
REPEAT
j := j+1;

{同一角度かをチェック}
IF ( lineArray[ i ].Lang = lineArray[ j ].Lang ) THEN BEGIN
V_GetSegPt( lineArray[ i ].Lh, v, v1 );
V_GetSegPt( lineArray[ j ].Lh, v2, v3 );
gValue := V_CrossProduct2D( ( v1-v ), ( v3-v2 ) );
IF gValue = 0 THEN BEGIN
onLine := PtOnLine( v2, v, v1, Precision );
onLine2 := PtOnLine( v3, v, v1, Precision );

IF NOT( ( onLine = FALSE ) & ( onLine2 = FALSE ) ) THEN BEGIN
IF OverlapLineLine( v, v1, v2, v3, v4, v5, Precision) THEN BEGIN{重複線分の処理}
IF lineArray[ i ].flg = FALSE THEN BEGIN
lineArray[ i ].flg := TRUE;
chkCO := chkCO+1;
SetSelect( lineArray[ i ].Lh );
IF ( lineArray[ i ].layName = 'レイヤ-1' )&( lineArray[ i ].clName = '一般' ) THEN BEGIN
SetPenFore( lineArray[ i ].Lh, 65535, 0, 65535 );{pink}
END;
END;
IF lineArray[ j ].flg = FALSE THEN BEGIN
lineArray[ j ].flg := TRUE;
chkCO := chkCO+1;
SetSelect( lineArray[ j ].Lh );
IF ( lineArray[ j ].layName = 'レイヤ-1' )&( lineArray[ j ].clName = '一般' ) THEN BEGIN
SetPenFore( lineArray[ j ].Lh, 65535, 0, 65535 );{pink}
END;
END;

V_DrawLocPt( v4 );
V_DrawLocPt( v5 );
END;
END;
END;
IF ( i mod 50 ) = 0 THEN Message( msg1, chkCO, ' / 検索済み図形数 ', ( i ) );
END;
UNTIL ( j = gLine ) OR ( lineArray[ i ].Lang < lineArray[ j ].Lang );
UNTIL ( i= ( gLine-1 ) );

END;
{////////////////////////////// Main ////////////////////////////}
BEGIN
PushAttrs;
DSelectAll;
Get_Fixed_Vlue;
IF gUnit=Err THEN
BEGIN
msg1:='単位を変更してください。';
AlrtDialog(msg1);
END ELSE
BEGIN
gLine := Count( T = LINE );
Message( Concat( '線分の数 = ', gLine ) );
ALLOCATE lineArray[ 1..gLine ];
ForEachObjectInLayer( GetLineHandle, 0, 0, 1);
Q_Sort_Angle( 1, gLine );

Get_Find; {比較する}
msg1 := Concat( '重複線分の数 = ', chkCO,' 線分の数 = ',gLine );
Message( msg1 );
AlrtDialog( msg1 );
END;
PopAttrs;
END;
RUN( DelEqual_Lines );


 RE30:重なった直線の検出と処理   masafumi
Mon May 2 13:16:49 2011


石男さん、お疲れ様です。ずいぶん良くなりましたね。
それでもまだ、検索に引っかからない場合が有りました。

>gValue := V_CrossProduct2D( ( v1-v ), ( v3-v2 ) );

の値が「0」にならずに、浮動小数点で

gValue := 1.16415321826935e-010
gValue := 3.32016497850418e-007

のような値になるため、

>IF gValue = 0 THEN BEGIN{ 0= 平行}

の条件をクリア出来ないことが多分に有ります。この値は角度を比較するためだけの値ですから

gValue :=Round(gValue*100000);

のように適当に丸めるか、与太郎さんの言われるように

>角度の差が一定値以下なら処理するというやり方に変えたほうが良いでしょう。

Precision := 0.0001;
IF ((-Precision <= gValue) and (gValue <= Precision)) THEN BEGIN

のようにした方が良いようですね。それと

IF NOT( ( onLine = FALSE ) & ( onLine2 = FALSE ) ) THEN BEGIN

この部分ですが、v,v1 の直線が v2,v3 の直線より短くて v2,v3 の直線の内側に有る場合( v,v1 の
始点・終点がどちらも v2,v3 の始点・終点の内側。シツコイ?)はどちらも FALSE を返して、重複
していないと解釈しているようです。(今回の設定には必要なさそうですが)それでも

PROCEDURE Get_Find

を下記のように変更してみました。 onLine を noLine1 に変更して noLine3 noLine4 を追加し
グローバル変数だったのをこのルーチンへ移動しました。
Precision を 0.001→0.0001 に変更。gValue の誤差と PtOnLine の誤差の両方に兼用ってのは
まずいかな・・・とも思いましたがそのままいきます。(^^;)


{////////////////////////////// Get_Find ////////////////////////////}
PROCEDURE Get_Find;
VAR
Precision : REAL;
onLine1, onLine2 : BOOLEAN;
onLine3, onLine4 : BOOLEAN; {この部分追加}
BEGIN
Precision := 0.0001/gUnit;{許容誤差}
msg1:=' 同一線上の 図形数検索中 ';
i := 0;
j := 0;
chkCO := 0;
REPEAT
i := i+1;
j := i;
REPEAT
j := j+1;

{同一角度かをチェック}
IF ( lineArray[ i ].Lang = lineArray[ j ].Lang ) THEN BEGIN
V_GetSegPt( lineArray[ i ].Lh, v, v1 );
V_GetSegPt( lineArray[ j ].Lh, v2, v3 );
gValue := V_CrossProduct2D( ( v1-v ), ( v3-v2 ) );
IF ((-Precision <= gValue) and (gValue <= Precision)) THEN BEGIN
onLine1 := PtOnLine( v2, v, v1, Precision );
onLine2 := PtOnLine( v3, v, v1, Precision );}

{------------- 下2行追加 -------------}
onLine3 := PtOnLine( v, v2, v3, Precision );
onLine4 := PtOnLine( v1, v2, v3, Precision );
{----------------------- 追加部分も条件判断する ---------------------------------------}
IF NOT((onLine1=FALSE) & (onLine2=FALSE) & (onLine3=FALSE) & (onLine4=FALSE)) THEN BEGIN
IF OverlapLineLine( v, v1, v2, v3, v4, v5, Precision) THEN BEGIN{重複線分の処理}
IF lineArray[ i ].flg = FALSE THEN BEGIN
lineArray[ i ].flg := TRUE;
chkCO := chkCO+1;
SetSelect( lineArray[ i ].Lh );
IF ( lineArray[ i ].layName = 'レイヤ-1' )&( lineArray[ i ].clName = '一般' ) THEN BEGIN
SetPenFore( lineArray[ i ].Lh, 65535, 0, 65535 );{pink}
END;
END;
IF lineArray[ j ].flg = FALSE THEN BEGIN
lineArray[ j ].flg := TRUE;
chkCO := chkCO+1;
SetSelect( lineArray[ j ].Lh );
IF ( lineArray[ j ].layName = 'レイヤ-1' )&( lineArray[ j ].clName = '一般' ) THEN BEGIN
SetPenFore( lineArray[ j ].Lh, 65535, 0, 65535 );{pink}
END;
END;

V_DrawLocPt( v4 );
V_DrawLocPt( v5 );
END;
END;
END;
IF ( i mod 50 ) = 0 THEN Message( msg1, chkCO, ' / 検索済み図形数 ', ( i ) );
END;
UNTIL ( j = gLine ) OR ( lineArray[ i ].Lang < lineArray[ j ].Lang );
UNTIL ( i= ( gLine-1 ) );

END;
{-------------------------------------- ここまで ----------------------------------------}

これで私の想定していた重複部分はクリアされました。(^_^)

あと、2直線が重複していなくても同一角度で始点・終点どちらかの端点が同じ座標(2直線が接している)
の時も True とFalse を返してきます。この場合

IF OverlapLineLine( v, v1, v2, v3, v4, v5, Precision) THEN BEGIN

の v4 と v5 は同じ座標になります。直線を画く分には影響はないでしょうが chkCO := chkCO+1; はカウント
され選択状態になります。(頭がオーバーヒート寸前なので、必要ならばこの部分はどなたかお願いします(笑))


もう一つ目から鱗・・・。

PushAttrs と PopAttrs

今まで、ずぅ〜〜〜っと Get_Fixed_Vlue の中でシコシコと値を取得しては書いて Get_Fixed_Vlue 関数を作って
その中で元に戻していました。(ナサケナイ・・・)



 RE31:重なった直線の検出と処理   masafumi
Mon May 2 13:24:20 2011

どうでもいいところで、またミスってました。(^^;)

>今まで、ずぅ〜〜〜っと Get_Fixed_Vlue の中でシコシコと値を取得しては書いて Get_Fixed_Vlue 関数を作って

  Set_Fixed_Vlue 関数を作って

ですね。(ハァー)


 RE32:重なった直線の検出と処理   masafumi
Mon May 2 14:03:21 2011

角度の誤差には単位は関係ないですね。というより時には誤動作を起こしそうです。

>IF ((-Precision <= gValue) and (gValue <= Precision)) THEN BEGIN

は別に定数を設けて

const
Precision2=0.00001;
        ・
        ・
        ・
IF ((-Precision2 <= gValue) and (gValue <= Precision2)) THEN BEGIN

の方が良さそうです。


 RE33:重なった直線の検出と処理    石男
Mon May 2 20:25:28 2011

masafumiさん、お疲れさまでした。

>の値が「0」にならずに...
やはり、誤差を最初から認めないのはいけませんよね。PtOnLineとOverlapLineLineで
そうしているんですからね。

>2直線が重複していなくても同一角度で始点・終点どちらかの端点が同じ座標
>(2直線が接している)
ならば、こんなのはどうでしょうか?

 IF OverlapLineLine( v, v1, v2, v3, v4, v5, Precision) THEN BEGIN
 IF NOT( EqPt2D( v4, v5, Precision ) ) THEN BEGIN

通常のEqualPtは厳密過ぎますので、隠しコマンドのEqPt2Dを使えば誤差を設定出来ます。
EqPt2Dはver.11からですが、同等のものでEqPtがあります。こいつはver.10.5から使用
出来ます。


 RE34:重なった直線の検出と処理   masafumi
Wed May 4 22:21:32 2011

>通常のEqualPtは厳密過ぎますので、隠しコマンドのEqPt2Dを使えば誤差を設定 出来ます。
>EqPt2Dはver.11からですが、同等のものでEqPtがあります。こいつはver.10.5から使用
>出来ます。

相変わらずマニアックな関数を使っていますねぇ。(笑)

リファレンスに載っていない関数は動作が保証されてなく、動作確認は自己責任でってことになり
検証には、けっこう時間がかかります。臆病な私は近づかないようにしています。(^^;)


RE35:重なった直線の検 出と処 理    与太郎
Fri May 6 23:27:44 2011

ゴンスケさんのお題とは方向性が違うような気がしますが、重複チェックのスクリプトを書いてみまし た。
レイヤ別、クラス別、属性別に処理するオプションも付けましたが、ダイアログを作るのが面倒 だったので
インターフェースはありません。
オプションを変更するにはソースを書き換える必要があります。
ちょっと長いのでリンクだけ貼っておきます。興味のある人はどうぞ。
http://web.me.com/justlikeyoudo/vsfactory/samples/commands/check_overlap_line.htm

グループ内の線がチェック対象にならないのは仕様です。
ForEachObjectInLayerのパラメーターで変えられるはずですが、試したことが無いので放置してます。

配列は最大で-32768〜32767まで取れますが、
線が32767本以下なら1から、それより多 ければ-32768から始めます。
理由は、SortArrayがマイナスから始まる配列に対応していないからです。
文字列でのソートはSortArrayが圧倒的に速いので、32767本以下なら SortArrayを使おうということです。
自前のソートも少しでも速くなるように、最終段階で選択ソートに切り替えるようにするつもりですが、
その部分はまだ書いていません。


 RE36:重なった直線の検出と処理   masafumi
Sat May 7 16:27:54 2011

与太郎さん、お疲れ様です。ソース見せていただきました。
なんか、スッキリとまとまっていますね。実行時間もずいぶん早いです。
約 1000 個の直線4890 個の重複部分を削除するのに約7秒でした。(^_^)

>function XY2Vec(x, y:real):vector;

私のように、わざわざ var を使って
Procedure (var Vec1:vector; ax,ay:real);
にしなくても、function で返り値を vector で返せば良いのですねぇ。勉強になります。

簡単にしか見ていませんが、直線が2本の時に拾ってきません。たぶん

>if nLine <= 2 then begin
>errMsg:= '線を2本以上選択してください!';

この部分だと思います。 if nLine < 2 then begin ですとうまくいきます。
それと下記のデータ(私の想定重複部分です)で試してみてください。
私の環境では重複部分の長い方の直線を削除している場合が有ります。

Procedure Line_Plot;
Begin
MoveTo(-6500 , 4400);
LineTo(-5214.15206231032 , 4925.84196812896);
MoveTo(-6500 , 4400);
LineTo(-240 , 6960);
MoveTo(-240 , 6960);
LineTo(-3370 , 5680);
MoveTo(-2527.26083634201 , 994.781588302832);
LineTo(-3655.13962967792 , 154.294987499708);
MoveTo(-400 , 2580);
LineTo(-1418.98058184208 , 1820.66350872337);
MoveTo(-400 , 2580);
LineTo(-4560 , -520);
MoveTo(-2527.26083634201 , 994.781588302832);
LineTo(-1418.98058184208 , 1820.66350872337);
MoveTo(610.835961879696 , 199.180755906419);
LineTo(1982.4066407619 , 1380.37065891642);
MoveTo(-1178.32807624061 , -1341.63848818716);
LineTo(2400 , 1740);
MoveTo(-760 , 1380);
LineTo(-760 , 5062.29444609817);
MoveTo(-760 , 3992.57278145965);
LineTo(-760 , 6148.22401474636);
MoveTo(-760 , 2311.73076923077);
LineTo(-760 , 798.415106071581);
MoveTo(-4560 , -520);
LineTo(-5620 , 2760);
MoveTo(-5620 , 2760);
LineTo(-5090 , 1120);
MoveTo(-3200 , 2160);
LineTo(-1178.32807624061 , -1341.63848818716);
MoveTo(-2527.26083634201 , 994.781588302832);
LineTo(-3200 , 2160);
MoveTo(-2527.26083634201 , 994.781588302832);
LineTo(-1178.32807624061 , -1341.63848818716);
MoveTo(-5050 , 5950);
LineTo(-400 , 2580);
MoveTo(-5050 , 5950);
LineTo(-2725 , 4265);
End;
Run(Line_Plot);



 RE37:重なった直線の検出と処理   masafumi
Sat May 7 16:33:23 2011

またまた・・・「送信」ボタンを押さないとミスに気がつかない・・・。
まるでマーフィーの法則みたいですね。(^^;)

>約 1000 個の直線

約 10000個です。



 RE38:重なった直線の検出と処理    与太郎
Sun May 8 11:30:21 2011

RE35の自己レスです。

>ただ、最小値と最大値付近で余計な手間がかかってしまいますが。
とRE19で言及したのに、自分が書いたスクリプトではその部分をスルーしてました。
つまり、line[i]とline[j]を比べるときにline[i]の角度が180ー-AnglePrec〜180ーの間なら、
line[j]の角度は180ーを越えて0ー〜AnglePrecの間も比較対象になるということです。
line[]が角度でソートされてたらjを配列の最初の数字である1か-32768に戻すだけですが、
レイヤ>クラス>属性>角度の優先順位でソートしているのでjの値が単純には決まりません。

重複チェック手続きを呼び出すたびにline[i]の座標変換するのは処理速度の面では無駄です。
しかし処理速度に最適化すると、読みにくいスクリプトになる可能性があります。

masafumiさん、
>if nLine <= 2 then begin
>errMsg:= '線を2本以上選択してください!';
の部分は、図形を選択せずに実行するとエラーになるのに気付いて最期のほうで追加しました。
あんまり深く考えてなかったかも、です。


 RE39:重なった直線の検出と処理    与太郎
Tue May 10 11:34:05 2011

>masafumiさん
RE36のデータで実行結果がおかしくなるのは、
線の角度に180ー足したり引いたりしたときに、始点と終点の座標を入れ替えるのを忘れたせいです。
そのため、GetOverlap手続きが意図通りに動いていませんでした。
「近い角度どうしでしか比較しないので不要 」とコメントアウトした部分が、実は必要だったのです。

R38の、角度が180ー付近のときの処理は、LineType構造体に next :longint; を追加することで解決しました。
j:= j + 1; は、j:= line[j].next; に変えました。
関連して、重複チェック判定のIF文の、(line[i].attrs = line[j].attrs) は(消していませんが)不要になりました。
その他も色々直しています。
http://web.me.com/justlikeyoudo/vsfactory/samples/commands/check_overlap_line_2.htm


 RE40:重なった直線の検出と処理    ゴンスケ
Tue May 10 14:31:35 2011

経過報告。
与太郎さんの最新のものはまだ試していませんが、それ以前のものを書き換えながら
試行錯誤しています。必要な結果が得られる状態には、なっていません。
判定ルーチンを見直している状況です。
(しかし、スクリプトでやるにはタイムアウトになりそう、、、、、、。)


 RE41:重なった直線の検出と処理   masafumi
Tue May 10 19:38:28 2011

こんにちは与太郎さん。

修正後のスクリプト試してみました。クラス・レイヤ他ソートしている条件が同じ時はOKみたいです。
複数のクラス・レイヤ又はクラス・レイヤが同じでも属性が違うときはうまくいきません。
(これはまだでしたかな・・・?)


 RE42:重なった直線の検出と処理    与太郎
Wed May 11 11:25:35 2011

>masafumiさん
検証ありがとうございます。

初期状態では図形情報(レイヤ、クラス、線属性、名前、レコード)が欠落しないような設定なので、
レイヤ、クラス、線属性が異なる線どうしでは重複チェックをしません。
また、名前やレコードがある線は削除しません。
以下の定数、
  pUseLayer = true;{ レイヤ別にチェック }
  pUseClass = true;{ クラス別にチェック }
  pUseAttributes = true;{ 属性別にチェック }
  pNameCheck = true;{ 名前がある図形は削除しない }
  pRecordCheck = true;{ レコードがある図形は削除しない }
を全てFalseにすると一番緩い設定になり、端点の座標以外の情報を無視して処理します。
が、以上の仕様はまだ動作確認していません。


 RE43:重なった直線の検出と処理    与太郎
Thu May 12 11:12:21 2011

CheckOverlap手続きの、
while (i <> j) & (Abs(line[j].ang-line[i].ang) <= AnglePrec) & (line[i].attrs = line[j].attrs) do begin
から (line[i].h <> nil) を抜いたのは失敗でした。
このループの中で線を削除したら、すぐにループを抜け出さないといけないので、
(line[i].h <> nil) は必要でした。
条件の2番目に & (line[i].h <> nil) を付け加えておきます。
それから、line[]の配列範囲の計算方法を少し変えました。
http://web.me.com/justlikeyoudo/vsfactory/samples/commands/check_overlap_line_2a.htm


 RE44:重なった直線の検出と処理    与太郎
Sun May 15 13:13:06 2011

CheckOverlap手続きのwhileループの前の j:= i + 1; も、
j:= line[i].next; に直さないといけないですね。


 RE45:重なった直線の検出と処理    与太郎
Mon May 16 12:25:08 2011

直線の重なりをチェックするときに、
ある一点から直線までの距離(直線から基準点までの垂線の長さ)でソートしてもいいかも知れません。
線の角度が水平や垂直ばかりだったら、角度でソートする意味がないですから。

>masafumiさん
レイヤや属性を無視したときの実行結果がおかしいのは、それらの変数を初期化してなかったからです。
マニュアルのどこにも「変数の暗黙の初期値」の項目はないので、やはりPascalのお作法どおり変数の
初期化は必要みたいです。
http://web.me.com/justlikeyoudo/vsfactory/samples/commands/check_overlap_line_3b.htm


 RE46:重なった直線の検出と処理   masafumi
Tue May 17 0:12:12 2011

>直線の重なりをチェックするときに、
>ある一点から直線までの距離(直線から基準点までの垂線の長さ)でソートしてもいいかも知れません。

おもしろい発想ですね。

>線の角度が水平や垂直ばかりだったら、角度でソートする意味がないですから。

む〜ん、確かに・・・私の仕事(測量)では、こんな条件はほとんど有りませんので、思いつきもしませんでした。(^^;)

>レイヤや属性を無視したときの実行結果がおかしいのは、それらの変数を初期化してな かったからです。

初期化、やっぱ必要なんですねぇ・・・悩ましい・・・。



 RE47:重なった直線の検出と処理    与太郎
Wed May 18 13:40:36 2011

変数の初期値については、今までデバッグ画面で観察した限り、
ゼロ(or Nil or Nul文字)以外になっていたことは無いのですが、
もちろん巨大な配列などは全て確認したわけではありません。
構造体を含んだ構造体の大きな配列という特殊なケースだからかも知れませんが、
マニュアルに明記されてないので、それ以外なら大丈夫とも言い切れません。
基本的に、必要な初期化(初期値の代入)はゼロであっても省略しないのですが、
量が多いので誘惑に負けてしまいました。
ほんの数秒の実行時間を惜しんで、それ以上の時間をデバッグに費やしたという
おそまつ。

ところでmasafumiさん、
今まで扱った図面で、最大の直線数は何本くらいだったのでしょうか?


 RE48:重なった直線の検出と処理   masafumi
Wed May 18 23:02:26 2011

>今まで扱った図面で、最大の直線数は何本くらいだったのでしょうか?

これまでの最高は DWG の図面ですが約 17 万個の直線です。恐ろしく重複部分が有り ます。
角度も小数点以下 3 桁目で微妙に違っていたりするモノもあります。
当時(10年位前)にラスター → ベクター変換した図面を修復したもの考えられ、曲線らしく見える部分も細か
い直線の連続となっています。

実は今回これも VectorWorks に取り込んで選択個数を 65000 個以下にしたり、以上にしたり色々と試したのですが
正常に動いているのか、そうでないのか・・・実行しただけで検証する気力もなく、よくわかりませんでした。(笑)

下記にこの図面を置いておきます。宜しければダウンロードして試して見てください。
(所在や建物名等必要ないモノは削除しています)

http://www5c.biglobe.ne.jp/~masafumi/dwn.html


 RE49:重なった直線の検出と処理    与太郎
Fri May 20 9:52:10 2011

>masafumiさん
データの御提供ありがとうございました。

1次元配列のサイズ制限以上の大きなデータでも1度に処理出来るように改造していたら、
またまたバグを見付けてしまいました...

SortLines手続き内のGetPivotStr関数の
s:= Concat(s, Chr((Ord(Copy(s1, i, 1)) + Ord(Copy(s1, i, 1))) div 2)); ですが、
s2とするところがs1になっているので、結果はs1になってしまいます。
しかし、それでも問題ないみたいです。
実際にs1とs2の中間文字列になるように直したら、ソート中に配列範囲外へのアクセスが発生して止まります。
私が考えた文字列の比較方法が、VWが実際にやってる方法とは違ってるらしいです。
結局、元のデータがランダムに並んでいれば、leftとrightの間のどの値を使っても問題ないということです。
でも端っこのデータよりは真ん中へんのほうがいいと思うので、
pivot:= GetPivotStr(line[left].sSort, line[right].sSort); は、
pivot:= line[(left + right) div 2].sSort; に変更しました。
GetPivotStr関数は不要です。
http://web.me.com/justlikeyoudo/vsfactory/samples/commands/check_overlap_line_3c.htm


 RE50:重なった直線の検出と処理   masafumi
Fri May 20 21:07:24 2011

>データの御提供ありがとうございました。

どういたしまして、お役にたてば幸いです。

それにしても、処理速度が速いですね。
Windows7 i7CPU 2.8GHz メモリー4.0G のマシンで 54019 個の直線重複部分 30245 個を削除するのに 152.5 秒でした。
以前私が作った Script ですと約3倍の時間がかかりました。おそれいりました m(_ _)m


 RE51:重なった直線の検出と処理    与太郎
Sun May 22 15:57:24 2011

>以前私が作った Script ですと約3倍の時間がかかりました。
masafumiさんのスクリプトでは、同一の線と部分的に重なる線を別々に処理しているのに対して、
私のほうは完全重複と部分重複の区別はしていません。
また、masafumiさんのほうは他の種類の図形も処理する分、余計に時間がかかるのかも知れません。

ソート用の文字列を生成する箇所、
line[i].sSort:= Concat(GetAttrsStr(line[i].attrs), ExpString(concat(Round(a/AnglePrec)), 12));
は、以下のように角度を許容誤差より1桁多くしました。
line[i].sSort:= Concat(GetAttrsStr(line[i].attrs), ExpString(concat(Round(a/AnglePrec*10)), 12));
許容誤差と同じだとソート語でも許容誤差の範囲内で角度の順位が前後しているので、
比較する線の取りこぼしが起きます。実際は2倍でいいと思いますが、10倍にしました。
http://web.me.com/justlikeyoudo/vsfactory/samples/commands/check_overlap_line_3d.htm

下は配列を2次元配列にして、図形数の制限を無くしたものです。
http://web.me.com/justlikeyoudo/vsfactory/samples/commands/check_overlap_line_4.htm
くらいになっています。
masafumiさんのデータ(直線数:172109)では、1時間少々かかります。
(Core 2 Duo 1.6GHz/2GB ロゼッタ環境にて)


 RE52:重なった直線の検出と処理    与太郎
Fri May 27 13:35:34 2011

2次元配列版で、配列の最後の図形がスキップされてしまうバグを直しました。
実行時間も40分台に向上しています。Celeron 2.8GB/512MB だと20分以下でした。
http://web.me.com/justlikeyoudo/vsfactory/samples/commands/check_overlap_line_4a.htm

メモリの使用量を減らそうと、ソート用文字列をstring型からarray[1..64] of char に変更したら、
ソートの結果がめちゃくちゃになってしまいました。
char型配列ではstring型と違って大小の比較が出来ないみたいなので、一旦string型の変数にコピー
して比較しています。
http://web.me.com/justlikeyoudo/vsfactory/samples/commands/check_overlap_line_5.htm


 RE53:重なった直線の検出と処理   masafumi
Sun May 29 12:08:00 2011

>実行時間も40分台に向上しています。Celeron 2.8GB/512MB だと20分以下でした。

私の環境では 966 秒 (約 16 分)です。(^_^)v

リンク先に有るソースですが、一段落しましたらここへ貼り付けませんか?
少々の行数は大丈夫でしょう。
もし、数年後にリンクが途切れていたら、このスレは何を書いているのかわからなくなりそうです。
ご一考のほど、よろしくお願いします。



  RE54:重なった直線の検出と処理    与太郎
Tue May 31 13:13:12 2011

>リンク先に有るソースですが、一段落しましたらここへ貼り付けませんか?
>少々の行数は大丈夫でしょう。
バギーな初期のバージョンから数えて12本目最 新バージョンは600行を越えています。
こんなのを何個も貼っても大丈夫でしょうか。
コメントをスクリプトではなくここに書き込んだ結果、両方見ないとバージョン間の変更点が
自分でも判らないという状態に落ち入っています。
いっそHTMLファイルを管理人さんに預けてしまいましょうか。
とりあえず、最新版のアドレスを貼っておきます。
http://web.me.com/justlikeyoudo/vsfactory/samples/commands/check_overlap_line_6.htm

更なるメモリ節約のため、
属性を別の配列にして、線のデータに入れるのは属性の番号だけにしました。
これで直線1本当り80バイト近く減らせて(計算上は)66バイトになります。
直線ハンドルの配列は、属性の番号を追加したので1本当り6バイトです。
たとえ百万本のデータでも66MB+6MBで収まる計算です。
ただ、アクティビティモニタでスクリプト実行中のメモリ使用量を見ると、
変数確保よりも図形削除による(多分Undo処理のための)メモリの増加の方が遥かに多いので、
余計な心配かも知れません。
Undoと言えば、数千本削除した後のUndoなら少々待たされるくらいで済みますが、
9万本削除後のUndoは厳禁です。(メモリを4GB以上積んでたら大丈夫なのかも知れませ んが。)
実行前に必ず保存して、「取り消し」でなく「復帰」で元に戻せるようにしましょう。

データ構造が変わったので、処理の流れも変わっています。
最初にハンドルを取得する時に属性の番号を与え、属性別に本数をカウントします。
属性別の線の本数から線データ配列内での各属性の範囲が計算出来るので、
線データ配列にデータをコピーし終わった時点で、線データ配列は属性別にソートされています。
あとは属性別に角度でソートすることになります。
全てが同じ属性でない限り、ソートの範囲が狭くなるのでソート時間も短縮するはずです。
ただし属性の番号を決定するのに手間取ると、逆に時間がかかってしまいます。
レイヤ数や属性の種類が多いほど、ソート時間は短縮しますが、
1つのレイヤ内の属性の種類が多いと、属性番号を検索するのに時間がかかかって、
ソート時間の短縮が相殺される可能性もあります。
属性番号の検索は単純な線形探索です。

環境を変えて実行時間を計ってみました。
選択ソートに切り替える数は15、許容誤差は0.001、角度の許容誤差は0.001ーです。
結果:172109個中 93941個削除 0個削除不能
PPC G4 1.67GHz/1.5GB VW11.5 (t=1635sec.)
Core 2 Duo 1.4GHz/2GB VW11.5 (t=1805sec.)
Core 2 Duo 1.4GHz/2GB VW12.5 (t=1940sec.)
Core 2 Duo 1.4GHz/2GB VW2009 (t= 634sec.)
Core 2 Duo 1.4GHz/2GB VW2010 (t= 680sec.)
Core 2 Duo 1.4GHz/2GB VW2011 (t= 668sec.)
Celeron 2.8GHz/512MB VW11.5 (t= 739sec.)
(選択ソートに切り替える数を15→20に変えると、739sec.→933sec.になりました。)

最初の実行後、さらに実行させました。削除数は当然ゼロになります。
結果:78168個中 28個削除 0個削除不能
PPC G4 1.67GHz/1.5GB VW11.5 (t=666sec.)
Core 2 Duo 1.4GHz/2GB VW12.5 (t=755sec.)
Core 2 Duo 1.4GHz/2GB VW2010 (t=281sec.)
Celeron 2.8GHz/512MB VW11.5 (t=281sec.)
(3番目と4番目がt=281sec.なのは偶然です。)



Script談話室での提案    管理人
Tue May 31 14:00:17 2011 

与太郎さんから、膨大なScriptの扱いについてご提案がありました。
開発とは別の話題になるので、この喫茶室にて打ち合わせさせて下さい。

全く寄与していないのに、図々しい管理人の目論見は、ですね。
すっかり忘れていましたが、当クラブには連載コラムというコーナーがあり、
ここには為になるお話や素材が蓄えられています。

ゴンスケ殿の短い問いかけが、一ヶ月超の数十回のやり取りと開発ポイント、
惜しげも無く出る、山のような洞察とノウハウと実験を生み出しました。
Scriptがわからなくても、この一連の物語りは非常に貴重で教育的です。
ええと、単なる技術にとどまらない所が、管理人には魅力です。

どなたかが、以上!と宣言し、皆さんが賛同された時点で、連載コラムに入れます。

それまでは、管理人が最新バージョンのScriptをダウンロードできるように、
リンク先など書き込んで頂きますよう、お願いします。
開発途中のScriptは談話室に書き込まれた分量で十分と思います。
万人が付いてゆけるレベルではないので、最終版が参照できれば良いかと。
いかがでしょう?


Re2:Script談話室での提案   masafumi
Fri Jun 3 22:50:57 2011

インターネットの出来ない環境に出張していまして、レスが遅くなりました。

管理人さん、ご提案ありがとうございます。私も最新版で十分だと思います。

VectorScript に限りませんが、探していた情報が得られると思っていた先がリンク切れで気落ちした
経験が何度も有ります。この場所で完結出来るのが理想的かな・・・っと考えた次第です。

よろしくお願いします。


Re3:Script談話室での提案    与太郎
Sat Jun 4 10:25:45 2011

管理人さん、ありがとうございます。
面倒でしょうが宜しくお願いします。
動作確認していたら、返事が遅くなってしまいました。
修正すべき点があるのですが、簡単な方法が見付かりません。
とりあえず今までの分は、
http://web.me.com/justlikeyoudo/vsfactory/commands.zip
でダウンロード出来ます。


RE55:重なった直線の検出と処理    管理人
Thu Jun 9 7:07:59 2011
このテーマ、連載コラムにまとめました。
作成過程のScriptもご覧頂ける様にして下さいましたので、
是非ご一読下さい。ノウハウ満載の大作です。
参加された猛者連に改めて感謝!
ありがとうございます。


RE56:重なった直線の検出と処理    ゴンスケ
Thu Jun 9 17:41:12 2011
言い出しっぺなので、「これをもって終息!」。
喫茶室にも書きましたが、皆さまありがとうございました。

RE57:重なった直線の検出と処理    与太郎
Thu Jun 9 22:16:28 2011
ゴンスケさん、すいません。
しつこい!って言われそうですが、続きです。
バグが2つありました。

1つ目は直線の重複チェックをするサブルーチンのバグで、
角度の許容誤差が大きくすると、重ならない線でも重なっていると判定するケースがあります。
曲線を直線に分解したようなデータだと、頂点が間引かれた状態になる可能性もあるので、
放っておくわけにはいきません。

重複チェックの考え方は、
http://web.me.com/justlikeyoudo/vsfactory/samples/commands/method.htm

修正したスクリプトは、
http://web.me.com/justlikeyoudo/vsfactory/samples/commands/check_overlap_line_3e.htm
http://web.me.com/justlikeyoudo/vsfactory/samples/commands/check_overlap_line_6a.htm
です。

もうひとつは合成した直線の角度が変わるときの問題です。
完全一致でなく一部が重なっている場合は、合成した直線の角度が元の直線とは変わることがあります。
そのときは角度でソートされた配列内での位置も変えないと、重なっているはずの線がチェックする角度
の範囲から外れてしまい、チェック漏れが生じます。
これも直したいのですが、
たとえ極狭い範囲だとしても配列をソートし直すのは面倒だし、forループも使えなくなります。
こちらも単純な解決法があればいいんですけどね。

RE58:重なった直線の検出と処理    ゴンスケ
Tue Jun 14 9:34:16 2011
与太郎さん、どうも!
図解がとても分かりやすいです!

業務連絡    管理人
Fri Jun 17 14:50:06 2011
与太郎さんの御依頼で書き込み修正しました。
お手数ですが、凄い展開なので、引き続き、よろしくお願いいたします。

Re:業務連絡    与太郎
Fri Jun 17 15:55:58 2011
>管理人さん
ありがとうございました。

RE59:重なった直線の検出と処理    与太郎
Fri Jun 17 15:58:13 2011
その場しのぎで最適化してきたため、改造するのが面倒になってきました。
ここらで一度、最初から整理してみたいと思います。

直線の重複チェックの処理は、
2本の直線を重複チェックするサブルーチンと、そのサブルーチンを呼び出す部分から成ります。
仮に重複チェックのサブルーチンをCheck手続きとしておきます。
この手続きは、直線データの配列の番号を2つ受け取り、重なっているかチェックして、
重なっていれば直線を合成し、不要な線を削除します。

直線データの配列変数lineのデータ型は、下のような構造体です。

LineType = structure
   ang :real;
   ptSt, ptEd :vector;
   h :handle;
end;

angは、0〜180°の範囲に調整した直線の角度です。
ptStとptEdは、直線の端点の座標です。
hは、直線図形のハンドルです。直線を削除したらnilを入れます。
ang, ptSt, ptEdは、ループ内で何度も情報を取得する無駄を省くための項目です。

Check手続きを呼び出す部分は、一番単純な方法では2重ループで全ての組合わせを実行します。
配列の範囲が[1..n]とすると、スクリプトは下のようになります。
話を単純にするため、線の属性や配列サイズの制限は無視しています。

for i:= 1 to n-1 do begin
   if line[i].h <> nil then begin
      for j:= i+1 to n do begin
         if line[j].h <> nil then begin
            Check(i, j); { 重複チェック処理 }
         end;
      ebd;
   end;
end;

線が少ないときはこれで問題無いのですが、何千本何万本とある場合は時間がかかり過ぎるので、
最初から必要が無い比較は行わないように工夫します。
たとえば、角度が大きく違う直線同士は重ならないと考えて間違いないでしょう。
逆に言えば、角度が近いものだけ比較すれば良いことになります。
そのための方法は、直線の配列を角度順に並べ換えることです。
スクリプトの高速化と単純化のため、構造体LineTypeにnextという項目を追加します。

LineType = structure
   ang :real;
   ptSt, ptEd :vector;
   h :handle;
   next :longint;
end;

nextには次のデータの番号(配列の添字)が入ります。line[i].next = i+1 です。
ただし最後だけ line[n].next = 1 とすることで、スクリプトを簡単にする効果があります。
つまり、次のデータの番号を j:= j + 1; で計算すると、最後のデータでjが配列の範囲外になるため
if n < j then j:= 1; で最初に戻す必要がありますが、j:= line[j].next; だと勝手に戻ります。
その代償は余分なメモリと余分な前処理のサブルーチンですが、それだけの価値はあります。

AngPrecを角度の許容誤差とすれば、角度でソート済みの配列に対しての処理は下のようになります。

for i:= 1 to n do begin
   if line[i].h <> nil then begin
      j:= i + 1;
      while (line[j] <> nil) & (i <> j) & (Abs(line[j].ang - line[i].ang) <= AngPrec) do begin
         Check(i, j); { 重複チェック処理 }
         j:= line[j].next;
      end;
   end;
end;

外側のforループは一本分だけ増えます。
内側のwhileループの条件判定で、角度の差がAngPrecより大きくなったらループを終了してcheck手続き
の実行回数を減らすことで、実行時間を短縮しています。

ここまでが現在の状況です。
これからの課題は、線を合成して角度が変わってしまったときの対処法です。
このままでは、線が重なっているのにチェックされないケースが生じます。

RE60:重なった直線の検出と処理    与太郎
Mon Jun 20 13:58:46 2011
Ver.3eとVer.6aのGetUnion手続きが間違っていました。
改造時にバグが紛れ込ませたようです。
pt31とpt32を計算しないといけないのに両方ともpt31になっていて、
pt32は常に(0, 0, 0)を返していました。

procedure GetUnion(pt11, pt12, pt21, pt22:vector; var pt31, pt32:vector);
{ pt11〜pt12とpt21〜pt22の両方の直線を合成して返す。 }
begin
__pt31:= If_V(pt11.x < pt21.x, pt11, pt21);
__pt32:= If_V(pt12.x < pt22.x, pt22, pt12);
end;{GetUnion}

http://web.me.com/justlikeyoudo/vsfactory/samples/commands/check_overlap_line_3f.htm
http://web.me.com/justlikeyoudo/vsfactory/samples/commands/check_overlap_line_6b.htm

RE61:重なった直線の検出と処理    与太郎
Thu Jun 23 11:08:00 2011
RE:59の続きです。
最後のスクリプトの3行目の j:= i + 1; は j:= line[i].next; が正しいので、下のように
なります。

for i:= 1 to n do begin
  if line[i].h <> nil then begin
    j:= line[i].next; {j:= i + 1;}
    while (line[j] <> nil) & (i <> j) & (Abs(line[j].ang - line[i].ang) <= AngPrec) do begin
      Check(i, j); { 重複チェック処理 }
      j:= line[j].next; { j:= i + 1; }
    end;
  end;
end;

いきなりですが、ここからはポインタのおはなしです。
CやPascalの変数型には、変数の位置を表すポインタ型があります。
ポインタ型は、たいていは変数のメモリアドレスで、内部的には長整数型です。
元々CPUの動作にメモリアドレスは欠かせません。
マシン語や、それを読みやすく記述したアセンブリ言語でもそれは変わりません。
しかしメモリアドレスの計算は面倒だし、実行時でないと決まらないことも多いので、
メモリアドレスに名前を付けて、アドレス計算はコンピュータに任せることにしました。
これが変数の始まりです。
変数の割当て(CPU内部のレジスタかメインメモリか)や、ループや分岐のラベル生成を
自動的にやってくれれば、それはもう立派な高級言語です。
というわけで、高級言語ではメモリアドレスなどは考える必要はなくなったはずでした。
しかし「変数の位置」はプログラムに有用なこともあって、CやPascalではポインタ型が
導入されています。
ただしPascalでは「変数の位置」は隠蔽されていて、ポインタの値は不明です。
可能な演算も比較と代入のみです。
参照先のの変数型が違うポインタ同士は違う変数型になるので、演算は許されません。
プログラミングの自由度や実行速度が優先のC言語では、ポインタは参照先の変数型と関係
ないメモリアドレスで、長整数型と同等として扱われるので演算にも制限はありません。
そのためポインタを使えば何でも出来るという反面、思わぬ落とし穴もあります。

VectorScriptはPascal準拠のスクリプト言語ですが、ポインタ型はありません。
前身のMiniPascal開発時に、マクロ(スクリプト)言語へのポインタ型導入はメリットより
デメリットのほうが大きいと判断されてしまったのでしょう。
VectorScriptのハンドル型の実体はポインタそのものですが、対象は図形とリソースのデー
タに限定されています。
(ハンドル変数への演算もPascalのポインタ同様、比較と代入以外は許されていません。)
だからといって、VectorScriptで変数へのポインタを使ったスクリプトが書けないわけでは
ありません。
MiniPascalの開発者からは否定されましたが、当時はデバッガもないので無理ありません。
しかし今では(非力ながら)デバッガのおかげで、実行中の変数の値を確認出来ます。
よほど複雑怪奇なことをでなければ、ポインタを使ったスクリプトも可能でしょう。
実際、LineType構造体のnext項目のデータはメモリアドレスではなく配列内の番号ですが、
ポインタとして機能します。
元々Pascalのポインタは、メモリアドレスを指すと決まっているわけではなく、そうなって
いるのはコンパイラ実装の都合に過ぎません。
変数を番号で管理しても構わないのです。
というわけで、line変数は外側のforループでは配列として、内側のwhileループではポイン
タで連結された循環リストとして扱っています。

ところで、合成後の角度が変わらない場合でも、データの順番によっては重複チェックの漏
れが起こります。
たとえば、1本の線を3分割してA, B, C とした場合、AとB、またはBとCは繋がりま
すが、AとCは離れているので繋がりません。
もしもA, C, Bの順になっていたら、
まず、line[i]=A, line[j]=Cでは重複はしません。
次の、line[i]=A, line[j]=BでAとBが合成されてAに反映され、Bが削除されます。
そうするとこの時点でCは合成後のAと比較される機会が無くなります。
元のデータは順番通り並んでいても、ソート後はどんな順番になっているか判りません。
そういう意味では、line[i]を削除してline[j]を変形したほうが良かったのです。
あくまでも「合成後に角度が変わらない場合は」ですが。

しかし合成して角度が変わると、直線が角度順に並んでいるという前提が崩れてしまいます。
どちらを削除してどちらを変形するという問題だけではなくなります。
それでは配列のそのデータの付近だけでも再ソートするとどうなるでしょうか。
ちょっと考えても、チェック済みと未チェックの直線がごっちゃになってしまいそうです。
最悪は、iループでチェック済みの直線を何度もチェックするということになりそうです。
そもそも、forループでは出来そうもありません。
外側のiループでは全ての直線を重複や漏れなくチェックしたいので、出来るなら単純なfor
ループでやりたいです。
となると、配列の再ソートは出来ません。

で。よく考えたら外側のiループは角度順になっている必要はないのでした。
角度順で処理したいのは内側のjループのほうです。
だから配列のほうは放っておいて構わないということです。
では、内側のjループのほうは、対処法はふたつ考えられます。
1つ目の方法は、角度の許容誤差より広い範囲の角度までチェックすることです。
具体的には、AngPrecの値を大きめに設定します。
合成後の角度がよほど違わない限り、これで大丈夫だと思います。
余計な角度チェックの分だけ実行時間は増えますが、楽な方法です。
もうひとつは、nextの値を変えて、循環リストの順番を角度順に修正する方法です。
後者が正しいやり方だとは思いますが、どちらが速いのか確信は持てません。

どちらにしても、nextの他にprevという項目も付け加えて、line[i]に対して角度の増加側
と減少側の両方をチェックしたほうが良いのは確かです。
また、合成後の角度が変わったことを表す変数changeを追加して、角度が変わったらループ
を終了して最初からやり直すように変更します。
直線の削除と合成、循環ループの修正などの処理は、Check手続きの中で行います。

for i:= 1 to n do begin
  if line[i].h <> nil then begin
    change:= true;
    while change do begin
      change:= false;
      j:= line[i].next;
      while (i <> j) & (Abs(line[j].ang - line[i].ang) <= AngPrec) & (not change) do begin
        Check(i, j, change); { 重複チェック処理 }
        j:= line[j].next;
      end;
      if not change then begin
        j:= line[i].prev;
        while (i <> j) & (Abs(line[j].ang - line[i].ang) <= AngPrec) & (not change) do begin
          Check(i, j, change); { 重複チェック処理 }
          j:= line[j].prev;
        end;
      end;
    end;
  end;
end;

削除したデータはnext, prevの値を変えて循環リストから取り除けばいいので、whileの条件
の「line[j] <> nil(本当はline[j].h <> nil)」は消しました。

RE62:重なった直線の検出と処理    与太郎
Thu Jul 7 12:41:03 2011
line[j]の直線を削除する手順を考えます。
j = 10 のとき、前後のデータが以下のようになっていたと仮定します。

line[ 8].next =  9  line[ 8].prev =  7
line[ 9].next = 10  line[ 9].prev =  8
line[10].next = 11  line[10].prev =  9
line[11].next = 12  line[11].prev = 10
line[12].next = 13  line[12].prev = 11

nextは順方向リンクのポインタ、prexは逆方向リンクのポインタです。
ここからline[j](line[10])の線を削除する手順は、
DelObj(line[j].h); line[j].h:= nil;
となります。
循環リストからline[10]を取り除くには、
line[9].nextとline[11].prevの値を変えて下のようにします。

line[ 8].next =  9  line[ 8].prev =  7
line[ 9].next = 11  line[ 9].prev =  8
line[10].next =(11)  line[10].prev = (9) {削除データ}
line[11].next = 12  line[11].prev =  9
line[12].next = 13  line[12].prev = 11

これで順方向、逆方向ともにline[10]のデータはスキップされるので、
配列の再ソートやif文などは不要になります。
間違えてline[10]にアクセスしても処理を続けられるように、
line[10].nextとline[10].prevはゼロクリアはしないで、そのままにしておきます。

具体的には以下のようなスクリプトになります。

prv:= line[j].prev; {prv = 9}
nxt:= line[j].next; {nxt = 11}
line[prv].next:= nxt; {line[9].next = 11}
line[nxt].prev:= prv; {line[11].prev = 9}

上記の処理は、全てCheck手続きの中で行います。
以下は、line[i]に対して、角度の増加方向と減少方向の両方をチェックするスクリプトです。
line[i]の角度が変化したときは最初からやり直しますが、リストの順番は変えません。
重複チェックの取りこぼしには、角度の許容誤差を大きめにして対処します。
http://web.me.com/justlikeyoudo/vsfactory/samples/commands/check_overlap_line_3g.htm

2次元配列版はバグ取り中です。

RE63:重なった直線の検出と処理    与太郎
Mon Jul 11 11:15:25 2011
2次元配列では添字は2つで1組なので、まとめて構造体にします。
そのほうが代入文が1つで済むからです。
しかし配列にアクセスするには、やはり line[index.H, index.L] のように書く必要があり
ます。
Change手続きの中にはline[i.H, i.L]とline[j.H, j.L]が何度も出てくるので、
var lnI, lnJ で変数パラメータにすれば簡潔だし、配列の添字の書き間違いもなく無くな
ると考えました。
ところが実行すると、エラーでVWが終了してしまうのです。
コンパイルは出来ても実行時にエラーが出ることが、VectorScriptではたまにあります。
デバッグ・モードで実行してもVWが突然落ちてしまうので、問題箇所を特定するのが一
苦労です。
ブレークポイントを変えながら何度もVWの再起動を繰り返して、Check手続きの中に該
当箇所を見つけました。
それは、nxt:= lnJ.next; と prv:= lnJ.prev; の2文でした。
以前は nxt:= line[j.H, j.L].next; prv:= line[j.H, j.L].prev; のように書いていましたが、
[ ]の中に j を2つ書くのを嫌って直した部分です。
他にもline[j.H, j.L]をlnJに書き換えた所はあるのに、何故そこだけが問題なのか、
本当のところはは分かりませんが、
多分それが構造体の中の構造体だということと関係はあるのでしょう。
ネイティブ・コンパイラなら問題無い方法だと思いますが、VectorScriptは中間コードに
変換する方式のはずなので、その辺の制限があるのでしょう。
ここでは原因は追求せず、対処療法にとどめておきます。
エラー回避の方法は2つあります。
1つ目は、nextとprevを一度に代入せずに、nxt.H:= lnJ.next.H; nxt.L:= inJ.next.L; と、
メンバ単位で代入する方法。
2つ目は、修正前の nxt:= line[j.H, j.L].next; prv:= line[j.H, j.L].prev; です。
せっかく定義した変数パラメータlnI, lnJを使わないのはもったいないのですが、結局は
命令数が2つで済む2つ目の方法を採りました。
http://web.me.com/justlikeyoudo/vsfactory/samples/commands/check_overlap_line_6c.htm

前回までは SbscriptType のメンバ名は up, lw でしたが、今回 H, L に変更しました。
upに対応するのはdown、lowに対応するのはhighなので、以前から直したいと思ってい
たところです。
高次(H)と低次(L)のほうが意味が合っています。

おしまい。