E'DN
;エラー処理　
(DEFUN *ERROR* (MSG)
(PRINC "ERROR : 入力ミスです！ 再度実行して下さい。")
(PRINC MSG)
(TERPRI)
);ERROR END

;ラジアン変換　
(DEFUN DTR (A)
(* PI(/ A 180.0))
);DTR END

;ラジアンを普通の角度に変換する
(DEFUN FUT (B)
(* 180.0(/ B PI))
);FUT END

;実数−＞整数（文字）
(DEFUN SEISU (JITUS)
(SETQ	JITU(+ 0.0 JITUS)
	JIT1(FIX JITU)
	JIT2(* JIT1 10)
	JIT3(* JITU 10)
	SYO(FIX (- JIT3 JIT2))
);SETQ END
(IF	(= SYO 0)
	(SETQ	JITUSU(ITOA JIT1))
	(SETQ	JITUSU(STRCAT (ITOA JIT1) "." (ITOA SYO)))
);IF END
);SEISU LIST END

;実数→整数 （四捨五入）〔文字列→実数〕
(DEFUN SEISUU (JITUS)
(SETQ	JITU (+ 0.05 JITUS)
	JIT1 (FIX JITU)
	JIT2 (* JIT1 10)
	JIT3 (* JITU 10)
	SYOU (FIX (- JIT3 JIT2))
);SETQ END

(IF	(= SYOU 0)
	(SETQ	JITU_A (ITOA JIT1))
	(SETQ	JITU_A (STRCAT (ITOA JIT1) "." (ITOA SYOU)))
);IF END
(SETQ	JITUSU	(ATOF JITU_A))
);SEISUU END

;メインプログラム
(DEFUN C:BM_S ()
;(DEFUN C:QQ ()

(COMMAND "UCS" "W")
(COMMAND "OSNAP" "INT,ENDP")
(IF	(= DDMY nil)	(SETQ	DDMY ""))
(SETQ	SN (STRCASE (GETSTRING (STRCAT "\n 寸法方向は ？（Ｘ＝水平方向、Ｙ＝鉛直方向）:〈 "DDMY" 〉 ")))
);SETQ END
(IF (= SN "") (SETQ SN DDMY))
(SETQ	DDMY SN)

;水平方向寸法表示
(IF (= SN "X")


(PROGN	(IF	(= DIS nil)	(SETQ	DIS ""))
	(SETQ	SN1 (STRCASE (GETSTRING (STRCAT "\n 寸法線は ？（Ｈ＝水平, Ｃ＝直列） :〈 "DIS" 〉 ")))
	);SETQ END
	(IF (= SN1 "") (SETQ SN1 DIS))
	(SETQ	DIS SN1)

	(IF (= SN1 "H")
	(PROGN	(IF	(= YZ1 nil)	(SETQ	YZ1 0))
		(IF	(= YZ2 nil)	(SETQ	YZ2 0))
		(SETQ	XWP1 (GETPOINT (STRCAT "\n 寸法補助線始点(Ｙ座標点)を指示して下さい : 〈"(SEISU YZ1)"〉"))
			XWP2 (GETPOINT (STRCAT "\n 寸法線記入位置(Ｙ座標点)を指示して下さい : 〈"(SEISU YZ2)"〉"))
			X1 (CADR XWP1)
			X2 (CADR XWP2)
		);SETQ END
			(IF (= XWP1 nil) (SETQ X1 YZ1))
			(SETQ	YZ1 X1)
			(IF (= XWP2 nil) (SETQ X2 YZ2))
			(SETQ	YZ2 X2)
		(SETQ	XWP (LIST 0 X2)
			XOT1 (GETPOINT "\n 一点目を指示して下さい :")
			XOT2 (GETPOINT "\n 二点目を指示して下さい :")
			BM_SX (CAR XOT1);始点Ｘ座標
			BM_EX (CAR XOT2);終点Ｘ座標
			XPT1 (LIST BM_SX X1)
			XPT2 (LIST BM_EX X1)
		);SETQ END

		(COMMAND "OSNAP" "NON")

		(COMMAND "LAYER" "M" "DIM-B" "")
		(COMMAND "DIM" "RESTORE" "DOT1" "HORIZ" XPT1 XPT2 XWP "")

		(COMMAND "EXIT")
		(SETQ	KAISU 1)

	);PROGN END YES

	);IF END


	(IF (= SN1 "C")
		(PROGN	
			(WHILE
			(SETQ	XOT3 (GETPOINT "\n 二点目を指示 (SPACE:終了) :")
					BM_EX2 (CAR XOT3);終点Ｘ座標
			);SETQ END
			(IF (= KAISU 1) (SETQ PT XPT2))
			(SETQ	XPT3 (LIST BM_EX2 X1))

			(COMMAND "OSNAP" "NON")

			(COMMAND "LAYER" "M" "DIM-B" "")
			(COMMAND "DIM" "RESTORE" "DOT1" "HORIZ" PT XPT3 XWP "")
			(SETQ	PT XPT3
				KAISU 2
			);SETQ END

			(COMMAND "OSNAP" "INT,ENDP,CEN")
			(COMMAND "EXIT")
			);WHILE END


		);PROGN END


	);IF END

);PROGN END YES

);IF END



;鉛直方向寸法表示
(IF (= SN "Y")

(PROGN	(IF	(= DISY nil)	(SETQ	DISY ""))
	(SETQ	SN2 (STRCASE (GETSTRING (STRCAT "\n 寸法線は ？（Ｖ＝垂直, Ｃ＝直列） :〈 "DISY" 〉 ")))
	);SETQ END
	(IF (= SN2 "") (SETQ SN2 DISY))
	(SETQ	DISY SN2)

	(IF (= SN2 "V")
	(PROGN	(IF	(= XZ1 nil)	(SETQ	XZ1 0))
		(IF	(= XZ2 nil)	(SETQ	XZ2 0))
		(SETQ	YWP1 (GETPOINT (STRCAT "\n 寸法補助線始点(Ｘ座標点)を指示して下さい : 〈"(SEISU XZ1)"〉"))
			YWP2 (GETPOINT (STRCAT "\n 寸法線記入位置(Ｘ座標点)を指示して下さい : 〈"(SEISU XZ2)"〉"))
			Y1 (CAR YWP1)
			Y2 (CAR YWP2)
		);SETQ END
			(IF (= YWP1 nil) (SETQ Y1 XZ1))
			(SETQ	XZ1 Y1)
			(IF (= YWP2 nil) (SETQ Y2 XZ2))
			(SETQ	XZ2 Y2)
		(SETQ	YWP (LIST Y2 0)
			YOT1 (GETPOINT "\n 一点目を指示して下さい :")
			YOT2 (GETPOINT "\n 二点目を指示して下さい :")
			BM_SY (CADR YOT1);始点Ｙ座標
			BM_EY (CADR YOT2);終点Ｙ座標
			YPT1 (LIST Y1 BM_SY)
			YPT2 (LIST Y1 BM_EY)
		);SETQ END

		(COMMAND "OSNAP" "NON")

		(COMMAND "LAYER" "M" "DIM-B" "")
		(COMMAND "DIM" "RESTORE" "DOT1" "VERT" YPT1 YPT2 YWP "")

		(COMMAND "EXIT")
		(SETQ	KAI 1)

	);PROGN END YES

	);IF END

	(IF (= SN2 "C")
		(PROGN	
			(WHILE
			(SETQ	YOT3 (GETPOINT "\n 二点目を指示 (SPACE:終了) :")
					BM_EY2 (CADR YOT3);終点Ｙ座標
			);SETQ END
			(IF (= KAI 1) (SETQ PTY YPT2))
			(SETQ	YPT3 (LIST Y1 BM_EY2))

			(COMMAND "OSNAP" "NON")

			(COMMAND "LAYER" "M" "DIM-B" "")
			(COMMAND "DIM" "RESTORE" "DOT1" "VERT" PTY YPT3 YWP "")

			(SETQ	PTY YPT3
				KAI 2
			);SETQ END

			(COMMAND "OSNAP" "INT,ENDP,CEN")
			(COMMAND "EXIT")
			);WHILE END


		);PROGN END

	);IF END

);PROGN END YES

);IF END

(COMMAND "OSNAP" "INT,ENDP,CEN")
);LIST END