;==============================================================================
;【ソ フ ト名】	二重オブジェクト削除Lisp(Vir2.5)
;				直線・円・円弧・テキスト・マルチテキスト・寸法・リーダー・スプライン・LWポリライン・点・ブロックに対応
;【著作権  者】	OKAP工房　おかぴー
;【動作	確認】	AutoCAD 2000 確認済み
;【掲  載  日】	2000/10/16
;【ｿﾌﾄｳｪｱ種別】	フリーウェア
;【転載	条件】	要連絡
;【 ﾎｰﾑﾍﾟｰｼﾞ 】	http://homepage1.nifty.com/okap/
;【電子メール】 BQW04027@nifty.com
;==============================================================================
;このファイルには、当Lispをご利用いただく上での注意や制限事項などに関して記載しています。
;記載内容をよくお読みの上、本ソフトウェアをご使用ください。
;
;1. 当Lispについて
;	当Lispは、AutoCAD 2000　用に作成したAutoLispですが、他のバージョンでも使用できると思われます。
;
;2.実行方法
;	本ファイルをAutoCADのサポートパスの通して有る場所に保存してください。
;　　その後AutoCADのコマンドラインから本アプリケーションをロードすると実行します。(load "wes")
;
;3.基本的な使い方
;	本アプリケーションをロードすると、誤差範囲を聞いてきます。次に、Cラバー1点目2点目を聞いてきます。
;	1点目2点目のラバーで囲まれた内側のオブジェクトを抽出し、二重に成っている部分を削除します。
;	オブジェクトの数が増えるとそれだけ時間がかかります。（PCのスペックに依存します）
;	最初は少ない数のオブジェクトで実際に処理出来ることを確認してください。
;		☆コマンド実行の際は画面に変更する図形が表示されている状態で行う
;		☆直線・円・円弧・テキスト・マルチテキスト・寸法・リーダー・スプライン・LWポリライン・点・ブロックに対応
;		☆ポリライン・スプライン等は完全に同一の場合だけ処理する（一部だけ重なっている場合は処理しない）
;		☆元図形の色、画層、線種を使用する（円弧の連続により、円になる場合は円弧は削除され円を描く）
;		☆属性付ブロックが含まれている場合、削除をするか聞いてきます。
;			これは同一座標に有っても内容が違う場合、不用意に削除しないためです。(Y/N)を押して削除するか決めて下さい。
;			また、寸法に複雑な情報が含まれている場合も違いを判断できない場合があります。
;
;4.品質保証
;	いかなる場合においても生ずる障害に関し、OKAP工房側は一切責任を持ちません。
;	ご意見、感想、障害、使用方法などは BQW04027@nifty.com までメールをお願いします。
;
;5.使用上の注意
;	本ソフトは図面作図のため、また自分で使用するコマンドを作成するために使用してください。
;	転載する場合は連絡して下さい。
;	本バージョンからフリーウェアとなり、ソースを公開していますので自由に変更可能です。
;
;6.更新履歴
;	2000/6/14	 押し出し方向が異なっていても削除してしまうのを修正
;	2001/2/28	 円の二重線削除において、色付きの画層がBylayerになってしまうのを修正
;	2001/8/17	 円・円弧等で、中心座標が非常に小さい値の時も処理するように修正
;	2001/8/17	 各画層をフリーズしなくても処理できるように修正（高速化）
;	2001/8/17	 マルチテキスト・リーダーに対応
;	2001/8/17	 ポリライン・スプライン・楕円・点に対応
;	2001/8/29	 ポリラインの重なっている座標を削除するように追加
;	2001/8/29	 ポリラインの開始点が異なっていても処理するように追加
;	2001/9/5	 ポリライン上の同一角度線・同一円弧線を処理するように追加
;	2001/10/13 円・円弧・テキスト・マルチテキストも誤差を入力出来るように追加
;	2001/10/13 空白テキストを削除出来るように追加
;	2001/10/15 ブロック・点・楕円・寸法・リーダー・スプライン・ポリラインも誤差を入力出来るように追加
;	2001/10/16 誤差入力を実行時に設定できるように追加
;	2002/4/16  実行状況をオブジェクト数で表示するように追加
;	2003/6/7   コマンド名変更＆フリーウェア化

;画層名取得
(defun ew_gasou (pt1 pt2 / plist0 kari all pno pno part0 lay)
	(setq plist0 (ssget "C" pt1 pt2 ))
	(setq kari nil count 0)
	(if plist0
		(progn
			(setq all (sslength plist0) pno all lay_list1 nil lays (getvar "clayer"))
			(repeat all
				(setq pno (- pno 1))
				(setq part0 (ssname plist0 pno))			;オブジェクト名取得
				(setq lay (cdr (assoc '8 (entget part0))))
				(foreach n lay_list1
					(if (= n lay)(setq kari "NG"))			;ダミー
				)
				(if (= "NG" kari)
					(setq kari nil)
					(progn
						(setq lay_list1 (cons lay lay_list1))
						(setq lays (strcat lay "," lays))
						(setq count (1+ count))
					)
				)
			)
		)
	)
)
;直線処理１
(defun ew_line1 ( b_stpn b_enpn / leno pps ppe )
	(setq pps (list (car b_stpn) (cadr b_stpn) 0.0))
	(setq ppe (list (car b_enpn) (cadr b_enpn) 0.0))
	(setq leno (distance pps ppe)) leno;２点間の長さ
)
;直線処理２
(defun ew_line2 ( b_stpn b_enpn b_eps / vecte len xv yv zv )
	(setq len (ew_line1 b_stpn b_enpn))
	(if (<= len b_eps)
		(setq vecte nil)
		(progn
			(setq xv (/ (- (car b_enpn) (car b_stpn)) len))
			(setq yv (/ (- (cadr b_enpn) (cadr b_stpn)) len))
			(setq zv 0.0)(setq vecte (list xv yv zv))
		)
	) vecte
)
;直線処理３
(defun ew_line3 ( b_stpn b_enpn b_elen b_eps / ptot vc xv yv xx yy zz )
	(setq vc (ew_line2 b_stpn b_enpn b_eps))
	(if vc
		(progn
			(setq xv (car vc) yv (cadr	vc))
			(setq xx (+ (car b_enpn) (* b_elen xv)))
			(setq yy (+ (cadr b_enpn) (* b_elen yv)))
			(setq zz 0.0 ptot (list xx yy zz))
		)
		(setq ptot nil)
	) ptot
)
;直線処理４
(defun ew_line4 ( b_stpn b_enpn b_elen b_eps / pept ps pe le2 prl prs pre pls ple p1 p2 p3 p4 )
	(setq ps (list (car b_stpn) (cadr b_stpn) 0.0))
	(setq pe (list (car b_enpn) (cadr b_enpn) 0.0))
	(setq le2 (* b_elen 2.0) prl (ew_line5 ps pe le2 b_eps) pept nil)
	(if prl
		(progn
			(setq prs (car (car prl)) pre (cadr (car prl)) pls (car (cadr prl)) ple (cadr (cadr prl)));延長した点
			(setq p1 (ew_line3 prs pre b_elen b_eps) p2 (ew_line3 pls ple b_elen b_eps))
			(setq p3 (ew_line3 ple pls b_elen b_eps) p4 (ew_line3 pre prs b_elen b_eps))
			(if (and p1 p2 p3 p4)
				(setq pept (list p1 p2 p3 p4 p1))
			)
		)
	) pept
)
;直線処理５
(defun ew_line5 ( b_stpn b_enpn b_wide b_eps / prps	 prpe plps plpe vc xv yv xvr yvr xvl yvl ww xx yy prlo );両側の座標値
	(setq vc (ew_line2 b_stpn b_enpn b_eps))
	(if vc
		(progn
			(setq xv (car vc) yv (cadr vc) xvr yv yvr (- 0.0 xv) xvl (- 0.0 yv) yvl xv ww (/ b_wide 2.0))
			(setq xx (+ (car b_stpn) (* ww xvr)) yy (+ (cadr b_stpn) (* ww yvr)) prps (list xx yy (caddr b_stpn)))
			(setq xx (+ (car b_stpn) (* ww xvl)) yy (+ (cadr b_stpn) (* ww yvl)) plps (list xx yy (caddr b_stpn)))
			(setq xx (+ (car b_enpn) (* ww xvr)) yy (+ (cadr b_enpn) (* ww yvr)) prpe (list xx yy (caddr b_enpn)))
			(setq xx (+ (car b_enpn) (* ww xvl)) yy (+ (cadr b_enpn) (* ww yvl)) plpe (list xx yy (caddr b_enpn)))
			(setq prlo (list (list prps prpe) (list plps plpe)))
		)
		(setq prlo nil)
	) prlo
)
;直線処理６
(defun ew_line6 ( c_stpn c_enpn c_ckp c_eps / flgo vec xv yv xp yp yy ya )
	(setq vec (ew_line2 c_stpn c_enpn c_eps))
	(if vec
		(progn
			(setq xv (car vec) yv (cadr vec))
			(setq xp (- (car c_ckp) (car c_stpn)) yp (- (cadr c_ckp) (cadr c_stpn)))
			(setq yy (- (* xv yp) (* yv xp)) ya (abs yy))
			(if (> ya c_eps)
				(setq flgo 0)
				(setq flgo 1)
			)
		)
		(setq flgo nil)
	) flgo
)
;直線処理７
(defun ew_line7 ( c_stpn c_enpn c_ckp c_eps / flgo len vec xv yv xp yp xx yy ya xmi xma le1 le2 )
	(setq len (ew_line1 c_stpn c_enpn) vec (ew_line2 c_stpn c_enpn c_eps))
	(if (<= len c_eps)
		(setq flgo nil)
		(progn
			(setq xv (car vec) yv (cadr vec))
			(setq xp (- (car c_ckp) (car c_stpn)) yp (- (cadr c_ckp) (cadr c_stpn)))
			(setq xx (+ (* xv xp) (* yv yp)) yy (- (* xv yp) (* yv xp)) ya (abs yy))
			(if (> ya c_eps)
				(setq flgo 0)
				(progn
					(setq xmi (- 0.0 c_eps) xma (+ len	c_eps))
					(if (or (< xx xmi) (> xx xma))
						(setq flgo 0)
						(progn
							(setq flgo 3 le1 (ew_line1 c_stpn c_ckp) le2 (ew_line1 c_enpn c_ckp))
							(if (<= le1 c_eps)(setq flgo 1))
							(if (<= le2 c_eps)(setq flgo 2))
						)
					) 
				)
			)
		)
	) flgo
)
;直線処理８
(defun ew_line8 (c_stpn1 c_enpn1 c_stpn2 c_enpn2 c_eps / flgo pout ln1 ln2 fl1 fl2 fps2 fpe2 fps1 fpe1 flpt )
	(setq ln1 (ew_line1 c_stpn1 c_enpn1) ln2 (ew_line1 c_stpn2 c_enpn2))
	(if (or (<= ln1 c_eps) (<= ln2 c_eps))
		(setq flgo nil pout nil)
		(progn	;延長線上にのっているか判定
			(setq fl1 (ew_line6 c_stpn1 c_enpn1 c_stpn2 c_eps) fl2 (ew_line6 c_stpn1 c_enpn1 c_enpn2 c_eps))
			(if (or (= fl1 0) (= fl2 0) (= fl1 nil) (= fl2 nil))
				(setq flgo 3 pout nil)
				(progn	;線上にのっているか判定
					(setq fps2 (ew_line7 c_stpn1 c_enpn1 c_stpn2 c_eps) fpe2 (ew_line7 c_stpn1 c_enpn1 c_enpn2 c_eps))
					(setq fps1 (ew_line7 c_stpn2 c_enpn2 c_stpn1 c_eps) fpe1 (ew_line7 c_stpn2 c_enpn2 c_enpn1 c_eps))
					(if (or (= fps2 nil) (= fpe2 nil) (= fps1 nil) (= fpe1 nil))
						(setq flgo 3 pout nil)
						(progn
							(setq flgo 3 pout nil)
							(cond
								((and (> fps2 0) (> fpe2 0))(setq flgo 1)(setq pout (list c_stpn1 c_enpn1)))
								((and (> fps1 0) (> fpe1 0))(setq flgo 2)(setq pout (list c_stpn2 c_enpn2)))
								((and (= fps2 0) (= fpe2 0) (= fps1 0) (= fpe1 0))(setq flgo 3)(setq pout nil))
								((and (> fps2 0) (= fpe2 0) (= fps1 0) (> fpe1 0))(setq flgo 4)(setq pout (list c_enpn2 c_stpn1)))
								((and (> fps2 0) (= fpe2 0) (> fps1 0) (= fpe1 0))(setq flgo 4)(setq pout (list c_enpn2 c_enpn1)))
								((and (= fps2 0) (> fpe2 0) (= fps1 0) (> fpe1 0))(setq flgo 4)(setq pout (list c_stpn2 c_stpn1)))
								((and (= fps2 0) (> fpe2 0) (> fps1 0) (= fpe1 0))(setq flgo 4)(setq pout (list c_stpn2 c_enpn1)))
							)
						)
					)
				)
			)
		)
	)
	(setq flpt (list flgo pout)) flpt
)
;直線処理９
(defun ew_line9 (pp1 pp2 gosa plist1 / plis ssw ssf nnf ncf entf enf pf1 pf2 lck lfg lpn elin lp1 lp2)
	(setq plis (ew_line4 pp1 pp2 gosa gosa) ssw (ssget "CP" plis (list (cons -4 "<AND") (cons 8 lay) (cons 0 "LINE") (cons -4 "AND>"))) ssf (ssdel plist1 ssw));重なる物を全選択
	(if (/= ssf nil)
		(progn
			(setq nnf (sslength ssf) ncf 0)
			(repeat nnf
				(setq entf (ssname ssf ncf) ncf (+ ncf 1) enf (entget entf))
				(setq pf1 (cdr (assoc 10 enf)) pf2 (cdr (assoc 11 enf)));２つの重なり状態をチェック
				(setq lck (ew_line8 pp1 pp2 pf1 pf2 gosa) lfg (car lck) lpn (cadr lck))
				(if (= lfg 1)(entdel entf))
				(if (= lfg 2)(entdel plist1))
				(if (= lfg 4)
					(progn
						(entdel plist1)(setq elin (entget entf) lp1 (car lpn) lp2 (cadr lpn))
						(setq elin (subst (cons 10 lp1)(assoc 10 elin) elin))
						(setq elin (subst (cons 11 lp2)(assoc 11 elin) elin))
						(entmod elin)
					)
				)
			)
		)
	)
)
;重なっている直線を省く
(defun ew_line (pt1 pt2 plist lay gosa / all pp1 pp2 cln plist1 enls pp1 pp2 lenl)
	(if plist (setq all (sslength plist)))
	(setq pp1 (list 0.0 0.0 0.0) pp2 (list 0.0 0.0 0.0) cln 0)
	(command "pan" "_non" pp1 "_non" pp2)
	(repeat all
		(setq plist1 (ssname plist cln) cln (+ cln 1))
		(if plist1
			(if (setq enls (entget plist1))
				(progn
					(setq pp1 (cdr (assoc 10 enls)) pp2 (cdr (assoc 11 enls)) lenl (ew_line1 pp1 pp2))
					(if (<= lenl gosa)
						(entdel plist1)
						(ew_line9 pp1 pp2 gosa plist1)
					)
				)
			)
		)
		(if (or (= cln (fix (* all 0.1)))(= cln (fix (* all 0.2)))(= cln (fix (* all 0.3)))(= cln (fix (* all 0.4)))(= cln (fix (* all 0.5)))(= cln (fix (* all 0.6)))(= cln (fix (* all 0.7)))(= cln (fix (* all 0.8)))(= cln (fix (* all 0.9))))
			(princ (strcat "\n" (rtos cln) "/" (rtos all)))
		)
	)
	(princ)
)
;重なっている円を省く
(defun ew_circle (pt1 pt2 plist lay gosa / p_arc1 p_arc2 all pno part0 p_cen p_arc plist1a all1 pno1 plist1 pno_c all_c plist0 part11 part1 n_cen)
	(setq all (sslength plist) pno all)
	(repeat all
		(setq pno (- pno 1) part0 (ssname plist pno))
		(setq p_cen (cdr (assoc '10 (entget part0))));原点
		(setq p_arc (assoc '40 (entget part0)));半径
		(if p_arc
			(progn
				(setq p_arc1 (cons 40 (- (cdr p_arc) gosa)));半径下限
				(setq p_arc2 (cons 40 (+ (cdr p_arc) gosa)));半径上限
			)
		)
		(setq plist0 (entget part0))
		(if p_cen
			(progn
				(setq plist1a (ssget "C" pt1 pt2 (list (cons -4 "<AND") (cons 8 lay) (cons -4 ">") p_arc1 (cons -4 "<") p_arc2 (cons -4 "AND>"))));半径が同一のもの全選択
				(setq all1 (sslength plist1a) pno1 all1)
				(setq plist1 (ssadd))
				(repeat all1;中心誤差を考慮
					(setq pno1 (- pno1 1) part1 (ssname plist1a pno1) part11 (entget part1))
					(setq n_cen (cdr (assoc '10 (entget part1))))	;中心
					(if (> gosa (distance p_cen n_cen))
						(setq plist1 (ssadd part1 plist1));中心半径が同一のもの全選択
					)
				)
				(command "erase" plist1 "")
				(entmake plist0)
			)
		)
		(if (or (= pno (fix (* all 0.1)))(= pno (fix (* all 0.2)))(= pno (fix (* all 0.3)))(= pno (fix (* all 0.4)))(= pno (fix (* all 0.5)))(= pno (fix (* all 0.6)))(= pno (fix (* all 0.7)))(= pno (fix (* all 0.8)))(= pno (fix (* all 0.9))))
			(princ (strcat "\n" (rtos pno) "/" (rtos all)))
		)
	)
	(princ)
)
;円弧処理１
(defun ew_arc_ch1 (s_rad1 e_rad1 e_rad0 part11 e_rad / kari)
	(if (< s_rad1 e_rad1)(if (< e_rad1 e_rad0) (progn (setq kari (subst e_rad (assoc 51 part11) part11))(entmod kari))))
	(if (< s_rad1 e_rad0)(if (< e_rad0 e_rad1)(setq circle "o")))
	(if (< e_rad1 s_rad1)(if (< s_rad1 e_rad0)(setq circle "o")))
	(if (< e_rad1 e_rad0)(if (< e_rad0 s_rad1)(progn (setq kari (subst e_rad (assoc 51 part11) part11))(entmod kari))))
	(if (< e_rad0 s_rad1)(if (< s_rad1 e_rad1)(progn (setq kari (subst e_rad (assoc 51 part11) part11))(entmod kari))))
	(if (< e_rad0 e_rad1)(if (< e_rad1 s_rad1)(setq circle "o")))
)
;円弧処理２
(defun ew_arc_ch2 (s_rad1 e_rad1 s_rad0 e_rad0 part11 e_rad s_rad part1 / kari);重なり状態を比較
	;(if(< s_rad1 e_rad1)(if(< e_rad1 s_rad0)(if(< s_rad0 e_rad0)())))
	(if(< s_rad1 e_rad1)(if(< e_rad1 e_rad0)(if(< e_rad0 s_rad0)(entdel part1))))
	(if(< s_rad1 s_rad0)(if(< s_rad0 e_rad1)(if(< e_rad1 e_rad0)(progn(setq kari (subst e_rad (assoc 51 part11) part11))(entmod kari)))))
	;(if(< s_rad1 s_rad0)(if(< s_rad0 e_rad0)(if(< e_rad0 e_rad1)())))
	(if(< s_rad1 e_rad0)(if(< e_rad0 e_rad1)(if(< e_rad1 s_rad0)(progn(setq kari (subst s_rad (assoc 50 part11) part11))(entmod kari)))))
	(if(< s_rad1 e_rad0)(if(< e_rad0 s_rad0)(if(< s_rad0 e_rad1)(setq circle "o"))))
	;(if(< e_rad1 s_rad1)(if(< s_rad1 s_rad0)(if(< s_rad0 e_rad0)())))
	(if(< e_rad1 s_rad1)(if(< s_rad1 e_rad0)(if(< e_rad0 s_rad0)(setq circle "o"))))
	(if(< e_rad1 s_rad0)(if(< s_rad0 s_rad1)(if(< s_rad1 e_rad0)(progn(setq kari (subst s_rad (assoc 50 part11) part11))(entmod kari)))))
	;(if(< e_rad1 s_rad0)(if(< s_rad0 e_rad0)(if(< e_rad0 s_rad1)())))
	(if(< e_rad1 e_rad0)(if(< e_rad0 s_rad1)(if(< s_rad1 s_rad0)(progn(setq kari (subst e_rad (assoc 51 part11) part11))(entmod kari)))))
	(if(< e_rad1 e_rad0)(if(< e_rad0 s_rad0)(if(< s_rad0 s_rad1)(entdel part1))))
	(if(< s_rad0 s_rad1)(if(< s_rad1 e_rad1)(if(< e_rad1 e_rad0)(entdel part1))))
	(if(< s_rad0 s_rad1)(if(< s_rad1 e_rad0)(if(< e_rad0 e_rad1)(progn(setq kari (subst s_rad (assoc 50 part11) part11))(entmod kari)))))
	(if(< s_rad0 e_rad1)(if(< e_rad1 s_rad1)(if(< s_rad1 e_rad0)(setq circle "o"))))
	(if(< s_rad0 e_rad1)(if(< e_rad1 e_rad0)(if(< e_rad0 s_rad1)(progn(setq kari (subst e_rad (assoc 51 part11) part11))(entmod kari)))))
	;(if(< s_rad0 e_rad0)(if(< e_rad0 s_rad1)(if(< s_rad1 e_rad1)())))
	;(if(< s_rad0 e_rad0)(if(< e_rad0 e_rad1)(if(< e_rad1 s_rad1)())))
	;(if(< e_rad0 s_rad1)(if(< s_rad1 e_rad1)(if(< e_rad1 s_rad0)())))
	(if(< e_rad0 s_rad1)(if(< s_rad1 s_rad0)(if(< s_rad0 e_rad1)(progn(setq kari (subst e_rad (assoc 51 part11) part11))(entmod kari)))))
	;(if(< e_rad0 e_rad1)(if(< e_rad1 s_rad1)(if(< s_rad1 s_rad0)())))
	(if(< e_rad0 e_rad1)(if(< e_rad1 s_rad0)(if(< s_rad0 s_rad1)(progn(setq kari (subst s_rad (assoc 50 part11) part11))(entmod kari)))))
	(if(< e_rad0 s_rad0)(if(< s_rad0 s_rad1)(if(< s_rad1 e_rad1)(entdel part1))))
	(if(< e_rad0 s_rad0)(if(< s_rad0 e_rad1)(if(< e_rad1 s_rad1)(setq circle "o"))))
)
;円弧処理３
(defun ew_arc_ch3 (s_rad1 s_rad0 e_rad1 e_rad0 n_rad0 n_rad1 part1 l_rad0 l_rad1 part11 e_rad s_rad /)
	(if (= s_rad0 s_rad1)
		(if (= e_rad0 e_rad1)
			(if (/= n_rad0 n_rad1)(entdel part1))	;始点同一　終点同一
			(if (> l_rad0 l_rad1)(entdel part1))	;始点同一　終点短い
		)
		(if (= e_rad0 e_rad1)
			(if (> l_rad0 l_rad1)(entdel part1))	;始点短い　終点同一
			(if (= e_rad1 s_rad0)
				(if(= e_rad0 s_rad1)
					(progn										;円になる
						(entdel part1)
						(setq circle "o")
					)
					(ew_arc_ch1 s_rad1 e_rad1 e_rad0 part11 e_rad);連続した円
				)
				(ew_arc_ch2 s_rad1 e_rad1 s_rad0 e_rad0 part11 e_rad s_rad part1);始点・終点異なる
			)
		)
	)
)
;円弧処理４
(defun ew_arc_ch4 (p_cen p_arc p_psh n_rad0 s_rad0 e_rad0 e_rad s_rad lay gosa / p_arc1 p_arc2 l_rad0 ee_rad0 plist1a all1 pno1 plist1 n_cen part1 part11 n_rad1 s_rad1 e_rad1 l_rad1 ee_rad1 circle arc_col plist2)
	(if (< s_rad0 e_rad0)
		(setq l_rad0 (- e_rad0 s_rad0))
		(setq l_rad0 (+ (- e_rad0 s_rad0) (* 2 pi)))
	)
	(setq ee_rad0 (+ s_rad0 l_rad0))
	(if p_arc
		(progn
			(setq p_arc1 (cons 40 (- (cdr p_arc) gosa)));半径下限
			(setq p_arc2 (cons 40 (+ (cdr p_arc) gosa)));半径上限
		)
	)
	(setq plist1a (ssget "C" pt1 pt2 (list (cons -4 "<AND") (cons 0 "ARC") (cons 8 lay) (cons -4 ">") p_arc1 (cons -4 "<") p_arc2 p_psh (cons -4 "AND>"))));半径・押し出し方向が同一のもの全選択
	(setq all1 (sslength plist1a) pno1 all1)
	(setq plist1 (ssadd))
	(repeat all1;中心誤差を考慮
		(setq pno1 (- pno1 1) part1 (ssname plist1a pno1) part11 (entget part1))
		(setq n_cen (cdr (assoc '10 (entget part1))));中心
		(if (> gosa (distance (cdr p_cen) n_cen))
			(setq plist1 (ssadd part1 plist1))
		)
	)
	(setq all1 (sslength plist1) pno1 all1 circle nil)
	;重なり方により処理を変える
	(repeat all1
		(setq pno1 (- pno1 1) part1 (ssname plist1 pno1) part11 (entget part1))
		(setq n_rad1 (cdr (assoc '5 (entget part1))));名前
		(setq s_rad1 (cdr (assoc '50 (entget part1))));始点
		(setq e_rad1 (cdr (assoc '51 (entget part1))));終点
		(if s_rad0 (setq s_rad1 (atof (rtos s_rad1))));角度誤差
		(if e_rad0 (setq e_rad1 (atof (rtos e_rad1))));角度誤差
		(if (< s_rad1 e_rad1)(setq l_rad1 (- e_rad1 s_rad1))(setq l_rad1 (+ (- e_rad1 s_rad1) (* 2 pi))))
		(setq ee_rad1 (+ s_rad1 l_rad1))
		(ew_arc_ch3 s_rad1 s_rad0 e_rad1 e_rad0 n_rad0 n_rad1 part1 l_rad0 l_rad1 part11 e_rad s_rad);重なりを比較
	)
	;円になる場合
	(if (= "o" circle)
		(progn
			(setq plist1 (ssget "C" pt1 pt2 (list (cons -4 "<AND") (cons 0 "ARC,CIRCLE") (cons 8 lay) (cons -4 ">") p_arc1 (cons -4 "<") p_arc2 p_psh (cons -4 "AND>"))))
			(setq all (sslength plist1) pno all)
			(setq plist2 (ssadd))
			(repeat all
				(setq pno (1- pno))
				(setq part1 (ssname plist1 pno))
				(setq n_cen (cdr (assoc '10 (entget part1))))	;中心
				(if (> gosa (distance (cdr p_cen) n_cen))
					(setq plist2 (ssadd part1 plist2));中心半径が同一のもの全選択
				)
			)
			(setq arc_col (cdr (assoc '62 (entget (ssname plist2 0)))))
			(command "erase" plist2 "" "circle" "_non" (cdr p_cen) (cdr p_arc) "chprop" (entlast) "" "la" lay "");画層変更
			(if arc_col;色変更
				(command "chprop" (entlast) "" "c" arc_col "")
			)
			(setq circle nil)
		)
	)
)
;円弧処理５
(defun ew_arc_ch5 (plist / all pno s_rad0 e_rad0 part0)
	(setq all (sslength plist0) pno all)
	(repeat all
		(setq pno (- pno 1) part0 (ssname plist0 pno))
		(setq s_rad0 (cdr (assoc '50 (entget part0))))	;開始角	
		(setq e_rad0 (cdr (assoc '51 (entget part0))))	;終点角
		(if (= "0" (rtos (- s_rad0 e_rad0)))			;誤差
			(entdel part0)								;長さ0の時削除
		)
	)
)
;重なっている円弧を省く
(defun ew_arc (pt1 pt2 lay gosa / plist0 all pno2 part0 p_cen p_arc n_rad0 s_rad s_rad0 e_rad0 p_psh e_rad arc_times)
	(repeat 2
		(setq plist0 (ssget "C" pt1 pt2 (list (cons -4 "<AND") (cons 8 lay) (cons 0 "ARC") (cons -4 "AND>"))));円弧全選択
		(if plist0
			(progn
				(setq all (sslength plist0) pno2 all)
				(repeat all
					(setq pno2 (- pno2 1))
					(setq part0 (ssname plist0 pno2))				;オブジェクト名取得
					(setq p_cen (assoc '10 (entget part0)))			;原点
					(setq p_arc (assoc '40 (entget part0)))			;半径
					(setq p_psh (assoc '210 (entget part0)))		;押し出し方向
					(setq s_rad (assoc '50 (entget part0)))			;開始角	
					(setq e_rad (assoc '51 (entget part0)))			;終点角
					(setq n_rad0 (cdr (assoc '5 (entget part0))))	;名前
					(setq s_rad0 (cdr (assoc '50 (entget part0))))	;始点
					(setq e_rad0 (cdr (assoc '51 (entget part0))))	;終点
					(if s_rad0 (setq s_rad0 (atof (rtos s_rad0))))	;誤差
					(if e_rad0 (setq e_rad0 (atof (rtos e_rad0))))	;誤差
					(if p_cen
						(ew_arc_ch4 p_cen p_arc p_psh n_rad0 s_rad0 e_rad0 e_rad s_rad lay gosa)
					)
					(if (or (= pno2 (fix (* all 0.1)))(= pno2 (fix (* all 0.2)))(= pno2 (fix (* all 0.3)))(= pno2 (fix (* all 0.4)))(= pno2 (fix (* all 0.5)))(= pno2 (fix (* all 0.6)))(= pno2 (fix (* all 0.7)))(= pno2 (fix (* all 0.8)))(= pno2 (fix (* all 0.9))))
						(princ (strcat "\n" (rtos (- all pno2)) "/" (rtos all)))
					)
				)
			)
		)
		(if (= nil arc_times)(progn(princ "\n再調査・・・")(setq arc_times "0")))
	)
	(setq plist0 (ssget "C" pt1 pt2 (list (cons -4 "<AND") (cons 8 lay) (cons 0 "ARC") (cons -4 "AND>"))));円弧全選択
	(if plist0
		(ew_arc_ch5 plist0)
	)
	(princ)
)
;重なっているテキストを省く
(defun ew_text (pt1 pt2 plist lay gosa / all pno part0 p_nam p_cen p_ban p_hig p_ang p_xsh p_ysh plist1 all1 pno1 part1 p_ban1 plist1a n_cen)
	(setq all (sslength plist) pno all)
	(repeat all
		(setq pno (- pno 1) part0 (ssname plist pno))
		(setq p_nam (assoc '1 (entget part0)))	;文字列
		(setq p_cen (assoc '10 (entget part0)))	;原点
		(setq p_ban (assoc '5 (entget part0)))	;番号
		(setq p_hig (assoc '40 (entget part0)))	;高さ
		(setq p_ang (assoc '50 (entget part0)))	;角度
		(setq p_xsh (assoc '41 (entget part0)))	;縦横比
		(setq p_ysh (assoc '51 (entget part0)))	;傾斜角度
		(if p_cen
			(progn
				(setq plist1a (ssget "C" pt1 pt2 (list (cons -4 "<AND") (cons 0 "TEXT") (cons 8 lay) p_nam p_hig p_ang p_xsh p_ysh (cons -4 "AND>"))));同一のもの全選択
				(setq all1 (sslength plist1a) pno1 all1 plist1 (ssadd))
				(repeat all1;中心誤差を考慮
					(setq pno1 (- pno1 1) part1 (ssname plist1a pno1) n_cen (cdr (assoc '10 (entget part1))))
					(if (> gosa (distance (cdr p_cen) n_cen))
						(setq plist1 (ssadd part1 plist1))
					)
				)
				(if plist1
					(progn
						(setq all1 (sslength plist1) pno1 all1)
						(repeat all1
							(setq pno1 (- pno1 1) part1 (ssname plist1 pno1) p_ban1 (assoc '5 (entget part1)))
							(if (/= (cdr p_ban) (cdr p_ban1))
								(entdel part1)
							)
						)
					)
				)
			)
		)
		(if (or (= pno (fix (* all 0.1)))(= pno (fix (* all 0.2)))(= pno (fix (* all 0.3)))(= pno (fix (* all 0.4)))(= pno (fix (* all 0.5)))(= pno (fix (* all 0.6)))(= pno (fix (* all 0.7)))(= pno (fix (* all 0.8)))(= pno (fix (* all 0.9))))
			(princ (strcat "\n" (rtos (- all pno)) "/" (rtos all)))
		)
	)
	(princ)
)
;重なっているマルチテキストを省く
(defun ew_mtext (pt1 pt2 plist lay gosa / all pno part0 p_nam p_cen p_st1 p_st2 p_st3 p_st4 p_st5 p_st6 p_st7 p_st8 p_st9 p_ban plist1a all1 pno1 plist1 n_cen p_ban1 part1)
	(setq all (sslength plist) pno all)
	(repeat all
		(setq pno (- pno 1) part0 (ssname plist pno))
		(setq p_nam (assoc '1 (entget part0)))	;文字列
		(setq p_cen (assoc '10 (entget part0)))	;原点
		(setq p_st1 (assoc '11 (entget part0)))	;
		(setq p_st2 (assoc '40 (entget part0)))	;高さ
		(setq p_st3 (assoc '41 (entget part0)))	;縦横比
		(setq p_st4 (assoc '42 (entget part0)))	;
		(setq p_st5 (assoc '43 (entget part0)))	;
		(setq p_st6 (assoc '44 (entget part0)))	;行間隔
		(setq p_st7 (assoc '50 (entget part0)))	;角度
		(setq p_st8 (assoc '71 (entget part0)))	;
		(setq p_st9 (assoc '72 (entget part0)))	;位置
		(setq p_ban (assoc '5 (entget part0)))	;番号
		(if p_cen
			(progn
				(setq plist1a (ssget "C" pt1 pt2 (list (cons -4 "<AND") (cons 0 "MTEXT") (cons 8 lay) p_nam p_st1 p_st2 p_st3 p_st4 p_st5 p_st6 p_st7 p_st8 p_st9 (cons -4 "AND>"))));同一のもの全選択
				(setq all1 (sslength plist1a) pno1 all1 plist1 (ssadd))
				(repeat all1;中心誤差を考慮
					(setq pno1 (- pno1 1) part1 (ssname plist1a pno1) n_cen (cdr (assoc '10 (entget part1))))
					(if (> gosa (distance (cdr p_cen) n_cen))
						(setq plist1 (ssadd part1 plist1))
					)
				)
				(if plist1
					(progn
						(setq all1 (sslength plist1) pno1 all1)
						(repeat all1
							(setq pno1 (- pno1 1) part1 (ssname plist1 pno1) p_ban1 (assoc '5 (entget part1)))
							(if (/= (cdr p_ban) (cdr p_ban1))
								(entdel part1)
							)
						)
					)
				)
			)
		)
		(if (or (= pno (fix (* all 0.1)))(= pno (fix (* all 0.2)))(= pno (fix (* all 0.3)))(= pno (fix (* all 0.4)))(= pno (fix (* all 0.5)))(= pno (fix (* all 0.6)))(= pno (fix (* all 0.7)))(= pno (fix (* all 0.8)))(= pno (fix (* all 0.9))))
			(princ (strcat "\n" (rtos (- all pno)) "/" (rtos all)))
		)
	)
	(princ)
)
;重なっている寸法を省く
(defun ew_dimention (pt1 pt2 plist lay gosa / all pno part0 p_05 p_01 p_10 p_11 p_13 p_14 p_15 p_05a p_10a p_11a p_13a p_14a p_15a plist1 all1 pno1 part1 gosa1 gosa2 gosa3 gosa4 gosa5)
	(setq all (sslength plist) pno all)
	(repeat all
		(setq pno (- pno 1) part0 (ssname plist pno))
		(setq p_05 (assoc '5 (entget part0)))	;番号
		(setq p_10 (assoc '10 (entget part0)))	;定義点
		(setq p_11 (assoc '11 (entget part0)))	;中央点　文字列
		(setq p_13 (assoc '13 (entget part0)))	;挿入点1　寸法
		(setq p_14 (assoc '14 (entget part0)))	;挿入点2　寸法
		(setq p_15 (assoc '15 (entget part0)))	;挿入点3　角度
		(setq plist1 (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 0 "DIMENSION")(cons 8 lay)(cons -4 "AND>"))));同一のもの全選択
		(if (and plist1 p_10)
			(progn
				(setq all1 (sslength plist1) pno1 all1)
				(repeat all1
					(setq pno1 (- pno1 1) part1 (ssname plist1 pno1))
					(if part1
						(progn
							(setq p_05a (assoc 5 (entget part1)))
							(setq p_10a (assoc 10 (entget part1)))
							(setq p_11a (assoc 11 (entget part1)))
							(setq p_13a (assoc 13 (entget part1)))
							(setq p_14a (assoc 14 (entget part1)))
							(setq p_15a (assoc 15 (entget part1)))
							(setq gosa1 (> gosa (distance (cdr p_11) (cdr p_11a))));文字起点
							(setq gosa2 (and (> gosa (distance (cdr p_13) (cdr p_13a))) (> gosa (distance (cdr p_14) (cdr p_14a)))))
							(setq gosa3 (and (> gosa (distance (cdr p_13) (cdr p_14a))) (> gosa (distance (cdr p_14) (cdr p_13a)))))
							(setq gosa4 (and (> gosa (distance (cdr p_10) (cdr p_10a))) (> gosa (distance (cdr p_15) (cdr p_15a)))))
							(setq gosa5 (and (> gosa (distance (cdr p_10) (cdr p_15a))) (> gosa (distance (cdr p_15) (cdr p_10a)))))
						)
						(setq gosa1 nil)
					)
					(if (inters (cdr p_10) (cdr p_15) (cdr p_13) (cdr p_14) nil)
						(if (or (and gosa1 gosa2) (and gosa1 gosa3));平行・角度寸法
							(if (/= (cdr p_05) (cdr p_05a))
								(entdel part1)
							)
						)
						(if (or (and gosa1 gosa4) (and gosa1 gosa5));半径・直径寸法
							(if (/= (cdr p_05) (cdr p_05a))
								(entdel part1)
							)
						)
					)
				)
			)
		)
		(if (or (= pno (fix (* all 0.1)))(= pno (fix (* all 0.2)))(= pno (fix (* all 0.3)))(= pno (fix (* all 0.4)))(= pno (fix (* all 0.5)))(= pno (fix (* all 0.6)))(= pno (fix (* all 0.7)))(= pno (fix (* all 0.8)))(= pno (fix (* all 0.9))))
			(princ (strcat "\n" (rtos (- all pno)) "/" (rtos all)))
		)
	)
	(princ)
)
;重なっているリーダーを省く
(defun ew_leader (pt1 pt2 plist lay gosa / all pno part0 p_01 p_02 p_03 p_04 p_05 p_06 nomb all_l plist1 all1 pno1 part1 pno2 test)
	(setq all (sslength plist) pno all)
	(repeat all
		(setq pno (- pno 1) part0 (ssname plist pno))
		(setq p_01 (assoc '71 (entget part0)))
		(setq p_02 (assoc '72 (entget part0)))
		(setq p_03 (assoc '73 (entget part0)))
		(setq p_04 (assoc '74 (entget part0)))
		(setq p_05 (assoc '75 (entget part0)))
		(setq p_06 (assoc '76 (entget part0)))
		(setq nomb (cdr (assoc '5 (entget part0))));番号
		(setq all_l (length (entget part0)))
		(if p_01
			(progn
				(setq plist1 (ssget "C" pt1 pt2 (list (cons -4 "<AND") (cons 0 "LEADER") (cons 8 lay) p_01 p_02 p_03 p_04 p_05 p_06 (cons -4 "AND>"))));同一のもの全選択
				(if plist1
					(progn
						(setq all1 (sslength plist1) pno1 all1)
						(repeat all1
							(setq pno1 (- pno1 1) part1 (ssname plist1 pno1) pno2 17 test nil)
							(repeat (- all_l 23);'10の数だけ繰り返す
								(setq pno2 (1+ pno2))
								(if (= 10 (car (nth pno2 (entget part0))))
									(if (< gosa	(distance (cdr (nth pno2 (entget part0))) (cdr (nth pno2 (entget part1)))));許容誤差
										(setq test "NG");ダミー
									)
								)
							)
							(if (not test)
								(if (/= nomb (cdr (assoc '5 (entget part1))))
									(entdel part1)
								)
							)
						)
					)
				)
			)
		)
		(if (or (= pno (fix (* all 0.1)))(= pno (fix (* all 0.2)))(= pno (fix (* all 0.3)))(= pno (fix (* all 0.4)))(= pno (fix (* all 0.5)))(= pno (fix (* all 0.6)))(= pno (fix (* all 0.7)))(= pno (fix (* all 0.8)))(= pno (fix (* all 0.9))))
			(princ (strcat "\n" (rtos (- all pno)) "/" (rtos all)))
		)
	)
	(princ)
)
;重なっているポリラインを省く
(defun ew_pline (pt1 pt2 plist lay gosa / all pno part0 p_01 p_02 p_03 p_04 p_05 p_06 nomb all_l plist1 all1 pno1 part1 pno2 test cpt2 cpt4 cpt5)
	(setq all (sslength plist) pno all)
	(repeat all
		(setq pno (- pno 1) part0 (ssname plist pno))
		(setq p_01 (assoc '67 (entget part0)))
		(setq p_02 (assoc '90 (entget part0)))
		(setq p_03 (assoc '70 (entget part0)))
		(setq p_04 (assoc '43 (entget part0)))
		(setq p_05 (assoc '38 (entget part0)))
		(setq p_06 (assoc '39 (entget part0)))
		(setq nomb (cdr (assoc '5 (entget part0))));番号
		(setq all_l (length (entget part0)))
		(if p_01
			(progn
				(setq plist1 (ssget "C" pt1 pt2 (list (cons -4 "<AND") (cons 0 "LWPOLYLINE") (cons 8 lay) p_01 p_02 p_03 p_04 p_05 p_06 (cons -4 "AND>"))));同一のもの全選択
				(if plist1
					(progn
						(setq all1 (sslength plist1) pno1 all1)
						(repeat all1
							(setq pno1 (- pno1 1) part1 (ssname plist1 pno1) pno2 13 test nil)
							(repeat (- all_l 14)
								(setq pno2 (1+ pno2))
								(if (= 10 (car (nth pno2 (entget part0))))
									(if (< gosa (distance (cdr (nth pno2 (entget part0))) (cdr (nth pno2 (entget part1)))));許容誤差
										(setq test "NG");ダミー
									)
								)
								(if (= 40 (car (nth pno2 (entget part0))));線幅は許容差に含めない
									(if (/=	(rtos (cdr (nth pno2 (entget part0)))) (rtos (cdr (nth pno2 (entget part1)))));許容誤差
										(setq test "NG");ダミー
									)
								)
								(if (= 41 (car (nth pno2 (entget part0))));線幅は許容差に含めない
									(if (/=	(rtos (cdr (nth pno2 (entget part0)))) (rtos (cdr (nth pno2 (entget part1)))));許容誤差
										(setq test "NG");ダミー
									)
								)
								(if (= 42 (car (nth pno2 (entget part0))))
									(progn
										(if (= 10 (car (nth (+ pno2 1) (entget part0))))
											(setq cpt2 (cdr (nth (+ pno2 1) (entget part0))))
											(setq cpt2 (cdr (assoc '10 (entget part0))))
										)
										(setq cpt4 (ew_mid_arc (cdr (nth (- pno2 3) (entget part0))) cpt2 (cdr (nth pno2 (entget part0)))));ポリライン円弧の中間点を算出
										(if (= 10 (car (nth (+ pno2 1) (entget part1))))
											(setq cpt2 (cdr (nth (+ pno2 1) (entget part1))))
											(setq cpt2 (cdr (assoc '10 (entget part1))))
										)
										(setq cpt5 (ew_mid_arc (cdr (nth (- pno2 3) (entget part1))) cpt2 (cdr (nth pno2 (entget part1)))));ポリライン円弧の中間点を算出
										(if (< gosa (distance cpt4 cpt5));許容誤差
											(setq test "NG");ダミー
										)
									)
								)
							)
							(if (not test)
								(if (/= nomb (cdr (assoc '5 (entget part1))))
									(entdel part1)
								)
							)
						)
					)
				)
			)
		)
		(if (or (= pno (fix (* all 0.1)))(= pno (fix (* all 0.2)))(= pno (fix (* all 0.3)))(= pno (fix (* all 0.4)))(= pno (fix (* all 0.5)))(= pno (fix (* all 0.6)))(= pno (fix (* all 0.7)))(= pno (fix (* all 0.8)))(= pno (fix (* all 0.9))))
			(princ (strcat "\n" (rtos (- all pno)) "/" (rtos all)))
		)
	)
	(princ)
)
;重なっているスプラインを省く
(defun ew_spline (pt1 pt2 plist lay gosa / all pno part0 p_01 p_02 p_03 p_04 p_05 p_06 p_07 nomb all_l plist1 all1 pno1 part1 pno2 test)
	(setq all (sslength plist) pno all)
	(repeat all
		(setq pno (- pno 1) part0 (ssname plist pno))
		(setq p_01 (assoc '70 (entget part0)))
		(setq p_02 (assoc '71 (entget part0)))
		(setq p_03 (assoc '72 (entget part0)))
		(setq p_04 (assoc '73 (entget part0)))
		(setq p_05 (assoc '74 (entget part0)))
		(setq p_06 (assoc '42 (entget part0)))
		(setq p_07 (assoc '43 (entget part0)))
		(setq nomb (cdr (assoc '5 (entget part0))));番号
		(setq all_l (length (entget part0)))
		(if p_01
			(progn
				(setq plist1 (ssget "C" pt1 pt2 (list (cons -4 "<AND") (cons 0 "SPLINE") (cons 8 lay) p_01 p_02 p_03 p_04 p_05 p_06 p_07 (cons -4 "AND>"))));同一のもの全選択
				(if plist1
					(progn
						(setq all1 (sslength plist1) pno1 all1)
						(repeat all1
							(setq pno1 (- pno1 1) part1 (ssname plist1 pno1) pno2 17 test nil)
							(repeat (- all_l 18)
								(setq pno2 (1+ pno2))
								(if (or (= 10 (car (nth pno2 (entget part0)))) (= 11 (car (nth pno2 (entget part0)))))
									(if (< gosa (distance (cdr (nth pno2 (entget part0))) (cdr (nth pno2 (entget part1)))));許容誤差
										(setq test "NG");ダミー
									)
								)
;								(if (= 40 (car (nth pno2 (entget part0))))
;									(if (/=	(rtos (cdr (nth pno2 (entget part0)))) (rtos (cdr (nth pno2 (entget part1)))));許容誤差
;										(setq test "NG");ダミー
;									)
;								)
							)
							(if (not test)
								(if (/= nomb (cdr (assoc '5 (entget part1))))
									(entdel part1)
								)
							)
						)
					)
				)
			)
		)
		(if (or (= pno (fix (* all 0.1)))(= pno (fix (* all 0.2)))(= pno (fix (* all 0.3)))(= pno (fix (* all 0.4)))(= pno (fix (* all 0.5)))(= pno (fix (* all 0.6)))(= pno (fix (* all 0.7)))(= pno (fix (* all 0.8)))(= pno (fix (* all 0.9))))
			(princ (strcat "\n" (rtos (- all pno)) "/" (rtos all)))
		)
	)
	(princ)
)
;重なっている楕円を省く
(defun ew_ellipse (pt1 pt2 plist lay gosa / all pno part0 p_cen p_11 p_40 p_41 p_42 p_ban all_l plist1 all1 pno1 part1 pno2 test plist1a p_ban1 n_cen tjiku n_p11 n_p11r n_p40 n_jiku el_type p210)
	(setq all (sslength plist) pno all)
	(repeat all
		(setq pno (- pno 1) part0 (ssname plist pno))
		(setq p_cen (assoc '10 (entget part0)));原点
		(setq p_11 (assoc '11 (entget part0)));傾き点
		(setq p_40 (assoc '40 (entget part0)));幅
		(setq p_41 (assoc '41 (entget part0)));開始角
		(setq p_42 (assoc '42 (entget part0)));終了角
		(if (entget part0)
			(setq p210 (nth 2 (cdr (assoc '210 (entget part0)))));方向
		)
		(setq p_ban (assoc '5 (entget part0)));番号
		(if p_40 (setq tjiku (* (distance (cdr p_11) (list 0 0 0)) (cdr p_40))))
		(if (and p_cen p_11 p_40 p_41 p_42)
			(progn
				(if (and (= (cdr p_41) 0.0) (= (rtos (cdr p_42)) "6.2832"));誤差を考慮
					(setq el_type 0);真楕円
					(setq el_type 1);半楕円
				)
				(setq plist1a (ssget "C" pt1 pt2 (list (cons -4 "<AND") (cons 0 "ELLIPSE") (cons 8 lay) (cons -4 "AND>"))));真楕円の時
				(setq all1 (sslength plist1a) pno1 all1 plist1 (ssadd))
				(repeat all1;中心誤差を考慮
					(setq pno1 (- pno1 1) part1 (ssname plist1a pno1))
					(setq n_cen (cdr (assoc '10 (entget part1))))
					(setq n_p210 (nth 2 (cdr (assoc '210 (entget part1)))) ok n_p210)
					(setq n_p11 (cdr (assoc '11 (entget part1))))
					(setq n_p11r (list (- (nth 0 n_p11)) (- (nth 1 n_p11)) (- (nth 2 n_p11))));反転しているとき
					(setq n_p40 (cdr (assoc '40 (entget part1))))
					(setq n_p41 (cdr (assoc '41 (entget part1))))
					(setq n_p42 (cdr (assoc '42 (entget part1))))
					(setq n_jiku (* (distance n_p11 (list 0 0 0)) n_p40))
					(if (> gosa (distance (cdr p_cen) n_cen));原点が誤差以内
						(if (> gosa (distance (cdr p_11) n_p11));長軸座標が誤差以内
							(if (> gosa (abs (- tjiku n_jiku)));短軸が誤差以内
								(if (= 0 el_type)
									(setq plist1 (ssadd part1 plist1))
									(if (and (= (rtos (cdr p_41)) (rtos n_p41)) (= (rtos (cdr p_42)) (rtos n_p42)));角度が同一か
										(if (= p210 n_p210)
											(setq plist1 (ssadd part1 plist1))
										)
									)
								)
							)
							(if (> gosa (distance (cdr p_11) n_p11r));長軸座標が誤差以内
								(if (> gosa (abs (- tjiku n_jiku)));短軸が誤差以内
									(if (= 0 el_type)
										(setq plist1 (ssadd part1 plist1))
										(if (and (= (rtos (cdr p_41)) (rtos n_p41)) (= (rtos (cdr p_42)) (rtos n_p42)));角度が同一か
											(if (/= p210 n_p210)
												(setq plist1 (ssadd part1 plist1))
											)
										)
									)
								)
							)
						)
					)
				)
				(if plist1
					(progn
						(setq all1 (sslength plist1) pno1 all1)
						(repeat all1
							(setq pno1 (- pno1 1) part1 (ssname plist1 pno1) p_ban1 (assoc '5 (entget part1)))
							(if (/= (cdr p_ban) (cdr p_ban1))
								(entdel part1)
							)
						)
					)
				)
			)
		)
		(if (or (= pno (fix (* all 0.1)))(= pno (fix (* all 0.2)))(= pno (fix (* all 0.3)))(= pno (fix (* all 0.4)))(= pno (fix (* all 0.5)))(= pno (fix (* all 0.6)))(= pno (fix (* all 0.7)))(= pno (fix (* all 0.8)))(= pno (fix (* all 0.9))))
			(princ (strcat "\n" (rtos (- all pno)) "/" (rtos all)))
		)
	)
	(princ)
)
;重なっている点を省く
(defun ew_point (pt1 pt2 plist lay gosa / all pno part0 p_cen p_ban nomb plist1 all1 pno1 plist1a part1 n_cen p_ban1)
	(setq all (sslength plist) pno all)
	(repeat all
		(setq pno (- pno 1) part0 (ssname plist pno))
		(setq p_cen (assoc '10 (entget part0)));起点
		(setq p_ban (assoc '5 (entget part0)));番号
		(if p_cen
			(progn
				(setq plist1a (ssget "C" pt1 pt2 (list (cons -4 "<AND") (cons 0 "POINT") (cons 8 lay) (cons -4 "AND>"))));同一のもの全選択
				(setq all1 (sslength plist1a) pno1 all1 plist1 (ssadd))
				(repeat all1;中心誤差を考慮
					(setq pno1 (- pno1 1) part1 (ssname plist1a pno1))
					(setq n_cen (cdr (assoc '10 (entget part1))))
					(if (> gosa (distance (cdr p_cen) n_cen))
						(setq plist1 (ssadd part1 plist1))
					)
				)
				(if plist1
					(progn
						(setq all1 (sslength plist1) pno1 all1)
						(repeat all1
							(setq pno1 (- pno1 1) part1 (ssname plist1 pno1) p_ban1 (assoc '5 (entget part1)))
							(if (/= (cdr p_ban) (cdr p_ban1))
								(entdel part1)
							)
						)
					)
				)
			)
		)
		(if (or (= pno (fix (* all 0.1)))(= pno (fix (* all 0.2)))(= pno (fix (* all 0.3)))(= pno (fix (* all 0.4)))(= pno (fix (* all 0.5)))(= pno (fix (* all 0.6)))(= pno (fix (* all 0.7)))(= pno (fix (* all 0.8)))(= pno (fix (* all 0.9))))
			(princ (strcat "\n" (rtos (- all pno)) "/" (rtos all)))
		)
	)
	(princ)
)
;重なっているブロックを省く
(defun ew_block (pt1 pt2 plist lay gosa / all pnp part0 p_cen p_nam p_xsh p_ysh p_ban plist1a p_ang plist1 all1 pno1 part1 p_ban1 p_zok1 kari n_cen)
	(setq all (sslength plist) pno all)
	(repeat all
		(setq pno (- pno 1) part0 (ssname plist pno))
		(setq p_cen (assoc '10 (entget part0)));原点
		(setq p_nam (assoc '2 (entget part0)));名前
		(setq p_xsh (assoc '41 (entget part0)));X尺度
		(setq p_ysh (assoc '42 (entget part0)));Y尺度
		(setq p_ban (assoc '5 (entget part0)));番号
		(setq p_ang (assoc '50 (entget part0)));傾き
		(setq plist1 nil)
		(if p_cen
			(progn
				(setq plist1a (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 0 "INSERT")(cons 8 lay) p_nam p_xsh p_ysh p_ang (cons -4 "AND>"))));同一のもの全選択
				(setq all1 (sslength plist1a) pno1 all1)
				(setq plist1 (ssadd))
				(repeat all1;中心誤差を考慮
					(setq pno1 (- pno1 1) part1 (ssname plist1a pno1))
					(setq n_cen (cdr (assoc '10 (entget part1))))	;中心
					(if (> gosa (distance (cdr p_cen) n_cen))
						(setq plist1 (ssadd part1 plist1))
					)
				)
				(if plist1
					(progn
						(setq all1 (sslength plist1) pno1 all1)
						(repeat all1
							(setq pno1 (- pno1 1) part1 (ssname plist1 pno1))
							(setq p_ban1 (assoc '5 (entget part1)))			;番号
							(setq p_zok1 (cdr (assoc '66 (entget part1))))	;属性
							(if (/= (cdr p_ban) (cdr p_ban1))
								(if (/= 1 p_zok1);属性付きブロックを削除しない
									(entdel part1)
									(progn
										(initget 1 "Y N")
										(setq kari (getkword "\n同一座標に同じ属性ブロックがあります。削除しますか？ (Y/N):"))
										(if (= kari "Y")(entdel part1))
									)
								)
							)
						)
					)
				)
			)
		)
		(if (or (= pno (fix (* all 0.1)))(= pno (fix (* all 0.2)))(= pno (fix (* all 0.3)))(= pno (fix (* all 0.4)))(= pno (fix (* all 0.5)))(= pno (fix (* all 0.6)))(= pno (fix (* all 0.7)))(= pno (fix (* all 0.8)))(= pno (fix (* all 0.9))))
			(princ (strcat "\n" (rtos (- all pno)) "/" (rtos all)))
		)
	)
	(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;ポリライン簡略化
;リストの最初を作成
(defun ew_pl_ch1 (plist0 / plist1 pno)
	(setq plist1 (list (car plist0)))
	(setq pno 0)
	(while (/= 39 (car (nth pno plist0)))
		(setq pno (1+ pno))
		(setq plist1 (append plist1 (list (nth pno plist0))))
	)
	(list plist1 pno)
)
;座標の重なりを削除
(defun ew_pl_ch2 (plist1 pno plist0 / pt_pno1 pt_pno2 pt_pno3 pt_pno4 plist2 last_p)
	(setq pno (+ pno 1))
	(setq plist2 (list (nth pno plist0)))
	(setq pno (+ pno 4))
	(while (or (/= 210 (car (nth pno plist0))) (< (length plist0) pno));予備
		(setq pt_pno1 (cadr (nth (- pno 4) plist0)));前のX座標
		(setq pt_pno2 (caddr (nth (- pno 4) plist0)));前のY座標
		(setq pt_pno3 (cadr (nth pno plist0)));次のX座標
		(setq pt_pno4 (caddr (nth pno plist0)));次のY座標
		(if (not (and (= (rtos pt_pno1) (rtos pt_pno3)) (= (rtos pt_pno2) (rtos pt_pno4))))
			(setq plist2 (append plist2 (list (nth (- pno 3) plist0) (nth (- pno 2) plist0) (nth (- pno 1) plist0) (nth pno plist0))))
		)
		(setq last_p (nth pno plist0));最後の点
		(setq pno (+ pno 4))
	)
	(setq plist2 (append plist2 (list (nth (- pno 3) plist0) (nth (- pno 2) plist0) (nth (- pno 1) plist0))))
	(list plist2 last_p)
)
;閉じているか判断
(defun ew_pl_ch3 (plist2 last_p / pt_pno5 pt_pno6 pt_pno7 pt_pno8 pno1 plist34 plist3 plist4 close all_p)
	(setq pt_pno5 (cadr (car plist2)));最初のX座標
	(setq pt_pno6 (caddr (car plist2)));最初のY座標
	(setq pt_pno7 (cadr last_p));最後のX座標
	(setq pt_pno8 (caddr last_p));最後のY座標
	(if (and (= (rtos pt_pno5) (rtos pt_pno7)) (= (rtos pt_pno6) (rtos pt_pno8)));誤差を考慮
		(progn
			(setq plist3 (list (car plist2)))
			(setq pno1 0)
			(repeat (- (length plist2) 5)
				(setq pno1 (1+ pno1))
				(setq plist3 (append plist3 (list (nth pno1 plist2))))
			)
			(setq close (cons 70 1));閉じたPLINE
		)
		(progn
			(setq plist3 plist2)
			(setq close (cons 70 0));開いたPLINE
		)
	)
	(if (= 1 (cdr (assoc 70 plist1)));元から閉じている
		(setq close (cons 70 1))
	)
	(setq all_p (cons 90 (/ (length plist3) 4)));頂点の数
	(setq plist34 (subst all_p (assoc 90 plist1) plist1))
	(setq plist4 (subst close (assoc 70 plist34) plist34));2Dポリラインのみ
	(list plist3 plist4 close all_p)
)
;閉じたポリラインの基点を統一
(defun ew_pl_ch4 (plist3 all_p / maxx maxy pno2 max1x max1y maxlist pno3 test plist5)
	(setq pno4 0 maxx nil)
	(while (and (not maxx) (< pno4 (cdr all_p)))
		(if (= 0 (cdr (nth (+ pno4 3) plist3)));円弧ポリラインを比較しない
			(setq maxx (cadr (nth pno4 plist3)) maxy (caddr (nth pno4 plist3)));最大のX座標その時のY座標
		)
		(setq pno4 (+ pno4 4))
	)
	(if (not maxx);円弧だけの時
		(setq maxx (cadr (car plist3)) maxy (caddr (car plist3)))
	)
	(setq pno2 0)
	(repeat (cdr all_p)
		(setq pno2 (+ pno2 4))
		(setq max1x (cadr (nth pno2 plist3)));比較するX座標
		(setq max1y (caddr (nth pno2 plist3)));比較するY座標
		(if (= 0 (cdr (nth (+ pno2 3) plist3)));円弧ポリラインを比較しない
			(if (= maxx max1x)
				(if (< maxy max1y)
					(setq maxx max1x maxy max1y)
				)
				(if (< maxx max1x)
					(setq maxx max1x maxy max1y)
				)
			)
		)
	)
	(setq maxlist (list 10 maxx maxy));最大になる座標
	(setq plist5 (member maxlist plist3));最大になる点から最後まで
	(setq pno3 0 test 1)
	(while (or test (> (/ pno3 4) (cdr all_p)));予備
		(if (= (rtos maxx) (rtos (cadr (nth pno3 plist3))));誤差を考慮
			(if (= (rtos maxy) (rtos (caddr (nth pno3 plist3))));誤差を考慮
				(setq test nil)
				(setq plist5 (append plist5 (list (nth pno3 plist3)) (list (nth (+ pno3 1) plist3)) (list (nth (+ pno3 2) plist3)) (list (nth (+ pno3 3) plist3))))
			)
			(setq plist5 (append plist5 (list (nth pno3 plist3)) (list (nth (+ pno3 1) plist3)) (list (nth (+ pno3 2) plist3)) (list (nth (+ pno3 3) plist3))))
		)
		(setq pno3 (+ pno3 4))
	)
	plist5
)

;閉じたポリラインの作図方向を統一
(defun ew_pl_ch5 (plist5 all_p / 2ndx 2ndy lastx lasty test2 plist6 pno4 list40 list41 list42 list10 plist7)
	(setq 2ndx (cadr (nth 4 plist5)));二番目のX座標
	(setq 2ndy (caddr (nth 4 plist5)));その時のY座標
	(setq lastx (cadr (cadddr (reverse plist5))));最後のX座標
	(setq lasty (caddr (cadddr (reverse plist5))));その時のY座標
	(setq test2 nil)
	(if (= 2ndx lastx);要素反転判断
		(if (< 2ndy lasty)
			(setq test2 "ok")
		)
		(if (< 2ndx lastx)
			(setq test2 "ok")
		)
	)
	(if test2;要素を反転
		(progn
			(setq plist6 (reverse plist5))
			(setq plist7 (list (car plist5)))
			(setq pno4 0)
			(repeat (- (cdr all_p) 1)
				(setq list40 (nth (+ pno4 2) plist6))
				(setq list41 (nth (+ pno4 1) plist6))
				(setq list42 (cons 42 (* (cdr (nth pno4 plist6)) -1)))
				(setq list10 (nth (+ pno4 3) plist6))
				(setq plist7 (append plist7 (list list40 list41 list42 list10)))
				(setq pno4 (+ pno4 4))
			)
			(setq list42 (cons 42 (* (cdr (nth 3 plist5)) -1)))
			(setq plist7 (append plist7 (list (nth 1 plist5) (nth 2 plist5) list42)))
		)
		(setq plist7 plist5)
	)
	plist7
)
;開いたポリラインの作図方向を統一
(defun ew_pl_ch6 (plist5 all_p / 1stx 1sty lastx lasty test3 plist6 pno4 list40 list41 list42 list10 plist7)
	(setq 1stx (cadr (car plist5)));最初のX座標
	(setq 1sty (caddr (car plist5)));その時のY座標
	(setq lastx (cadr (cadddr (reverse plist5))));最後のX座標
	(setq lasty (caddr (cadddr (reverse plist5))));その時のY座標
	(setq test3 nil)
	(if (= 1stx lastx);要素反転判断
		(if (< 1sty lasty)
			(setq test3 "ok")
		)
		(if (< 1stx lastx)
			(setq test3 "ok")
		)
	)
	(if test3;要素を反転
		(progn
			(setq plist6 (reverse plist5) plist7 (list (nth 3 plist6)) pno4 0)
			(repeat (- (cdr all_p) 1)
				(setq pno4 (+ pno4 4))
				(setq list40 (nth (+ pno4 2) plist6))
				(setq list41 (nth (+ pno4 1) plist6))
				(setq list42 (cons 42 (* (cdr (nth pno4 plist6)) -1)))
				(setq list10 (nth (+ pno4 3) plist6))
				(setq plist7 (append plist7 (list list40 list41 list42 list10)))
			)
			(setq list42 (cons 42 (* (cdr (nth 0 plist6)) -1)))
			(setq plist7 (append plist7 (list (nth 2 plist6) (nth 1 plist6) list42)))
		)
		(setq plist7 plist5)
	)
	plist7
)
;ポリライン処理
(defun ew_pl_ch7 (plist0 plist1 plist2 pno / plist2 last_p plist3 plist4 all_p plist5 close plist7 plist8 p1po p2lp p3p4ceap)
	(setq p1po (ew_pl_ch1 plist0));リストの最初を作成
	(setq plist1 (car p1po) pno (cadr p1po))
	(setq p2lp (ew_pl_ch2 plist1 pno plist0));座標の重なりを削除
	(setq plist2 (car p2lp) last_p (cadr p2lp))
	(setq p3p4ceap (ew_pl_ch3 plist2 last_p));閉じているか判断
	(setq plist3 (nth 0 p3p4ceap) plist4 (nth 1 p3p4ceap) close (nth 2 p3p4ceap) all_p (nth 3 p3p4ceap))
	(if (= 1 (cdr close))
		(setq plist5 (ew_pl_ch4 plist3 all_p));閉じたポリラインの基点を統一
		(setq plist5 plist3)
	)
	(if (= 1 (cdr close))
		(setq plist7 (ew_pl_ch5 plist5 all_p));閉じたポリラインの作図方向を統一
	)
	(if (= 0 (cdr close))
		(setq plist7 (ew_pl_ch6 plist5 all_p));開いたポリラインの作図方向を統一
	)
	(setq plist8 (append plist4 plist7 (list (last plist0))));全てを結合
	(entmod plist8)
)
;3点を通る円の中心と半径
(defun ew_p3_arc (cpt1 cpt2 cpt3 / cpt1x cpt1y cpt2x cpt2y cpt3x cpt3y aaa bbb ccc AA BB CC ctr rrr)
	(setq cpt1x (car cpt1) cpt1y (cadr cpt1))
	(setq cpt2x (car cpt2) cpt2y (cadr cpt2))
	(setq cpt3x (car cpt3) cpt3y (cadr cpt3))
	(setq aaa (+ (* cpt2x cpt2x) (* cpt2y cpt2y) (- (* cpt1x cpt1x)) (- (* cpt1y cpt1y))))
	(setq bbb (/ (* (+ (* cpt3x cpt3x) (* cpt3y cpt3y) (- (* cpt2x cpt2x)) (- (* cpt2y cpt2y))) (- cpt2y cpt1y)) (- cpt2y cpt3y)))
	(setq ccc (- (- cpt1x cpt2x) (/ (* (- cpt3x cpt2x) (- cpt2y cpt1y)) (- cpt2y cpt3y))))
	(setq AA (/ (+ aaa bbb) ccc))
	(setq BB (/ (+ (* cpt3x cpt3x) (* cpt3y cpt3y) (- (* cpt2x cpt2x)) (- (* cpt2y cpt2y)) (* AA cpt3x) (- (* AA cpt2x))) (- cpt2y cpt3y)))
	(setq CC (- (+ (* cpt1x cpt1x) (* cpt1y cpt1y) (* AA cpt1x) (* BB cpt1y))))
	(setq ctr (list (- (/ AA 2))(- (/ BB 2))));中心
	(setq rrr (sqrt (abs (- CC (* (/ AA 2) (/ AA 2)) (* (/ BB 2) (/ BB 2))))))
	(list ctr rrr)
)
;ポリライン円弧の中間点を算出
(defun ew_mid_arc (cpt1 cpt2 dist1 / cpt4x cpt4y ang12 dist2 distx disty cpt3)
	(setq cpt4x (+ (/ (- (car cpt2) (car cpt1)) 2) (car cpt1)))
	(setq cpt4y (+ (/ (- (cadr cpt2) (cadr cpt1)) 2) (cadr cpt1)))
	(setq ang12 (angle cpt1 cpt2))
	(setq dist2 (* (/ (distance cpt1 cpt2) 2) dist1))
	(setq distx (* (sin ang12) dist2))
	(setq disty (* (cos ang12) dist2))
	(setq cpt3 (list (+ cpt4x distx) (- cpt4y disty)))
	cpt3
)
;ポリラインの同じ円上の点を削除
(defun ew_plrr_ch2 (plist0 cdist1 cdist2 cpt1 cpt2 dist1 ccp5 ccp1 ccp2 cpt3 / ctr1 ctr2 ccps cpt4 count ctr rrr rr2 crrr dist2)
	(setq cpt3 (ew_mid_arc cpt1 cpt2 dist1));ポリライン円弧の中間点を算出
	(setq crrr (ew_p3_arc cpt1 cpt2 cpt3));3点を通る円の中心と半径
	(setq ctr (car crrr) rrr (cadr crrr))
	(setq ctr1 ctr count 1 rr2 rrr)
	(setq ctr2 ctr1);ダミー
	(setq ccps ccp1);起点座標
	(while (and (/= 0 cdist2) (= (rtos (car ctr1)) (rtos (car ctr2))) (= (rtos (cadr ctr1)) (rtos (cadr ctr2))));円弧の連続の時
		(setq cpt1 ccp2 cpt2 ccp5 dist1 cdist2)
		(setq cpt3 (ew_mid_arc cpt1 cpt2 dist1));円弧の中間点
		(setq crrr (ew_p3_arc cpt1 cpt2 cpt3));3点を通る円の中心と半径
		(setq ctr (car crrr) rrr (cdr crrr))
		(setq ctr2 ctr)
		(if (and (= (rtos (car ctr1)) (rtos (car ctr2))) (= (rtos (cadr ctr1)) (rtos (cadr ctr2))));円弧の連続の時
			(progn
				(setq pno (+ pno 4) count (1+ count))
				(setq ccp1 (cdr (nth (- pno 4) plist0)));前の座標
				(setq ccp2 (cdr (nth pno plist0)));今の座標
				(setq cdist1 (cdr (nth (- pno 1) plist0)));前の膨らみ
				(setq ccp5 (cdr (nth (+ pno 4) plist0)));次の座標
				(setq cdist2 (cdr (nth (+ pno 3) plist0)));次の膨らみ
			)
		)
	)
	(setq cpt4 (list (+ (/ (- (car ccp2) (car ccps)) 2) (car ccps)) (+ (/ (- (cadr ccp2) (cadr ccps)) 2) (cadr ccps))))
	(setq cpt3 (polar ctr1 (angle ctr1 cpt4) rr2))
	(if (= 1 count)
		(setq dist2 nil);削除していないとき
		(if (> 0 cdist1)
			(setq dist2 (- (/ (distance cpt4 cpt3) (distance ccps cpt4))))
			(setq dist2 (/ (distance cpt4 cpt3) (distance ccps cpt4)))
		)
	)
	dist2
)
;ポリラインの円弧座標を抽出
(defun ew_plrr_ch1 (pno plist0 / ccp1 ccp2 cdist1 ccp5 cdist2 dist1 dist2 cpt1 cpt2 plist2)
	(setq pno (+ pno 1) plist2 (list (nth pno plist0)))
	(setq pno (+ pno 4))
	(while (/= 210 (car (nth pno plist0)))
		(setq ccp1 (cdr (nth (- pno 4) plist0)));前の座標
		(setq cdist1 (cdr (nth (- pno 1) plist0)));前の膨らみ
		(setq ccp2 (cdr (nth pno plist0)));今の座標
		(setq cdist2 (cdr (nth (+ pno 3) plist0)));今の膨らみ
		(setq ccp5 (cdr (nth (+ pno 4) plist0)));次の座標
		(setq cpt1 ccp1 cpt2 ccp2 dist1 cdist1)
		(setq dist2 nil)
		(if (and (/= 0 cdist1) (/= 0 cdist2))
			(setq dist2 (ew_plrr_ch2 plist0 cdist1 cdist2 cpt1 cpt2 dist1 ccp5 ccp1 ccp2 cpt3));ポリラインの同じ円上の点を削除
		)
		(if dist2
			(setq plist2 (append plist2 (list (nth (- pno 3) plist0) (nth (- pno 2) plist0) (cons 42 dist2) (nth pno plist0))))
			(setq plist2 (append plist2 (list (nth (- pno 3) plist0) (nth (- pno 2) plist0) (nth (- pno 1) plist0) (nth pno plist0))))
		)
		(setq pno (+ pno 4))
	)
	(setq plist2 (append plist2 (list (nth (- pno 3) plist0) (nth (- pno 2) plist0) (nth (- pno 1) plist0))))
	plist2
)
;ポリラインの同一円上の円弧を結合
(defun ew_plrr_ch (plist0 / plist1 plist2 plist3 pno p1po)
	(setq p1po (ew_pl_ch1 plist0));リストの最初を作成
	(setq plist1 (car p1po) pno (cadr p1po))
	(setq plist2 (ew_plrr_ch1 pno plist0));ポリラインの円弧座標を抽出
	(setq plist3 (append plist1 plist2 (list (last plist0))));全てを結合
	(entmod plist3)
)
;ポリラインの同一直線座標を削除
(defun ew_plll_ch1 (pno plist0 / ccp1 ccp2 cdist1 ccp3 cdist2 dist1 plist2)
	(setq pno (+ pno 1) plist2 (list (nth pno plist0)))
	(while (/= 210 (car (nth (+ pno 4) plist0)))
		(setq pno (+ pno 4))
		(setq ccp1 (cdr (nth (- pno 4) plist0)));前の座標
		(setq cdist1 (cdr (nth (- pno 1) plist0)));前の膨らみ
		(setq ccp2 (cdr (nth pno plist0)));今の座標
		(setq cdist2 (cdr (nth (+ pno 3) plist0)));今の膨らみ
		(if (/= 210 (car (nth (+ pno 4) plist0)))
			(setq ccp3 (cdr (nth (+ pno 4) plist0)));次の座標
			(setq ccp3 (cdar plist2));最初の点
		)
		(if (and (= 0 cdist1) (= 0 cdist2));直線の連続の時
			(if (/= 210 (car (nth (+ pno 4) plist0)))
				(while (= (rtos (angle ccp1 ccp2)) (rtos (angle ccp2 ccp3)));同一角直線の連続の時　誤差を考慮
					(setq pno (+ pno 4))
					(setq ccp3 (cdr (nth (+ pno 4) plist0)))
				)
			)
		)
		(if (/= 210 (car (nth (+ pno 4) plist0)))
			(setq plist2 (append plist2 (list (nth (- pno 3) plist0) (nth (- pno 2) plist0) (nth (- pno 1) plist0) (nth pno plist0))))
			(if (= 0 (cdr (nth (- pno 1) plist0)));最後が円弧か直線か
				(if (/= 0 (cdr (assoc 70 plist0)));閉じたポリラインの時
					(if (/= (rtos (angle ccp1 ccp2)) (rtos (angle ccp2 (cdar plist2))));誤差を考慮
						(setq plist2 (append plist2 (list (nth (- pno 3) plist0) (nth (- pno 2) plist0) (nth (- pno 1) plist0) (nth pno plist0))))
					)
					(setq plist2 (append plist2 (list (nth (- pno 3) plist0) (nth (- pno 2) plist0) (nth (- pno 1) plist0) (nth pno plist0))));開いたポリラインの時
				)
				(setq plist2 (append plist2 (list (nth (- pno 3) plist0) (nth (- pno 2) plist0) (nth (- pno 1) plist0) (nth pno plist0))));円弧の場合
			)
		)
	)
	(setq pno (+ pno 4))
	(setq plist2 (append plist2 (list (nth (- pno 3) plist0) (nth (- pno 2) plist0) (nth (- pno 1) plist0))))
	plist2
)
;ポリラインの同一線上の点を結合
(defun ew_plll_ch (plist0 / pno p1po plist1 plist2 plist3)
	(setq p1po (ew_pl_ch1 plist0));リストの最初を作成
	(setq plist1 (car p1po) pno (cadr p1po))
	(setq plist2 (ew_plll_ch1 pno plist0));ポリラインの直線座標を抽出
	(setq plist3 (append plist1 plist2 (list (last plist0))));全てを結合
	(entmod plist3)
)
;全てのポリラインに処理を行う
(defun ew_pl_ch8 (plch_list / plist0 all pno0)
	(princ "\nポリライン処理中・・・")
	(setq all (sslength plch_list) pno0 all)
	(repeat all
		(setq pno0 (- pno0 1))
		(setq plist0 (entget (ssname plch_list pno0)'("ACAD")))
		(ew_pl_ch7 plist0 plist1 plist2 pno);ポリラインの作図方向を統一
		(setq plist0 (entget (ssname plch_list pno0)'("ACAD")))
		(ew_plrr_ch plist0);ポリラインの同一円上の円弧を結合
		(setq plist0 (entget (ssname plch_list pno0)'("ACAD")))
		(ew_plll_ch plist0);ポリラインの同一線上の点を結合
	)
	(princ)
)
;削除実行
(defun ew_all_parts (pt1 pt2 lay gosa / plist)
	;重なっている直線を省く
	(setq plist (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 0 "LINE")(cons 8 lay)(cons -4 "AND>"))));直線全選択
	(if plist (princ "\n直線検索中・・・"))
	(if plist (ew_line pt1 pt2 plist lay gosa))
	;重なっている円を省く
	(setq plist (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 0 "CIRCLE")(cons 8 lay)(cons -4 "AND>"))));円全選択
	(if plist (princ "\n円　検索中・・・"))
	(if plist (ew_circle pt1 pt2 plist lay gosa))
	;重なっている円弧を省く
	(setq plist (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 0 "ARC")(cons 8 lay)(cons -4 "AND>"))));円弧全選
	(if plist (princ "\n円弧検索中・・・"))
	(if plist (ew_arc pt1 pt2 lay gosa))
	;重なっているテキストを省く
	(setq plist (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 0 "TEXT")(cons 8 lay)(cons -4 "AND>"))));テキスト全選択
	(if plist (princ "\nテキスト検索中・・・"))
	(if plist (ew_text pt1 pt2 plist lay gosa))
	;重なっているマルチテキストを省く
	(setq plist (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 0 "MTEXT")(cons 8 lay)(cons -4 "AND>"))));マルチテキスト全選択
	(if plist (princ "\nマルチテキスト検索中・・・"))
	(if plist (ew_mtext pt1 pt2 plist lay gosa))
	;重なっている寸法を省く
	(setq plist (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 0 "DIMENSION")(cons 8 lay)(cons -4 "AND>"))));寸法全選択
	(if plist (princ "\n寸法検索中・・・"))
	(if plist (ew_dimention pt1 pt2 plist lay gosa))
	;重なっているリーダーを省く
	(setq plist (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 0 "LEADER")(cons 8 lay)(cons -4 "AND>"))));リーダー全選択
	(if plist (princ "\nリーダー検索中・・・"))
	(if plist (ew_leader pt1 pt2 plist lay gosa))
	;重なっているポリラインを省く
	(setq plist (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 0 "LWPOLYLINE")(cons 8 lay)(cons -4 "AND>"))));ポリライン全選択
	(if plist (princ "\nポリライン検索中・・・"))
	(if plist (ew_pline pt1 pt2 plist lay gosa))
	;重なっているスプラインを省く
	(setq plist (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 0 "SPLINE")(cons 8 lay)(cons -4 "AND>"))));スプライン全選択
	(if plist (princ "\nスプライン検索中・・・"))
	(if plist (ew_spline pt1 pt2 plist lay gosa))
	;重なっている楕円を省く
	(setq plist (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 0 "ELLIPSE")(cons 8 lay)(cons -4 "AND>"))));楕円全選択
	(if plist (princ "\n楕円検索中・・・"))
	(if plist (ew_ellipse pt1 pt2 plist lay gosa))
	;重なっている点を省く
	(setq plist (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 0 "POINT")(cons 8 lay)(cons -4 "AND>"))));楕円全選択
	(if plist (princ "\n点検索中・・・"))
	(if plist (ew_point pt1 pt2 plist lay gosa))
	;重なっているブロックを省く
	(setq plist (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 0 "INSERT")(cons 8 lay)(cons -4 "AND>"))));ブロック全選択
	(if plist (princ "\nブロック検索中・・・"))
	(if plist (ew_block pt1 pt2 plist lay gosa))
	(princ)
)
;カウントリセット
(defun ew_count_r (pt1 pt2 / plist)
	(setq plist (ssget "C" pt1 pt2 ));オブジェクト全選択
	(if plist (setq all_count0 (sslength plist))(setq all_count0 0))
	(setq plist (ssget "C" pt1 pt2 (list (cons 0 "LINE"))));直線全選択
	(if plist (setq line_count (sslength plist))(setq line_count 0))
	(setq plist (ssget "C" pt1 pt2 (list (cons 0 "CIRCLE"))));円全選択
	(if plist (setq circle_count (sslength plist))(setq circle_count 0))
	(setq plist (ssget "C" pt1 pt2 (list (cons 0 "ARC"))));円弧全選
	(if plist (setq arc_count (sslength plist))(setq arc_count 0))
	(setq plist (ssget "C" pt1 pt2 (list (cons 0 "TEXT"))));テキスト全選択
	(if plist (setq text_count (sslength plist))(setq text_count 0))
	(setq plist (ssget "C" pt1 pt2 (list (cons 0 "MTEXT"))));マルチテキスト全選択
	(if plist (setq mtex_count (sslength plist))(setq mtex_count 0))
	(setq plist (ssget "C" pt1 pt2 (list (cons 0 "DIMENSION"))));寸法全選択
	(if plist (setq dim_count (sslength plist))(setq dim_count 0))
	(setq plist (ssget "C" pt1 pt2 (list (cons 0 "LEADER"))));リーダー全選択
	(if plist (setq lead_count (sslength plist))(setq lead_count 0))
	(setq plist (ssget "C" pt1 pt2 (list (cons 0 "LWPOLYLINE"))));ポリライン全選択
	(if plist (setq pline_count (sslength plist))(setq pline_count 0))
	(setq plist (ssget "C" pt1 pt2 (list (cons 0 "SPLINE"))));スプライン全選択
	(if plist (setq spline_count (sslength plist))(setq spline_count 0))
	(setq plist (ssget "C" pt1 pt2 (list (cons 0 "ELLIPSE"))));楕円全選択
	(if plist (setq elpse_count (sslength plist))(setq elpse_count 0))
	(setq plist (ssget "C" pt1 pt2 (list (cons 0 "POINT"))));点全選択
	(if plist (setq point_count (sslength plist))(setq point_count 0))
	(setq plist (ssget "C" pt1 pt2 (list (cons 0 "INSERT"))));ブロック全選択
	(if plist (setq block_count (sslength plist))(setq block_count 0))
)
;未処理数計算
(defun ew_count_t (pt1 pt2 plist0 / all_count0 com0 lay_list pno p_nam kari lay_list1)
	(setq all_count1 (sslength plist0))
	(setq com0 (strcat "\n" (rtos all_count1)" 個のオブジェクト["));処理出来ない数
	(princ com0)
	(setq lay_list1 nil com0 "" pno all_count1)
	(repeat all_count1
		(setq pno (- pno 1) kari nil)
		(setq p_nam (list (cdr (assoc 0 (entget (ssname plist0 pno))))))
		(foreach n lay_list1 (if (= n p_nam)(setq kari "NG")))
		(if (= "NG" kari)
			(setq kari nil)
			(setq lay_list1 (cons p_nam lay_list1) com0 (strcat com0 " " (car p_nam)))
		)
	)
	(princ (strcat com0 " ]は処理出来ません。"));処理出来ないリスト
	(princ)
)
;削除数計算
(defun ew_count_e (pt1 pt2 / plist all_count1 plist0 com0 com1 com2 com3 com4 com5 com6 com7 com8 com9 com10 com11 com12 com)
	(setq plist (ssget "C" pt1 pt2 ));オブジェクト全選択
	(if plist (setq all_count1 (sslength plist))(setq all_count1 0))
	(setq plist0 (ssget "C" pt1 pt2 (list (cons 0 "LINE"))));直線全選択
	(if plist0 (setq line_count (- line_count (sslength plist0))))
	(setq plist0 (ssget "C" pt1 pt2 (list (cons 0 "CIRCLE"))));円全選択
	(if plist0 (setq circle_count (- circle_count (sslength plist0))))
	(setq plist0 (ssget "C" pt1 pt2 (list (cons 0 "ARC"))));円弧全選択
	(if plist0 (setq arc_count (- arc_count (sslength plist0))))
	(setq plist0 (ssget "C" pt1 pt2 (list (cons 0 "TEXT"))));テキスト全選択
	(if plist0 (setq text_count (- text_count (sslength plist0))))
	(setq plist0 (ssget "C" pt1 pt2 (list (cons 0 "MTEXT"))));マルチテキスト全選択
	(if plist0 (setq mtex_count (- mtex_count (sslength plist0))))
	(setq plist0 (ssget "C" pt1 pt2 (list (cons 0 "DIMENSION"))));寸法全選択
	(if plist0 (setq dim_count (- dim_count (sslength plist0))))
	(setq plist0 (ssget "C" pt1 pt2 (list (cons 0 "LEADER"))));リーダー全選択
	(if plist0 (setq lead_count (- lead_count (sslength plist0))))
	(setq plist0 (ssget "C" pt1 pt2 (list (cons 0 "LWPOLYLINE"))));ポリライン全選択
	(if plist0 (setq pline_count (- pline_count (sslength plist0))))
	(setq plist0 (ssget "C" pt1 pt2 (list (cons 0 "SPLINE"))));スプライン全選択
	(if plist0 (setq spline_count (- spline_count (sslength plist0))))
	(setq plist0 (ssget "C" pt1 pt2 (list (cons 0 "ELLIPSE"))));楕円全選択
	(if plist0 (setq elpse_count (- elpse_count (sslength plist0))))
	(setq plist0 (ssget "C" pt1 pt2 (list (cons 0 "POINT"))));点全選択
	(if plist0 (setq point_count (- point_count (sslength plist0))))
	(setq plist0 (ssget "C" pt1 pt2 (list (cons 0 "INSERT"))));ブロック全選択
	(if plist0 (setq block_count (- block_count (sslength plist0))))
	(setq com0 (strcat "\nオブジェクト数 " (rtos all_count0) " → " (rtos all_count1)))
	(princ com0)
	(setq plist0 (ssget "C" pt1 pt2 (list (cons -4 "<NOT")(cons -4 "<OR")
	;処理できるオブジェクトの種類
		(cons 0 "LINE")
		(cons 0 "CIRCLE")
		(cons 0 "ARC")
		(cons 0 "TEXT")
		(cons 0 "MTEXT")
		(cons 0 "DIMENSION")
		(cons 0 "LEADER")
		(cons 0 "LWPOLYLINE")
		(cons 0 "SPLINE")
		(cons 0 "ELLIPSE")
		(cons 0 "POINT")
		(cons 0 "INSERT")
	(cons -4 "OR>")(cons -4 "NOT>"))));処理不可能全数
	(if plist0 (ew_count_t pt1 pt2 plist0));未処理数計算
	(if (/= 0 line_count)(setq com1 (strcat "[直線" (rtos line_count) "] "))(setq com1 ""))
	(if (/= 0 circle_count)(setq com2 (strcat "[円" (rtos circle_count) "] "))(setq com2 ""))
	(if (/= 0 arc_count)(setq com3 (strcat "[円弧" (rtos arc_count) "] "))(setq com3 ""))
	(if (/= 0 text_count)(setq com4 (strcat "[テキスト" (rtos text_count) "] "))(setq com4 ""))
	(if (/= 0 mtex_count)(setq com5 (strcat "[マルチテキスト" (rtos mtex_count) "] "))(setq com5 ""))
	(if (/= 0 dim_count)(setq com6 (strcat "[寸法" (rtos dim_count) "] "))(setq com6 ""))
	(if (/= 0 lead_count)(setq com7 (strcat "[リーダー" (rtos lead_count) "] "))(setq com7 ""))
	(if (/= 0 pline_count)(setq com8 (strcat "[ポリライン" (rtos pline_count) "] "))(setq com8 ""))
	(if (/= 0 spline_count)(setq com9 (strcat "[スプライン" (rtos spline_count) "] "))(setq com9 ""))
	(if (/= 0 elpse_count)(setq com10 (strcat "[楕円" (rtos elpse_count) "] "))(setq com10 ""))
	(if (/= 0 point_count)(setq com11 (strcat "[点" (rtos point_count) "] "))(setq com11 ""))
	(if (/= 0 block_count)(setq com12 (strcat "[ブロック" (rtos block_count) "] "))(setq com12 ""))
	(if (/= "" (setq com (strcat com1 com2 com3 com4 com5 com6 com7 com8 com9 com10 com11 com12)))
		(princ (strcat "\n" com "を処理しました。"))
		(princ "\n処理するオブジェクトはありません。")
	)
	(princ)
)
;コマンド実行
(defun c:wes (/ gosa pt1 pt2 all_count0 line_count circle_count arc_count text_count mtex_count dim_count lead_count point_count pline_count spline_count elpse_count block_count nowl lay lays lay_list0 lay_list1 count plch_list tdel_all tdel)
	(setvar "cmdecho" 0)
	(command "undo" "be")
	(initget 134)
	(setq gosa (getpoint "\n 誤差範囲を入力<0.0001>:"))
	(if (= (type gosa) 'LIST)
		(progn;点だった場合２点目を指示
			(initget 1)
			(setq pt2 (getpoint gosa "\n 2 点目を指定"))
			(setq gosa (distance gosa pt2))
		)
		(if (= (type gosa) 'STR)
			(setq gosa (atof gosa))
			(setq gosa 0.0001)
		)
	)
	(setq pt1 (getpoint "\nCラバ-１点目"))
	(if pt1
		(progn
			(setq pt2 (getcorner pt1 "\nCラバ-２点目"))
			(if pt2
				(progn
					(ew_count_r pt1 pt2);カウントリセット
					(ew_gasou pt1 pt2);画層検索
					(setq plch_list (ssget "C" pt1 pt2 (list (cons 0 "LWPOLYLINE"))));ポリライン全選択
					(if plch_list (ew_pl_ch8 plch_list));ポリライン簡略化
					;画層ごとに処理
					(setq nowl (getvar "clayer") lay_list0 lay_list1)
					(repeat count
						(setq lay (car lay_list1))
						(setq lay_list1 (cdr lay_list1))
						(princ "\n")
						(princ (strcat "\n画層" lay))
						;削除実行
						(ew_all_parts pt1 pt2 lay gosa)
					)
					;空のテキストを省く
					(setq plist (ssget "X" (list (cons -4 "<AND")(cons 0 "TEXT,MTEXT")(cons 1 "")(cons -4 "AND>"))));空テキスト全選択
					(if plist 
						(progn
							(princ "\n空テキスト検索中・・・")
							(setq tdel_all (sslength plist))
							(initget "Y N")
							(setq tdel (getstring "図面内に空白のTEXTが有ります削除しますか？<Y>"))
							(if (/= (strcase tdel) "N")
								(progn
									(command "erase" plist "")
									(princ (strcat "空白のテキストを " (rtos tdel_all) " 削除しました。"))
								)
							)
						)
					)
					(command "undo" "e")
					(setvar "cmdecho" 1)
					(ew_count_e pt1 pt2);削除数計算
				)
				(princ "\nｷｬﾝｾﾙされました")
			)
		)
		(princ "\nｷｬﾝｾﾙされました")
	)
	(princ)
)
(princ "\nｺﾏﾝﾄﾞ名は『wes』です。")
(princ)