procedure XXX_3f;
{ 選択した線の重複をチェックして、不要な線を削除します。 }
{ 部分的に重なっている線も１本にまとめます。 }
{ 2011/05/06 与太郎 }
{ 2011/05/08 修正 (2) }
{ 2011/05/12 修正 (2a) }
{ 2011/05/13 修正 (3) }
{ 2011/05/15 修正 (3a) }
{ 2011/05/15 修正 (3b) }
{ 2011/05/20 修正 (3c) }
{ 2011/05/22 修正 (3d) }
{ 2011/05/22 修正 (4) ２次元配列版 }
{ 2011/05/26 修正 (4a) ２次元配列版 }
{ 2011/05/26 修正 (5) ２次元配列版（メモリ節約） }
{ 2011/05/29 修正 (5a) ２次元配列版（メモリ節約） }
{ 2011/05/30 修正 (6) 属性をテーブル化 }
{ 2011/06/09 修正 (3e) IsOverlapped手続きの修正 }
{ 2011/06/09 修正 (6a) IsOverlapped手続きの修正 }
{ 2011/06/20 修正 (3f) GetUnion手続きの修正 }
{$ DEBUG}
label
	9999;
const
	{ プラグイン用パラメータ }
	pUseLayer = true;	{ レイヤ別にチェック }
	pUseClass = true;	{ クラス別にチェック }
	pUseAttributes = true;	{ 属性別にチェック }
	pNameCheck = true;	{ 名前がある図形は削除しない }
	pRecordCheck = true;	{ レコードがある図形は削除しない }
	pPrecision = 0.001;	{ 許容誤差 }
	pDebug = true;			{ デバッグのためにソート用文字列を書き出す }
	
	AnglePrec = 0.001;{by degree　検索する角度の許容誤差 }
	ArrayBottom = -32768;
	ArrayTop = 32767;
	MinQSNum = 23;{ クイックソート／選択ソートの境界数 }
	SortKey = 1;
	MsgStep = 200;
	MsgStep2 = 10;
	LineObj = 2;
	SelectedObjects = 2;
	TraverseShallow = 0;
	EditableLayers = 4;
	
type
	AttributeType = structure
		hLyr	:handle;
		hCls	:handle;
		lnWd, lnPat, lnFCol, lnBCol	:integer;
	end;{AttributeType}
	
	LineType = structure
		sSort	:string;{ ソート用文字列。優先度：レイヤ＞クラス＞属性＞角度 }
		ptSt, ptEd	:vector;
		ang	:real;
		attrs	:AttributeType;
		h	:handle;
		next	:longint;{ レイヤ、クラス、属性が等しい次のデータのID }
	end;{LineType}
	
var
	iLine, nLine, btmLine, topLine, iMsg, nDel, nUnDel	:longint;
	nMatch, nOverlap	:longint;
	hLn	:dynArray[] of handle;
	line	:dynarray[] of LineType;
	quit	:boolean;
	errMsg	:string;
	t, t0	:longint;
	
{SubRoutins}
	function If_H(condition:boolean; dtTrue, dtFalse:handle):handle;
	{ IF関数（ハンドル） }
	begin
		if condition then
			If_H:= dtTrue
		else
			If_H:= dtFalse;
	end;{If_H}
	
	function If_S(condition:boolean; dtTrue, dtFalse:string):string;
	{ IF関数（文字列） }
	begin
		if condition then
			If_S:= dtTrue
		else
			If_S:= dtFalse;
	end;{If_S}
	
	function If_L(condition:boolean; dtTrue, dtFalse:longint):longint;
	{ IF関数（長整数） }
	begin
		if condition then
			If_L:= dtTrue
		else
			If_L:= dtFalse;
	end;{If_L}
	
	function If_R(condition:boolean; dtTrue, dtFalse:real):real;
	{ IF関数（実数） }
	begin
		if condition then
			If_R:= dtTrue
		else
			If_R:= dtFalse;
	end;{If_R}
	
	function If_V(condition:boolean; dtTrue, dtFalse:vector):vector;
	{ IF関数（ベクトル） }
	begin
		if condition then
			If_V:= dtTrue
		else
			If_V:= dtFalse;
	end;{If_V}
	
	function XY2Vec(x, y:real):vector;
	{ ベクトルを返す。 }
	begin
		XY2Vec.x:= x; XY2Vec.y:= y;
	end;{XY2Vec}
	
	function AddLine(h:handle):boolean;
	{ 線のハンドルを配列に追加する。 }
	var
		err	:boolean;
	begin
		err:= false;
		if GetType(h) = LineObj then begin
			if iLine < ArrayTop then begin
				iLine:= iLine + 1;
				hLn[iLine]:= h;
			end{if}
			else begin
				err:= true;
				errMsg:= Concat('線が', ArrayTop-ArrayBottom+1, '本以上あります');
				quit:= not YNDialog(Concat(errMsg, '。', Chr(13), '処理を続けますか？'));
				if quit then
					errMsg:= Concat(errMsg, 'ので、中止しました。')
				else
					errMsg:= Concat(errMsg, 'が、処理を続けました。');
			end;{else}
			iMsg:= iMsg + 1;
			if MsgStep <= iMsg then begin
				Message('線を取得中：', iLine-ArrayBottom+1);
				iMsg:= 0;
			end;{if}
		end;{if}
		AddLine:= err;	{ trueならForEachObjectXXXループを終了する。 }
	end;{AddLine}
	
	procedure GetAttributes(h:handle; var attrs:AttributeType);
	{ 属性を返す。 }
	var
		r, g, b	:longint;
	begin
			attrs.hLyr:= If_H(pUseLayer, GetLayer(h), nil);
			attrs.hCls:= If_H(pUseClass, GetObject(GetClass(h)), nil);
			if pUseAttributes then begin
				attrs.lnWd:= GetLW(h);
				attrs.lnPat:= GetLS(h);
				GetPenFore(h, r, g, b); RGBToColorIndex(r, g, b, attrs.lnFCol);
				GetPenBack(h, r, g, b); RGBToColorIndex(r, g, b, attrs.lnBCol);
			end
			else begin
				attrs.lnWd:= 0;
				attrs.lnPat:= 0;
				attrs.lnFCol:= 0;
				attrs.lnBCol:= 0;
			end;
	end;{GetAttributes}
	
	function ExpString(s:string; digit:integer):string;
	{ 指定した文字数になるように左端に空白を付ける。 }
	begin
		while Len(s) < digit do
			s:= Concat(' ', s);
		ExpString:= s;
	end;{ExpString}
	
	function GetAttrsStr(attrs:AttributeType):string;
	{ 属性を文字列にする。 }
	var
		s	:string;
	begin
		s:= '';
		if pUseLayer then
			s:= Concat(s, ExpString(Concat(attrs.hLyr), 10));
		if pUseClass then
			s:= Concat(s, ExpString(Concat(attrs.hCls), 10));
		if pUseAttributes then begin
			s:= Concat(s, ExpString(Concat(attrs.lnWd), 4));
			s:= Concat(s, ExpString(Concat(attrs.lnPat), 4));
			s:= Concat(s, ExpString(Concat(attrs.lnFCol), 4));
			s:= Concat(s, ExpString(Concat(attrs.lnBCol), 4));
		end;{if}
		GetAttrsStr:= s;
	end;{GetAttrsStr}
	
	procedure Swap_V(var dt1, dt2:vector);
	{ ベクトル型変数の値を交換する。 }
	var
		tmp	:vector;
	begin
		tmp:= dt1;
		dt1:= dt2;
		dt2:= tmp;
	end;{Swap_V}
	
	procedure CreateLineTable;
	{ 線テーブルを作成する。 }
	var
		i	:longint;
		a	:real;
		h	:handle;
		rvs	:boolean;
	begin
		iMsg:= 0; Message('線情報を取得中：0 / ', nLine);
		for i:= btmLine to topLine do begin
			h:= hLn[ArrayBottom - btmLine + i];
			line[i].h:= h;
			GetSegPt1(h, line[i].ptSt.x, line[i].ptSt.y);
			GetSegPt2(h, line[i].ptEd.x, line[i].ptEd.y);
			a:= Vec2Ang(line[i].ptEd - line[i].ptSt);
			rvs:= true;
			if a < 0 then
				a:= a + 180
			else if 180 <= a then
				a:= a - 180
			else
				rvs:= false;
			if rvs then Swap_V(line[i].ptSt, line[i].ptEd);
			line[i].ang:= a;
			GetAttributes(h, line[i].attrs);
			line[i].sSort:= Concat(GetAttrsStr(line[i].attrs), ExpString(concat(Round(a/AnglePrec*10)), 12));
			iMsg:= iMsg + 1;
			if MsgStep <= iMsg then begin
				Message('線情報を取得中：', i-btmLine+1, ' / ', nLine);
				iMsg:= 0;
			end;{if}
		end;{for}
	end;{CreateLineTable}
	
	function Small_L(i, j:longint):longint;
	{ 小さいほうの数字を返す。 }
	begin
		if i < j then
			Small_L:= i
		else
			Small_L:= j;
	end;{Small_L}
	
	procedure SortLines(left, right:longint);
	{  線の配列をソートする。}
	var
		i, j	:Longint;
		pivot	:string;
		tmp	:LineType;
		
		procedure Sort2(st, ed:longint);
		{ 選択ソート（数が少ない場合） }
		var
			i, j, max	:longint;
			tmp	:LineType;
		begin
			{選択ソート}
			for i:= ed downto st+1 do begin
				max:= st;
				for j:= st+1 to i do begin
					if line[max].sSort < line[j].sSort then
						max:= j;
				end;{for}
				if i <> max then begin
					tmp:= line[i];
					line[i]:= line[max];
					line[max]:= tmp;
				end;
			end;{for}
		end;{Sort2}
		
	begin{SortLines}
		Message('直線をソート中！ ', left-ArrayBottom+1, ' / ', nLine);
		if (right - left) <= MinQSNum then begin
			Sort2(left, right);
		end
		else begin
			pivot:= line[(left + right) div 2].sSort;
			i:= left;
			j:= right;
			repeat
				while (line[i].sSort < pivot) do i:= i + 1;
				while (line[j].sSort > pivot) do j:= j - 1;
				if (i <= j) then begin
					tmp:=line[i];
					line[i]:=line[j];
					line[j]:=tmp;
					i:= i+1;
					j:= j-1;
				end;{if}
			until (i > j);
			SortLines(left, j);
			SortLines(i, right);
		end;{else}
{		Message('直線をソート中！ ', right-ArrayBottom+1, ' / ', nLine);	}
	end;{SortLines}
	
	procedure SetNextID;
	{ line[]のnextの値を設定します。 }
	var
		i, bs	:longint;
	begin
		bs:= btmLine;
		for i:= btmLine to topLine - 1 do begin
			if line[i].attrs = line[i+1].attrs then begin
				line[i].next:= i + 1;
			end
			else begin
				line[i].next:= bs;
				bs:= i + 1;
			end;
		end;{for}
		line[topLine].next:= If_L(line[topLine-1].attrs = line[topLine].attrs, bs, topLine);
	end;{SetNextID}
	
	function IsOverlapped(x12:real; pt21, pt22:vector; prec:real; var pt31, pt32:vector):boolean;
	{ ２本の直線が重なっていたらTrueを返す。pt31とpt32には合成した線の座標が入る。 }
	{ (0, 0)～(x12, 0)が線１、pt21～pt22が線２である。 }
	var
		result	:boolean;
		pt1, pt2	:vector;
		y1, y2, d1, d2	:real;
		
		procedure GetOverlap(pt11, pt12, pt21, pt22:vector; var pt31, pt32:vector);
		{ pt11～pt12とpt21～pt22の重なる範囲を返す。 }
		var
			tmp	:real;
		begin
			pt31:= If_V(pt11.x <= pt21.x, pt21, pt11);
			pt32:= If_V(pt12.x <= pt22.x, pt12, pt22);
		end;{GetOverlap}
		
		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}
		
	begin{IsOverlapped}
		if ((pt21.x < -prec) & (pt22.x < -prec)) | (((x12+prec) < pt21.x) & ((x12+prec) < pt22.x)) then begin
			result:= false;
		end{if}
		else begin
			GetUnion(XY2Vec(0, 0), XY2Vec(X12, 0), pt21, pt22, pt31, pt32);
			GetOverlap(XY2Vec(0, 0), XY2Vec(X12, 0), pt21, pt22, pt1, pt2);
			y1:= pt31.y + (pt1.x - pt31.x) / (pt32.x - pt31.x) * (pt32.y - pt31.y);
			y2:= pt31.y + (pt2.x - pt31.x) / (pt32.x - pt31.x) * (pt32.y - pt31.y);
			result:= (Abs(pt1.y - y1) < prec) & (Abs(pt2.y - y2) < prec);
		end;{else}
		IsOverlapped:= result;
	end;{IsOverlapped}
	
	procedure CheckOverlap;
	{ 線の重なりをチェックして不要な線を消します。 }
	var
		i, j, iDel, iChg	:longint;
		pt11, pt12, pt21, pt22, pt1, pt2	:vector;
		pt11R, pt12R, pt21R, pt22R, pt1R, pt2R	:vector;{ 回転後の座標（pt11ベース） }
		rot	:real;
		nm1, nm2	:string;
		result	:boolean;
	begin
		if pDebug then begin
			{ ソート用文字列の書き出し }
			Message('ソート用文字列を書き出し中...');
			for i:= btmLine to topLine do begin	
				write(i:8, ':', line[i].sSort, ' :', line[i].next);
				if (i < topLine) & (line[i+1].sSort < line[i].sSort) then
					Write(' Sort Error!');
				WriteLn;
			end;
		end;{if}
		iMsg:= 0; Message('線の重複チェック中：0 / ', nLine);
		nDel:= 0; nUnDel:= 0;
		pt11R:= XY2Vec(0, 0); pt12R.y:= 0;
		for i:= btmLine to topLine - 1 do begin
			iMsg:= iMsg + 1;
			if MsgStep2 <= iMsg then begin
				Message('線の重複チェック中：', i-btmLine+1, ' / ', nLine, ' Del=', nDel, ' (Ang=',line[i].ang, ')');
				iMsg:= 0;
			end;{if}
			if line[i].h <> nil then begin
				{ line[i]が水平になるように座標変換 }
				pt11:= line[i].ptSt; 
				pt12:= line[i].ptEd; pt12R.x:= Norm(pt12-pt11);
				rot:= line[i].ang;
				j:= line[i].next;
				while (i <> j) & (line[i].h <> nil) & (Abs(line[j].ang-line[i].ang) <= AnglePrec) do begin
					if (line[j].h <> nil) then begin
						pt21:= line[j].ptSt; pt22:= line[j].ptEd;
						if (Norm(pt21 + pt22 - pt11 - pt12) < (Norm(pt22 - pt21) + Norm(pt12 - pt11) + 4*pPrecision)) then begin
							pt21R:= Ang2Vec(Vec2Ang(pt21-pt11) - rot, Norm(pt21-pt11));
							pt22R:= Ang2Vec(Vec2Ang(pt22-pt11) - rot, Norm(pt22-pt11));
							if IsOverlapped(pt12R.x, pt21R, pt22R, pPrecision, pt1R, pt2R) then begin
								pt1:= If_V(Norm(pt1R-pt11R) < Norm(pt1R-pt21R), pt11, pt21);
								pt2:= If_V(Norm(pt2R-pt12R) < Norm(pt2R-pt22R), pt12, pt22);
								iDel:= i; iChg:= j;{ Default }
								result:= true;
								if pNameCheck then begin
									nm1:= GetName(line[i].h); if nm1 = 'none' then nm1:= '';
									if nm1 <> '' then begin
										nm2:= GetName(line[j].h); if nm1 = 'none' then nm2:= '';
										if nm2 = '' then begin
											iDel:= j; iChg:= i;
										end
										else begin
											result:= false;
										end;
									end;{else}
								end;{if}
								if result & pRecordCheck then begin
									if NumRecords(line[i].h) <> 0 then begin
										if NumRecords(line[j].h) = 0 then begin
											iDel:= j; iChg:= i;
										end
										else begin
											result:= false;
										end;
									end;
								end;{if}
								if result then begin
									nDel:= nDel + 1;
									DelObject(line[iDel].h); line[iDel].h:= nil;
									line[iChg].ptSt:= pt1; line[iChg].ptEd:= pt2;
									SetSegPt1(line[iChg].h, pt1.x, pt1.y);
									SetSegPt2(line[iChg].h, pt2.x, pt2.y);
									if i = iChg then begin
										pt11:= pt1; 
										pt12:= pt2; pt12R.x:= Norm(pt12 - pt11);
									end;
								end{if}
								else begin
									nUnDel:= nUnDel + 1;
								end;{else}
							end;{if}
						end;{if}
					end;{if}
					j:= line[j].next;
				end;{while}
			end;{if}
		end;{for}
	end;{CheckOverlap}
	
begin{main}
	t0:= GetTickCount;
	quit:= false; errMsg:= '';
	iLine:= ArrayBottom - 1;
	Allocate hLn[ArrayBottom..ArrayTop];
	iMsg:= 0; Message('線を取得中：');
	ForEachObjectInLayer(AddLine, SelectedObjects, TraverseShallow, EditableLayers);
	if quit then GoTo 9999;
	nLine:= iLine - ArrayBottom + 1;
	if nLine < 2 then begin
		errMsg:= '線を２本以上選択してください！';
		GoTo 9999;
	end;
	if nLine <= 32767 then
		btmLine:= 1
	else
		btmLine:= ArrayBottom;
	topLine:= nLine + btmLine - 1;
	Allocate line[btmLine..topLine];
	CreateLineTable;
	Message('ソート中...');
	if 0 < btmLine then
		SortArray(line, topLine, SortKey)
	else
		SortLines(btmLine, topLine);
	SetNextID;
	CheckOverlap;
	ReDrawAll;
9999:
	t:= GetTickCount;
	errMsg:= Concat(If_S(errMsg <> '', Concat(errMsg, Chr(13)), '終了しました！'), '（t=', (t-t0)/60, 'sec.）', Chr(13), nLine, '個中 ', nDel, '個削除 ', nUnDel, '個削除不能');
	AlrtDialog(errMsg);
	WriteLn(errMsg);
	ClrMessage;
end;{main}
Run(xxx_3f);