外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。
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 #bz
REM #e
#!この次の行からプログラムを書いてください
;ユーザ定義関数
( ;文字列 "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)
)
)
( ;線長を返す
; x : (x1 y1 x2 y2)
defun lnlength (x)
(setq x1 (to_f (nth 0 x)))
(setq y1 (to_f (nth 1 x)))
(setq x2 (to_f (nth 2 x)))
(setq y2 (to_f (nth 3 x)))
(sqrt (+ (* (- x2 x1) (- x2 x1)) (* (- y2 y1) (- y2 y1))))
)
( ;２点間の距離を返す
; x : (x1 y1)
; y : (x2 y2)
defun ptdist (x y)
(lnlength (append x y))
)
(
defun polarto (pt r d)
(setq x1 (to_f (nth 0 pt)))
(setq y1 (to_f (nth 1 pt)))
(list (+ x1 (* r (cos d))) (+ y1 (* r (sin d))))
)
(
defun arrow (pt1 d pm &optional (size 3d0) (xang 60d0) (xan2 90d0))
(setq l (* (* -1 size) pm))
(setq a (/ (* xang (/ pi 180)) 2d0))
(setq pt2 (polarto pt1 l (- d a)))
(setq pt4 (polarto pt1 l (+ d a)))
(if (= xan2 180)
(append pt1 pt2 pt4)
(progn
(setq c (- (cos a) (* (sin a) (tan (* (- 90 (/ xan2 2d0)) (/ pi 180))))))
(setq pt3 (polarto pt1 (* l c) d))
(append pt1 pt2 pt3 pt4)
)
)
)
(
defun cipoint (ci &optional (pm 1))
(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)))
(setq d (* d (/ pi 180)))
(setq co (cos d))
(setq si (sin d))
(setq q (* (if (= pm -1) p1 p2) (/ pi 180)))
(setq xr (* r (cos q)))
(setq yr (* r (sin q) w))
(setq a (+ (atan (/ yr w) (* xr w)) d))
(list (list (+ x (* xr co) (- (* yr si))) (+ y (* xr si) (* yr co)) ) a)
)
;本文
( ;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 "^hp1ci" line) (setq pt (cdr a)))
(if (regexp:match "^ci" line)
(progn
(setq ci (cdr a))
(if (= (length ci) 3) (setq ci (append ci (list 0 0 1 0))))
)
)
)
)
( ;準備計算
progn
(setq size 5d0) ;矢印の長さ( 図寸 )
(setq xang 45d0) ;矢印の交角( ﾟ )
(setq xan2 120d0) ;矢尻の交角( ﾟ )
(multiple-value-setq (pt1 a1) (values-list (cipoint ci -1)))
(multiple-value-setq (pt2 a2) (values-list (cipoint ci 1)))
(setq l1 (ptdist pt pt1))
(setq l2 (ptdist pt pt2))
(setq pm (if (<= l1 l2) -1 1))
(setq sl (if (= pm -1)
(arrow pt1 (+ a1 (/ pi 2)) pm size xang xan2)
(arrow pt2 (+ a2 (/ pi 2)) pm size xang xan2)
)
)
)
( ;jwc_temp.txt へ 出力
with-open-file (g "jwc_temp.txt" :direction :output)
(write-line "bz" g)
(format g "sl~{ ~f~}~%" sl)
)
