外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。
clispで楕円弧の長さ(表示画面のｽｹｰﾙ)を計測表示する
:clispで楕円弧の長さ(表示画面のｽｹｰﾙ)を計測表示する
@echo off
for /f "delims=:" %%n in ('findstr /n "^#!" %0') do (
more +%%n %0 | clisp -q > nul
)
goto:eof
REM #jww
REM #1ci 長さを計測する円・円弧を指示してください
REM #e
#!この次の行からプログラムを書いてください
;楕円弧の長さ(表示画面のｽｹｰﾙ)を計測表示する Simpson
;
; 2008/01/03 Ver.0.00 clisp による JW_CAD 外部変形
;
; プログラムは未調整！！
;
( ;乗余( x % y )計算をして倍精度実数値を返す
defun remainder (x y)
(to_f (* (signum x) (mod x y)))
)
( ;べき乗( x ^ y )計算をして倍精度実数値を返す
defun pow (x y)
(setq x (expt x y))
(if (complexp x) (to_f (realpart x)) x)
)
( ;１６進数のレイヤ番号を１０進数に変換する
defun hex (x)
(cond
( (regexp:match "^[0-9]$" x) (parse-integer x))
( (equal x (or "a" "A")) 10)
( (equal x (or "b" "B")) 11)
( (equal x (or "c" "C")) 12)
( (equal x (or "d" "D")) 13)
( (equal x (or "e" "E")) 14)
( (equal x (or "f" "F")) 15)
)
)
;
( ;文字列 "x" を 数値 xd0 (倍精度 double-float) に変換
defun to_f (x)
(if (equal x nil) (setq x "0"))
(if (listp x)
(mapcar #'to_f x)
(progn
(if (typep x 'double-float)
x
(progn
(if (stringp x) nil (setq x (write-to-string x)))
(if (search "e" x)
(progn
(setq s (search "e" x))
(read-from-string
(concatenate 'string (subseq x 0 s) "d" (subseq x (+ 1 s) (length x)))
)
) ;progn (search "e" x)
(if (search "d" x)
x
(read-from-string
(concatenate 'string x "d0")
)
)
)
) ;progn (typep x 'double-float)
)
) ;progn (listp x)
)
)
( ;数値 xd0 (倍精度 double-float) を 文字列 "x" に変換
defun to_s (x)
(if (equal x nil) (setq x 0))
(if (listp x)
(mapcar #'to_s x)
(progn
(if (stringp x) nil (setq x (write-to-string x)))
(if (search "d0" x)
(subseq x 0 (search "d" x))
(if (search "d" x)
(progn
(setq s (search "d" x))
(concatenate 'string (subseq x 0 s) "e" (subseq x (+ 1 s) (length x)))
)
x
)
)
) ;progn (listp x)
)
)
( ;文字列 "x" を 整数に変換
defun to_i (x)
(if (numberp x)
(* (signum x) (floor (abs x)))
(progn
(if (equal x nil) (setq x "0"))
(if (listp x)
(mapcar #'to_i x)
(progn
(if (stringp x) nil (setq x (write-to-string x)))
(parse-integer x)
)
)
)
)
)
( ;弧長を返す
; ci : (x y r p1 p2 w d)
defun cilength (ci)
(setq x (to_f (nth 0 ci)))
(setq y (to_f (nth 1 ci)))
(setq r (to_f (nth 2 ci)))
(setq p1 (to_f (nth 3 ci)))
(setq p2 (to_f (nth 4 ci)))
(setq w (to_f (nth 5 ci)))
(setq d (to_f (nth 6 ci)))
(if (> w 1d0)
(progn
(setq w (/ 1d0 w))
(setq r (/ r w))
(setq p1 (- p1 90))
(setq p2 (- p2 90))
)
)
(setq k (sqrt (- 1d0 (* w w))))
(setq ek (e k (/ pi 2d0)))
(loop while (< p1 0) do (setq p1 (+ p1 360)))
(loop while (>= p1 360) do (setq p1 (- p1 360)))
(loop while (< p2 0) do (setq p2 (+ p2 360)))
(loop while (>= p2 360) do (setq p2 (- p2 360)))
(if (= p1 p2)
(* 4d0 ek r)
(progn
(setq n1 (+ 1 (to_i (/ p1 90.0)) ))
(if (> n1 4) (setq n1 4))
(setq lp (+ (* ek (remainder (+ n1 1) 2)) (* (e k (* (apa n1 p1) (/ pi 180d0))) (pow -1d0 (- n1 1))) ))
(setq n2 (+ 1 (to_i (/ p2 90.0)) ))
(if (> n2 4) (setq n2 4))
(if (= n1 n2) (setq n1 (+ n1 4)))
(setq n3 (+ 5 (* 2 (to_i (/ (- n2 1) 2.0)))))
(setq lp (+ lp (+ (* ek (remainder (- n3 n1) 4)) (* (e k (* (apa n2 p2) (/ pi 180d0))) (pow -1d0 n2)) )))
(if (< lp 0) (setq lp (+ lp (* 4d0 ek))))
(* lp r)
)
)
)
(
defun apa (o p)
(setq x (* (- (* 90 (- (* 2 (to_i (/ (+ o 1) 2.0)) ) 1)) p) (pow -1 (- o 1)) ))
(to_f (floor x))
)
(
defun f (x k)
(sqrt (- 1d0 (pow (* k (sin x)) 2)))
)
(
defun e (k p)
(if (= k 0d0)
p
(progn
(setq n *n*)
(setq h (/ p (* n 2d0)))
(setq x h)
(setq s1 0d0)
(setq s2 (f x k))
(loop for i from 1 to (- n 1)
do
(setq x (+ x h))
(setq s1 (+ s1 (f x k)))
(setq x (+ x h))
(setq s2 (+ s2 (f x k)))
)
(* (/ h 3d0) (+ (f 0d0 k) (f p k) (* 4d0 s2) (* 2d0 s1)))
)
)
)
;本文
(setq *n* 60)
(setq olg nil)
( ;jwc_temp.txt から 入力
with-open-file (f "jwc_temp.txt" :direction :input)
(loop for line = (read-line f nil) while line do
(setq a (regexp:regexp-split "\\s\\+" line))
(if (regexp:match "^hs" line) (setq hs (cdr a)))
(if (regexp:match "^lg" line)
(progn
(setq plg (subseq line 2 3))
(if (equal olg nil) (setq olg plg))
)
)
(if (regexp:match "^ci" line)
(progn
(setq ci1 (cdr a))
(if (= (length ci1) 3) (setq ci1 (append ci1 (list 0 0 1 0))))
)
)
)
)
( ;準備計算
progn
(setq xsc (/ (to_f (nth (hex olg) hs)) (to_f (nth (hex plg) hs))))
)
( ;jwc_temp.txt へ 出力
with-open-file (g "jwc_temp.txt" :direction :output)
(format g "h#円弧長 L = ~,3f~%" (* (cilength ci1) xsc))
)
