;==============================================================================
;【ソ フ ト名】  交点分解Lisp(Vir1.5)
;【著作権  者】  OKAP工房　おかぴー
;【動作  確認】  AutoCAD 2000 又は LTcom2000+AutoCADLT2000 確認済み
;【掲  載  日】  2000/04/10
;【ｿﾌﾄｳｪｱ種別】  フリーウェア
;【転載  条件】  要連絡
;【 ﾎｰﾑﾍﾟｰｼﾞ 】  http://homepage1.nifty.com/okap/
;【電子メール】  BQW04027@nifty.com
;==============================================================================
;このファイルには、当Lispをご利用いただく上での注意や制限事項などに関して記載しています。
;記載内容をよくお読みの上、本ソフトウェアをご使用ください。
;
;1. 当Lispについて
;	当Lispは、AutoCAD 2000　用に作成したAutoLispですが、他のバージョンでも使用できると思われます。
;
;2.実行方法
;	ファイルを解凍後、本フォルダ内のLispをAutoCADのサポートパスの通して有る場所に保存してください。
;　　その後AutoCADのコマンドラインから本アプリケーションをロードすると実行します。(load "intbreak")
;
;3.基本的な使い方
;	本アプリケーションをロードすると、Cラバー1点目2点目を聞いてきます。
;	1点目2点目のラバーで囲まれた内側の交点を抽出し、交点を分解します。
;	オブジェクトの数が増えるとそれだけ時間がかかります。
;	最初は少ない数のオブジェクトで実際に分解されることを確認してください。
;	☆分解出来るのは視覚的に交点が確認できる場所だけです。
;	　細かすぎて確認出来ないような交点は正常に分解されません。
;	☆中心線や点線の隙間に交点が有る場合は分解しない可能性が有ります。
;	　その場合はLTSCALEを大きくする等して対処してください。（今回のLISPには組み込みませんでした。）
;
;4.品質保証
;	いかなる場合においても生ずる障害に関し、OKAP工房側は一切責任を持ちません。
;	ご意見、感想、障害、使用方法などは BQW04027@nifty.com までメールをお願いします。
;
;5.使用上の注意
;	本ソフトは図面作図のため、また自分で使用するコマンドを作成するために使用してください。
;	転載する場合は連絡して下さい。
;	本バージョンからフリーウェアとなり、ソースを公開していますので自由に変更可能です。

;6.更新履歴
;	2000/04/10 公開
;	2003/6/7   フリーウェア化


;円と円の交点
(defun c_c_int (plist1 plist2 / c1x c1y rr1 c2x c2y rr2 mmm nnn aaa bbb ccc xx1 xx2 yy1 yy2);pp1 pp2 以外
	(setq c1x (car (cdr (assoc '10 (entget plist1)))));中心1X
	(setq c1y (cadr (cdr (assoc '10 (entget plist1)))));中心1Y
	(setq rr1 (cdr (assoc '40 (entget plist1))));半径1
	(setq c2x (car (cdr (assoc '10 (entget plist2)))));中心2X
	(setq c2y (cadr (cdr (assoc '10 (entget plist2)))));中心2Y
	(setq rr2 (cdr (assoc '40 (entget plist2))));半径2
	(if (/= "0" (rtos (- c2y c1y)));許容誤差
		(progn
			(setq mmm (/ (- c1x c2x) (- c2y c1y)))
			(setq nnn (/ (- (+ (* c2x c2x) (* c2y c2y) (* rr1 rr1)) (* c1x c1x) (* c1y c1y) (* rr2 rr2)) (- (* 2 c2y) (* 2 c1y))))
			(setq aaa (1+ (* mmm mmm)))
			(setq bbb (+ (* -2 c1x) (* 2 mmm nnn) (* -2 c1y mmm)))
			(setq ccc (+ (* c1x c1x) (* nnn nnn) (* -2 c1y nnn) (* c1y c1y) (* -1 rr1 rr1)))
			(if (< 0 (atof (rtos (- (* bbb bbb) (* 4 aaa ccc)))));許容誤差
				(progn ;解が2つの時
					(setq xx1 (/ (+ (- bbb) (sqrt (- (* bbb bbb) (* 4 aaa ccc)))) (* 2 aaa)))
					(setq xx2 (/ (- (- bbb) (sqrt (- (* bbb bbb) (* 4 aaa ccc)))) (* 2 aaa)))
					(setq yy1 (+ (* mmm xx1) nnn))
					(setq yy2 (+ (* mmm xx2) nnn))
					(setq pp1 (list xx1 yy1))
					(setq pp2 (list xx2 yy2))
				)
				(if (= "0" (rtos (- (* bbb bbb) (* 4 aaa ccc))));許容誤差
					(progn;解が1つの時
						(setq xx1 (/ (- bbb) (* 2 aaa)))
						(setq yy1 (+ (* mmm xx1) nnn))
						(setq pp1 (list xx1 yy1))
						(setq pp2 nil)
					)
					(setq pp1 nil pp2 nil);解が無いとき
				)
			)
		)
		(progn
			(setq nnn (/ (+ (- (* c2x c2x) (* c1x c1x)) (- (* rr1 rr1) (* rr2 rr2))) (- (* 2 c2x) (* 2 c1x))))
			(setq aaa 1)
			(setq bbb (- (* 2 c1y)))
			(setq ccc (+ (- (* c1y c1y) (* rr1 rr1)) (* (- nnn c1x) (- nnn c1x))))
			(if (< 0 (atof (rtos (- (* bbb bbb) (* 4 aaa ccc)))));許容誤差
				(progn ;解が2つの時
					(setq xx1 nnn)
					(setq xx2 nnn)
					(setq yy1 (/ (+ (- bbb) (sqrt (- (* bbb bbb) (* 4 aaa ccc)))) (* 2 aaa)))
					(setq yy2 (/ (- (- bbb) (sqrt (- (* bbb bbb) (* 4 aaa ccc)))) (* 2 aaa)))
					(setq pp1 (list xx1 yy1))
					(setq pp2 (list xx2 yy2))
				)
				(if (= "0" (rtos (- (* bbb bbb) (* 4 aaa ccc))));許容誤差
					(progn;解が1つの時
						(setq xx1 nnn)
						(setq yy1 c1x)
						(setq pp1 (list xx1 yy1))
						(setq pp2 nil)
					)
					(setq pp1 nil pp2 nil);解が無いとき
				)
			)
		)
	)
)
;円弧始点終点判断
(defun r_judge (cc2 rstr rend /);pp1 pp2 以外
	(if (/= nil pp1)
		(if (< rstr rend);終点が大きい
			(if (< (atof (rtos rstr)) (atof (rtos (angle cc2 pp1))));許容誤差
				(if (< (atof (rtos rend)) (atof (rtos (angle cc2 pp1))));許容誤差
					(setq pp1 nil);始点終点より大きい
				)
				(if (> (atof (rtos rstr)) (atof (rtos (angle cc2 pp1))));許容誤差
					(setq pp1 nil);始点より小さい
				)
			)
			(if (< (atof (rtos rend)) (atof (rtos (angle cc2 pp1))));許容誤差
				(if (> (atof (rtos rstr)) (atof (rtos (angle cc2 pp1))));許容誤差
					(setq pp1 nil);終点より大きく始点より小さい
				)
			)
		)
	)
	(if (/= nil pp2)
		(if (< rstr rend);終点が大きい
			(if (< (atof (rtos rstr)) (atof (rtos (angle cc2 pp2))));許容誤差
				(if (< (atof (rtos rend)) (atof (rtos (angle cc2 pp2))));許容誤差
					(setq pp2 nil);始点終点より大きい
				)
				(if (> (atof (rtos rstr)) (atof (rtos (angle cc2 pp2))));許容誤差
					(setq pp2 nil);始点より小さい
				)
			)
			(if (< (atof (rtos rend)) (atof (rtos (angle cc2 pp2))));許容誤差
				(if (> (atof (rtos rstr)) (atof (rtos (angle cc2 pp2))));許容誤差
					(setq pp2 nil);終点より大きく始点より小さい
				)
			)
		)
	)
)
;円弧と円弧の交点
(defun r_r_int (plist1 plist2 / cc2 rstr rend)
	(c_c_int plist1 plist2);円と円の交点
	(setq cc2 (cdr (assoc '10 (entget plist2))));中心
	(setq rstr (cdr (assoc '50 (entget plist2))));始点
	(setq rend (cdr (assoc '51 (entget plist2))));終点
	(if (/= nil rstr)
		(r_judge cc2 rstr rend);円弧始点終点判断
	)
	(setq cc2 (cdr (assoc '10 (entget plist1))));中心
	(setq rstr (cdr (assoc '50 (entget plist1))));始点
	(setq rend (cdr (assoc '51 (entget plist1))));終点
	(if (/= nil rstr)
		(r_judge cc2 rstr rend);円弧始点終点判断
	)
)
;円と円弧の交点
(defun c_r_int (plist1 plist2 / kari obje)
	(setq kari plist1)
	(setq obje (cdr (assoc '0 (entget plist2))))
	(if (= obje "CIRCLE")
		(progn
			(setq plist1 plist2);入れ替える
			(setq plist2 kari)
			(r_r_int plist1 plist2);円弧と円弧の交点
			(setq plist2 plist1);元に戻す
			(setq plist1 kari)
		)
		(r_r_int plist1 plist2);円弧と円弧の交点
	)
)
;方程式1
(defun equation1 (c1x c1y rr1 l1x l1y l2x l2y / aaa bbb ccc yy1 yy2);pp1 pp2 以外
	(setq aaa 1)
	(setq bbb (* -2 c1y))
	(setq ccc (+ (* c1y c1y) (* -1 rr1 rr1) (* (- l1x c1x) (- l1x c1x))))
	(if (< 0 (atof (rtos (- (* bbb bbb) (* 4 aaa ccc)))));許容誤差
		(progn ;解が2つの時
			(setq yy1 (/ (+ (- bbb) (sqrt (- (* bbb bbb) (* 4 aaa ccc)))) (* 2 aaa)))
			(setq yy2 (/ (- (- bbb) (sqrt (- (* bbb bbb) (* 4 aaa ccc)))) (* 2 aaa)))
			(setq pp1 (list l1x yy1))
			(setq pp2 (list l1x yy2))
		)
		(if (= "0" (rtos (- (* bbb bbb) (* 4 aaa ccc))));許容誤差
			(progn;解が1つの時
				(setq yy1 (/ (- bbb) (* 2 aaa)))
				(setq pp1 (list l1x yy1))
				(setq pp2 nil)
			)
			(setq pp1 nil pp2 nil);解が無いとき
		)
	)
)
;方程式2
(defun equation2 (c1x c1y rr1 l1x l1y l2x l2y / l1c l1d aaa bbb ccc xx1 xx2 yy1 yy2);pp1 pp2 以外
	(progn
		(if (= 0 (- l1y l2y))
			(setq l1c 0);傾き0の時 Y=a					c
			(setq l1c (/ (- l1y l2y) (- l1x l2x)));		c
		)
		(setq l1d (- l1y (* l1c l1x)));					d
		(setq aaa (1+ (* l1c l1c)))
		(setq bbb (+ (* -2 c1x) (* 2 l1c l1d) (* -2 c1y l1c)))
		(setq ccc (+ (* c1x c1x) (* l1d l1d) (* -2 c1y l1d) (* c1y c1y) (* -1 rr1 rr1)))
		(if (< 0 (atof (rtos (- (* bbb bbb) (* 4 aaa ccc)))));許容誤差
			(progn ;解が2つの時
				(setq xx1 (/ (+ (- bbb) (sqrt (- (* bbb bbb) (* 4 aaa ccc)))) (* 2 aaa)))
				(setq xx2 (/ (- (- bbb) (sqrt (- (* bbb bbb) (* 4 aaa ccc)))) (* 2 aaa)))
				(setq yy1 (+ (* l1c xx1) l1d))
				(setq yy2 (+ (* l1c xx2) l1d))
				(setq pp1 (list xx1 yy1))
				(setq pp2 (list xx2 yy2))
			)
			(if (= "0" (rtos (- (* bbb bbb) (* 4 aaa ccc))));許容誤差
				(progn;解が1つの時
					(setq xx1 (/ (- bbb) (* 2 aaa)))
					(setq yy1 (+ (* l1c xx1) l1d))
					(setq pp1 (list xx1 yy1))
					(setq pp2 nil)
				)
				(setq pp1 nil pp2 nil);解が無いとき
			)
		)
	)
)
;直線と円の交点1
(defun l_c_int1 (plist1 plist2 / c1x c1y rr1 l1x l1y l2x l2y);pp1 pp2 以外
	(setq c1x (car (cdr (assoc '10 (entget plist1)))));中心X	a
	(setq c1y (cadr (cdr (assoc '10 (entget plist1)))));中心Y	b
	(setq rr1 (cdr (assoc '40 (entget plist1))));半径			r
	(setq l1x (car (cdr (assoc '10 (entget plist2)))));始点X
	(setq l1y (cadr (cdr (assoc '10 (entget plist2)))));始点Y
	(setq l2x (car (cdr (assoc '11 (entget plist2)))));終点X
	(setq l2y (cadr (cdr (assoc '11 (entget plist2)))));終点Y
	(if (= 0 (- l1x l2x))
		(equation1 c1x c1y rr1 l1x l1y l2x l2y);方程式1
		(equation2 c1x c1y rr1 l1x l1y l2x l2y);方程式2
	)
	(if (/= nil pp1)
		(if (= nil (inters (getvar "vsmax") pp1 (list l1x l1y) (list l2x l2y)))
			(setq pp1 nil);直線上に交点がないとき
		)
	)
	(if (/= nil pp2)
		(if (= nil (inters (getvar "vsmax") pp2 (list l1x l1y) (list l2x l2y)))
			(setq pp2 nil);直線上に交点がないとき
		)
	)
)
;直線と円の交点2
(defun l_c_int2 (plist1 plist2 / kari obje)
	(setq obje (cdr (assoc '0 (entget plist1))))
	(if (= obje "LINE")
		(progn
			(setq kari plist1);入れ替える
			(setq plist1 plist2)
			(setq plist2 kari)
			(l_c_int1 plist1 plist2);直線と円の交点1
			(setq plist2 plist1);元に戻す
			(setq plist1 kari)
		)
		(l_c_int1 plist1 plist2);直線と円の交点1
	)
)
;直線と円弧の交点
(defun l_r_int (plist1 plist2 / cc2 rstr rend ll1 ll2)
	(l_c_int2 plist1 plist2);直線と円の交点2
	(if (= "LINE" (cdr (assoc '0 (entget plist1))))
		(progn
			(setq cc2 (cdr (assoc '10 (entget plist2))));中心
			(setq rstr (cdr (assoc '50 (entget plist2))));始点
			(setq rend (cdr (assoc '51 (entget plist2))));終点
			(setq ll1 (cdr (assoc '10 (entget plist1))));始点
			(setq ll2 (cdr (assoc '11 (entget plist1))));終点
		)
		(progn
			(setq cc2 (cdr (assoc '10 (entget plist1))));中心
			(setq rstr (cdr (assoc '50 (entget plist1))));始点
			(setq rend (cdr (assoc '51 (entget plist1))));終点
			(setq ll1 (cdr (assoc '10 (entget plist2))));始点
			(setq ll2 (cdr (assoc '11 (entget plist2))));終点
		)
	)
	(r_judge cc2 rstr rend);円弧始点終点判断
)
;直線と直線の交点
(defun l_l_int (plist1 plist2 / l1s l1e l2s l2e);pp1 以外
	(setq l1s (cdr (assoc '10 (entget plist1))));始点1
	(setq l1e (cdr (assoc '11 (entget plist1))));終点1
	(setq l2s (cdr (assoc '10 (entget plist2))));始点2
	(setq l2e (cdr (assoc '11 (entget plist2))));終点2
	(setq pp1 (inters l1s l1e l2s l2e))
)
;長さ0円弧処理
(defun 0arc (plist1 plist2 object_1 object_2 /)
	(if (= "ARC" object_1)
		(if (= (cdr (assoc '50 (entget plist1))) (cdr (assoc '51 (entget plist1))))
			(progn
				(command "erase" plist1 "")
				(setq object_1 nil)
			)
		)
		(if (= (cdr (assoc '50 (entget plist2))) (cdr (assoc '51 (entget plist2))))
			(progn
				(command "erase" plist2 "")
				(setq object_2 nil)
			)
		)
	)
)
;振り分け実行
(defun huriwake (plist1 plist2 / object_1 object_2)
	(setq object_1 (cdr (assoc '0 (entget plist1))));種類1
	(setq object_2 (cdr (assoc '0 (entget plist2))));種類2
	(if (= "ARC" object_1)
		(0arc plist1 plist2 object_1 object_2);長さ0円弧処理
	)
	(if (= "ARC" object_2)
		(0arc plist1 plist2 object_1 object_2);長さ0円弧処理
	)
	(if (= "CIRCLE" object_1)
		(if (= "CIRCLE" object_2)
			(c_c_int plist1 plist2);円と円の交点
			(if (= "ARC" object_2)
				(c_r_int plist1 plist2);円と円弧の交点
				(if (= "LINE" object_2)
					(l_c_int2 plist1 plist2);直線と円の交点2
				)
			)
		)
	)
	(if (= "ARC" object_1)
		(if (= "CIRCLE" object_2)
			(c_r_int plist1 plist2);円と円弧の交点
			(if (= "ARC" object_2)
				(r_r_int plist1 plist2);円弧と円弧の交点
				(if (= "LINE" object_2)
					(l_r_int plist1 plist2);直線と円弧の交点
				)
			)
		)
	)
	(if (= "LINE" object_1)
		(if (= "CIRCLE" object_2)
			(l_c_int2 plist1 plist2);直線と円の交点2
			(if (= "ARC" object_2)
				(l_r_int plist1 plist2);直線と円弧の交点
				(if (= "LINE" object_2)
					(l_l_int plist1 plist2);直線と直線の交点
				)
			)
		)
	)
)
;カウンター
(defun count_all (all1 pno1 com_mode /)
	(if (= (fix (* all1 0.01)) (- all1 pno1))(princ (strcat "\n" (rtos (- all1 pno1)) " / " (rtos all1) " 交点" com_mode "・・・10%")))
	(if (= (fix (* all1 0.1)) (- all1 pno1))(princ (strcat "\n" (rtos (- all1 pno1)) " / " (rtos all1) " 交点" com_mode "・・・20%")))
	(if (= (fix (* all1 0.2)) (- all1 pno1))(princ (strcat "\n" (rtos (- all1 pno1)) " / " (rtos all1) " 交点" com_mode "・・・30%")))
	(if (= (fix (* all1 0.3)) (- all1 pno1))(princ (strcat "\n" (rtos (- all1 pno1)) " / " (rtos all1) " 交点" com_mode "・・・40%")))
	(if (= (fix (* all1 0.4)) (- all1 pno1))(princ (strcat "\n" (rtos (- all1 pno1)) " / " (rtos all1) " 交点" com_mode "・・・50%")))
	(if (= (fix (* all1 0.5)) (- all1 pno1))(princ (strcat "\n" (rtos (- all1 pno1)) " / " (rtos all1) " 交点" com_mode "・・・60%")))
	(if (= (fix (* all1 0.6)) (- all1 pno1))(princ (strcat "\n" (rtos (- all1 pno1)) " / " (rtos all1) " 交点" com_mode "・・・70%")))
	(if (= (fix (* all1 0.7)) (- all1 pno1))(princ (strcat "\n" (rtos (- all1 pno1)) " / " (rtos all1) " 交点" com_mode "・・・80%")))
	(if (= (fix (* all1 0.8)) (- all1 pno1))(princ (strcat "\n" (rtos (- all1 pno1)) " / " (rtos all1) " 交点" com_mode "・・・90%")))
	(if (= (fix (* all1 0.9)) (- all1 pno1))(princ (strcat "\n" (rtos (- all1 pno1)) " / " (rtos all1) " 交点" com_mode "・・・100%")))
)
;交点処理
(defun int_make (pt1 pt2 / p_minx p_maxx p_miny p_maxy);all_point以外
	(if (< (car pt1) (car pt2))
		(setq p_minx (car pt1) p_maxx (car pt2))
		(setq p_minx (car pt2) p_maxx (car pt1))
	)
	(if (< (cadr pt1) (cadr pt2))
		(setq p_miny (cadr pt1) p_maxy (cadr pt2))
		(setq p_miny (cadr pt2) p_maxy (cadr pt1))
	)
	(if (/= nil pp1)
		(if (< p_minx (car pp1))
			(if (> p_maxx (car pp1))
				(if (< p_miny (cadr pp1))
					(if (> p_maxy (cadr pp1))
						(progn;Cラバーの中に有るか
							(command "point" pp1)
							(setq all_point (cons pp1 all_point))
						)
					)
				)
			)
		)
	)
	(if (/= nil pp2)
		(if (< p_minx (car pp2))
			(if (> p_maxx (car pp2))
				(if (< p_miny (cadr pp2))
					(if (> p_maxy (cadr pp2))
						(progn;Cラバーの中に有るか
							(command "point" pp2)
							(setq all_point (cons pp2 all_point))
						)
					)
				)
			)
		)
	)
)
;交点抽出2
(defun int_get2 (pt1 pt2 plist1 plist2 / pp1 pp2)
	(setq pp1 nil pp2 nil)
	(huriwake plist1 plist2);振り分け実行
	(if (/= nil pp1)
		(if (= nil (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 10 pp1)(cons 0 "POINT")(cons -4 "AND>"))))
			(int_make pt1 pt2);交点処理
		)
	)
	(if (/= nil pp2)
		(if (= nil (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 10 pp2)(cons 0 "POINT")(cons -4 "AND>"))))
			(int_make pt1 pt2);交点処理
		)
	)
)
;交点抽出1
(defun int_get1 (pt1 pt2 plist / all1 pno1 com_mode plist1 all2 pno2 plist2)
	(setq all1 (sslength plist));全数
	(setq pno1 all1)
	(repeat all1
		(setq com_mode "抽出中")
		(count_all all1 pno1 com_mode);カウンター
		(setq pno1 (1- pno1))
		(setq plist1 (ssname plist pno1))
		(setq all2 (sslength plist));全数
		(setq pno2 all2)
		(repeat all2
			(setq pno2 (1- pno2))
			(setq plist2 (ssname plist pno2))
			(if (/= (cdr (assoc '5 (entget plist1))) (cdr (assoc '5 (entget plist2))))
				(int_get2 pt1 pt2 plist1 plist2);交点抽出2
			)
		)
	)
)
;円上に点が2つ以上有ったら一個所だけBREAKして円弧の組み合わせにする
(defun c_break (pt1 pt2 / plist1 all1 pno1 ccc rrr plist2 all2 pno2 ccx ccy pp2 pp2x pp2y plist3 all3 pno3 pp3 pp3x pp3y)
	(setq plist1 (ssget "C" pt1 pt2 (list (cons 0 "CIRCLE"))));円全選択
	(if (/= nil plist1)
		(progn
			(setq all1 (sslength plist1) pno1 all1)
			(repeat all1;円1全部繰り返し
				(setq pno1 (1- pno1))
				(setq ccc (cdr (assoc '10 (entget (ssname plist1 pno1)))));中心
				(setq rrr (cdr (assoc '40 (entget (ssname plist1 pno1)))));半径
				(setq plist2 (ssget "C" pt1 pt2 (list (cons 0 "POINT"))));点2全選択
				(setq all2 (sslength plist2) pno2 all2)
				(setq pno2 all2)
				(repeat all2;点2全部繰り返し
					(setq pno2 (1- pno2))
					(setq ccx (car ccc) ccy (cadr ccc))
					(setq pp2 (cdr (assoc '10 (entget (ssname plist2 pno2)))));中心
					(setq  pp2x (car pp2) pp2y (cadr pp2))
					(if (/= (rtos (* (- pp2x ccx) (- pp2x ccx))) (rtos (- (* rrr rrr) (* (- pp2y ccy) (- pp2y ccy)))))(setq pp2 nil));点2が円上に有るか
					(if (/= nil pp2)
						(progn
							(setq plist3 (ssget "C" pt1 pt2 (list (cons 0 "POINT"))));点3全選択
							(setq all3 (sslength plist3))
							(setq pno3 all3)
							(repeat all3;点3全部繰り返し
								(setq pno3 (1- pno3))
								(setq pp3 (cdr (assoc '10 (entget (ssname plist3 pno3)))));中心
								(setq pp3x (car pp3))
								(setq pp3y (cadr pp3))
								(if (/= (rtos (* (- pp3x ccx) (- pp3x ccx))) (rtos (- (* rrr rrr) (* (- pp3y ccy) (- pp3y ccy)))))
									(setq pp3 nil)
								);点3が円上に有るか
								(if (= (car pp2) (car pp3))
									(if (= (cadr pp2) (cadr pp3))
										(setq pp3 nil)
									)
								);点2と同じでないかpp3
								(if (/= nil pp3)
									(if (/= nil (ssget "C" pt1 pt2 (list (cons -4 "<AND")(cons 0 "CIRCLE")(cons 10 ccc)(cons 40 rrr)(cons -4 "AND>"))))
										(command "break" (ssname plist1 pno1) pp2 pp3 "arc" "c" ccc pp2 pp3);break実行
									)
								)
							)
						)
					)
				)
			)
		)
	)
)
;交点を全て分割
(defun break_all (/ break_point all1 pno1 com_mode pp0 name)
	(setq break_point (ssget "C" pt1 pt2 (list ( cons 0 "point"))));点全選択
	(if (/= nil break_point)
		(progn
			(setq all1 (sslength break_point))
			(setq pno1 all1)
			(repeat all1
				(setq com_mode "分解中")
				(count_all all1 pno1 com_mode);カウンター
				(setq pno1 (1- pno1))
				(setq pp0 (cdr (assoc '10 (entget (ssname break_point pno1)))))
				(setq name 100)
				(if (/= nil pp0)
					(while (/= nil (ssget pp0));オブジェクトが無くなるまで繰り返す
						(if (/= "POINT" (cdr (assoc '0 (entget (ssname (ssget pp0) 0)))))
							(progn
								(setq name (1+ name))
								(command "break" (ssget pp0) "_non" pp0 "_non" pp0)
								(command "-block" (strcat "kari" (substr (rtos name) 2 2)) "_non" pp0 (ssget pp0) "");分割済みブロック化
							)
							(command "erase" (ssget pp0) "")
						)
					)
				)
				(if (/= nil pp0)
					(while (> name 100);ブロック化した数だけ繰り返す
						(command "-insert" (strcat "*kari" (substr (rtos name) 2 2)) "_non" pp0 "" "");分割済み挿入
						(setq name (1- name))
					)
				)
			)
			(princ "\n")
			(if (/= nil part_sunpou)
				(command "-insert" "*kari00" pt1 "" "")
			)
			(setq part_sunpou nil)
			(command "purge" "b" "kari*" "n")
		)
		(princ "\n交点が見つかりません")
	)
)
;交点チェック
(defun blip_on (all_point /)
	(if (/= nil (car all_point))
		(progn
			(princ "\n終了処理中・・・")
			(while (/= nil all_point)
				(command "point" (car all_point) "erase" (entlast) "");ブレイク点を残すため
				(setq all_point (cdr all_point))
			)
			(princ "\nｺﾏﾝﾄﾞ交点ブレイク完了")
		)
	)
)
;ゴミ処理
(defun erase_dust (pt1 pt2 / part_all all1 pno1 rad1 rad2)
	(setq part_all (ssget "C" pt1 pt2 (list ( cons 0 "ARC"))));円弧全選択
	(if (/= nil part_all)
		(progn
			(setq all1 (sslength part_all))
			(setq pno1 all1)
			(repeat all1
				(setq pno1 (1- pno1))
				(setq rad1 (cdr (assoc '50 (entget (ssname part_all pno1)))))
				(setq rad2 (cdr (assoc '51 (entget (ssname part_all pno1)))))
				(if (= "0" (rtos (- rad1 rad2)));許容誤差
					(command "erase" (ssname part_all pno1) "")
				)
			)
		)
	)
	(setq part_all (ssget "C" pt1 pt2 (list ( cons 0 "LINE"))));直線全選択
	(if (/= nil part_all)
		(progn
			(setq all1 (sslength part_all))
			(setq pno1 all1)
			(repeat all1
				(setq pno1 (1- pno1))
				(setq rad1 (cdr (assoc '10 (entget (ssname part_all pno1)))))
				(setq rad2 (cdr (assoc '11 (entget (ssname part_all pno1)))))
				(if (= 0 (distance rad1 rad2))
					(command "erase" (ssname part_all pno1) "")
				)
			)
		)
	)
)
;寸法線等ブレイクできないものを回避
(defun sunpou (pt1 pt2 /);part_sunpouを残す
	(setq part_sunpou (ssget "C" pt1 pt2 (list (cons -4 "<NOT")(cons 0 "LINE")(cons -4 "NOT>")(cons -4 "<NOT")(cons 0 "ARC")(cons -4 "NOT>")(cons -4 "<NOT")(cons 0 "CIRCLE")(cons -4 "NOT>"))))
	(if (/= nil part_sunpou)
		(command "-block" "kari00" pt1 part_sunpou "")
	)
)
;コマンド実行
(defun int_break (/ pt1 pt2 back_osmode back_cmdecho back_expert back_blipmode pp1 pp2 all_point plist back_pickbox)
	(setq back_cmdecho (getvar "cmdecho"))
	(setq back_pickbox (getvar "pickbox"))
	(setq back_osmode (getvar "osmode"))
	(setq back_expert (getvar "expert"))
	(setq back_blipmode (getvar "blipmode"))
	(setvar "cmdecho" 0)
	(command "undo" "be")
	(setq pt1 (getpoint "\nCラバー１点目"))
	(setq pt2 (getcorner pt1 "\nCラバ-２点目"))
	(setvar "osmode" 0)
	(setvar "expert" 5)
	(setvar "blipmode" 1)
	(setq pp1 nil pp2 nil all_point nil)
	(setq plist (ssget "C" pt1 pt2))
	(erase_dust pt1 pt2);ゴミ処理
	(sunpou pt1 pt2);寸法線等ブレイクできないものを回避
	(if (/= nil plist)
		(int_get1 pt1 pt2 plist);交点を抽出
	)
	(setvar "blipmode" 0);円の中心を記録しないようにするため
	(c_break pt1 pt2);円上に点が2つ以上有ったら一個所だけBREAKして円弧の組み合わせにする
	(setvar "blipmode" 1)
	(setvar "pickbox" 1);通常精度1予想外の所を切る可能性あり 最高精度0切らない可能性あり
	(break_all);交点を全て分割
	(if (/= nil part_sunpou)
		(command "-insert" "*kari00" pt1 "" "")
	)
	(setq part_sunpou nil)
	(erase_dust pt1 pt2);ゴミ処理
	(blip_on all_point);交点チェック
	(command "undo" "e")
	(setvar "osmode" back_osmode)
	(setvar "cmdecho" back_cmdecho)
	(setvar "expert" back_expert)
	(setvar "pickbox" back_pickbox)
	(setvar "blipmode" back_blipmode)
)
;AutoLISPのエラー処理
(defun *myerror* ( msg )
	(command "undo" "e")
	(setvar "osmode" back_osmode)
	(setvar "cmdecho" back_cmdecho)
	(setvar "expert" back_expert)
	(setvar "pickbox" back_pickbox)
	(setvar "blipmode" back_blipmode)
	(setq *error* m:err m:err nil)
	(princ)
)
(defun c:intbreak (/)
	(setq m:err *error* *error* *myerror*)
	(int_break)
	(setq *error* m:err m:err nil)
	(princ)
)
(princ "\nｺﾏﾝﾄﾞ名は『intbreak』です。")
(princ)