;;;-------------------------------------------------------------;;;
;;;既存線分から相対角度線作成 叩き台 by さとまさ 改 C9x4 + yuri	;;;
;;;-------------------------------------------------------------;;;
(defun C:kaidan (/
	INIT_LIST
	OLD_ERROR
	SP
	DWG_POINT
	R_L
;	ANG1		;勾配のグローバル変数
	KEY_WORD	;高さorPLINEのためのキーワード
	PL1
	ANG1L
;	TAKASA		;高さのグローバル変数
;	KODAN		;小段の幅のグローバル変数
	ANGLISTL
	XPTL1
	XPTL2
	)
;--------------------------------------------------------初期設定
	(setq INIT_LIST (act_syokisettei))
	(defun act_error (MSG)
		(setq *error* nil)
		(progn
			(act_syokimodosi INIT_LIST)
			(princ (strcat "erorr: " MSG))
			(princ)
		)
		(setq *error* OLD_ERROR)
		(princ)
	)
	(setq OLD_ERROR *error* *error* act_error)
;--------------------------------------------------------ユーザー入力
	(setq ANG1 (act_getreal "\n勾配を入力 (1:?):" ANG1))
	(setvar "osmode" 33)
	(setq SP (getpoint "\n始点を指示:"))
	(setvar "osmode" 0)
	(setq DWG_POINT (getpoint "\n法の方向を指示:"))
	(if (> (car SP) (car DWG_POINT))
		(setq R_L 'T)
	)
;高さorPLINEを選択
	(initget "p t")
	(setq KEY_WORD (getkword "(T=高さ/P=ポリライン)<T>:"))
	(setq PL1 (entget (car (entsel "\nポリラインを指示:"))))
;--------------------------------------------------------角度取得
	(setq ANG1L (atan (/ 1 ANG1)))
	(if R_L
		(setq ANG1L (- (* 0.5 PI) (- ANG1L (* 0.5 PI))))
	)
;--------------------------------------------------------高さありの場合の繰り返し
	(while (/= KEY_WORD "p")
		(setq TAKASA (act_getreal "\n 高さを入力" TAKASA))
		(setq KODAN (act_getreal "\n 小段の幅を入力" KODAN))
		(SETQ XPTL1
			(INTERS
				(list (car SP) (+ (cadr SP) TAKASA))
				(list (+ (car SP) 100) (+ (cadr SP) TAKASA))
				SP
				(POLAR SP ANG1L 100)
				NIL
			)
		)
		(setq XPTL2 (act_kaidan SP XPTL1 PL1))
;高さよりPLINEの方が低い場合
		(if (< (cadr XPTL2) (cadr XPTL1))
			(progn
				(setq XPTL1 XPTL2)
				(setq KEY_WORD "p")
			)
;高さと小段を描く
			(progn
				(command ".LINE" SP XPTL1 "")
				(if R_L
					(progn
						(command ".line" XPTL1 (list (- (car XPTL1) KODAN) (cadr XPTL1)) "")
						(setq SP (list (- (car XPTL1) KODAN) (cadr XPTL1)))
					)
					(progn
						(command ".line" XPTL1 (list (+ (car XPTL1) KODAN) (cadr XPTL1)) "")
						(setq SP (list (+ (car XPTL1) KODAN) (cadr XPTL1)))
					)
				)
				(initget "p t")
				(setq KEY_WORD (getkword "(T=高さ/P=ポリライン)<T>:"))
				(if (= KEY_WORD "p")
					(setq XPTL1 nil)
				)
			)
		)
	)
;--------------------------------------------------------PLINEまで描く
	(if (= XPTL1 nil)
		(setq XPTL1 (act_kaidan SP ANG1L PL1))
	)
	(command ".LINE" SP XPTL1 "")
;--------------------------------------------------------初期設定戻し
	(setq *error* OLD_ERROR)
	(act_syokimodosi INIT_LIST)
	(PRINC)
) ;_ <<defun
;--------------------------------------------------------
;		サブルーチン
;--------------------------------------------------------
;--------------------------------------------------------(1)
;	PLINE の頂点取得
;
(defun PLIST (ENTITY_DATA / 10_LIST ALL_10_LIST ALL_10_LIST_BACK FUKU_DATA)
	(while ENTITY_DATA
		(setq 10_LIST (car ENTITY_DATA))
		(if (= (car 10_LIST) 10)
			(if ALL_10_LIST
				(setq ALL_10_LIST (append ALL_10_LIST (list (cdr 10_LIST))))
				(setq ALL_10_LIST (list (cdr 10_LIST)))
			) ;_ <<if
		) ;_ <<if
		(setq ENTITY_DATA (cdr ENTITY_DATA))
	) ;_ <<while
	ALL_10_LIST
) ;_ <<defun
;--------------------------------------------------------(2)
;	デフォルト値を含むＧＥＴＲＥＡＬ関数
;	例 : (SETQ W 100.0)
;	(act_getreal "\n 数値を入力 :" W)
(defun act_getreal (MSG DEF / A)
	(if (not DEF)
		(setq DEF 0)
	)
	(prompt (strcat "\n" MSG "<" (rtos DEF 2 3)))
	(setq A (getSTRING " >: ")) ;_ END OF SETQ
	(if (/= "" A)
		(atof A)
		DEF
	)
)
;--------------------------------------------------------(3)
;;;	着地点のLISTを返す。
;;;
(defun act_kaidan (
	SP		;基準点
	PT_ANGLE	;長さありの時の点ＯＲ角度
	PL1		;PLINE
	/
	P10LIST
	P10LIST_BACK
	I
	KOUTEN
	)
;;PLINEの頂点のリストを取得
	(setq P10LIST (plist PL1))
	(if (> (car (car P10LIST)) (car (last P10LIST)))
		(setq P10LIST (reverse P10LIST))
	)
	(setq P10LIST_BACK P10LIST)
;;高さ入力があり、PLINEとまじわるとき
	(if (listp PT_ANGLE)
		(progn
			(setq I T)
			(while I
				(setq KOUTEN (inters SP PT_ANGLE (car P10LIST) (cadr P10LIST)))
				(if KOUTEN
					(setq I nil)
					(progn
						(setq P10LIST (cdr P10LIST))
						(if (= (length P10LIST) 1)
							(setq I nil)
						)
					)
				)
			)
;;高さ入力があり、PLINEとまじわらないとき
			(if (not KOUTEN)
				(setq KOUTEN PT_ANGLE)
			)
		)
	)
;;直接PLINEまで書くとき
	(if (not (listp PT_ANGLE))
		(progn
			(setq P10LIST P10LIST_BACK)
			(setq I T)
			(while I
				(setq KOUTEN
					(inters
						SP
						(polar SP PT_ANGLE 10000000)
						(car P10LIST)
						(cadr P10LIST)
					)
				)
				(if KOUTEN
					(setq I nil)
					(progn
						(setq P10LIST (cdr P10LIST))
						(if (= (length P10LIST) 1)
							(setq I nil)
						)
					)
				)
			)
		)
	)
	KOUTEN
) ;_ <<DEFUN
;--------------------------------------------------------(4)
;;;	初期設定ともどし
;;;
(defun act_syokisettei(/
	SYOKI_LIST	;;初期の設定のリスト
	OS      	;;ＯＳＮＡＰの値
	OR		;;直交の値
	ANGB     	;;０°の方向
	ANGD     	;;時計、反時計回り
	)
	(setq OS (cons "OSMODE" (getvar "osmode")))
	(setq OR (cons "ORTHOMODE" (getvar "ORTHOMODE")))
	(setq ANGB (cons "ANGBASE" (getvar "angbase")))
	(setq ANGD (cons "ANGDIR" (getvar "angdir")))
	(graphscr)
	(setvar "cmdecho" 0)
	(setvar "dimzin" 0)
	(command "undo" "be")
	(setvar "osmode" 0)
	(setvar "angbase" 0)
	(setvar "angdir" 0)
	(setvar "orthomode" 0)
	(setq SYOKI_LIST (list OS OR ANGB ANGD))
	SYOKI_LIST
)
(defun act_syokimodosi(
	INIT_LIST
	/
	SYS_LIST
	SYS_VAR
	)
	(setq SYS_LIST INIT_LIST)
	(while SYS_LIST
		(setq SYS_VAR (car SYS_LIST))
		(setvar (car SYS_VAR) (cdr SYS_VAR))
		(setq SYS_LIST (cdr SYS_LIST))
	)
	(command "undo" "e")
	(princ)
)