外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。
clispでＨ形鋼断面を描く
:clispでＨ形鋼断面を描く
@echo off
set s=%*
if defined s (
echo ^%*> %~dpn0.txt
) else (
if exist %~dpn0.txt (
for /f "tokens=*" %%a in (%~dpn0.txt) do set s=%%a
)
)
if not defined s set s=400 200 8 13 16
for /f "delims=:" %%n in ('findstr /n "^#!" %0') do (
more +%%n %0 | clisp -q > nul
)
goto:eof
REM #jww
REM #1%d 位置を指示して下さい
REM #99#
REM #c H B T1 T2 R =
REM #e
#!この次の行からプログラムを書いてください
;文字列 str の old に一致する部分を new で置き換える
(defun gsub (old new str)
(let (s e)
(if (search old str)
(progn
(setq s (search old str))
(setq e (+ s (length old)))
(setq str (concatenate 'string (subseq str 0 s) new (subseq str e)))
(gsub old new str)
)
str
)
))
;リストを平坦化する : 引用
(defun flatten (ls)
(cond ( (null ls) nil)
( (atom ls) (list ls))
(t (append (flatten (car ls)) (flatten (cdr ls))))))
(defun to_f (x) ;文字列 "x" を 倍精度実数値 double-float に変換する
(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)
)
)
(defun to_s (x) ;数値 xd0 (倍精度 double-float) を 文字列 "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)
)
)
)
)
)
;点 pt を 相対距離 (x y) 移動する
(defun moveto (pt x &optional (y nil) (d nil))
(let (xy i j)
(setq xy (if y (list x y) x))
(unless (listp xy) (setq xy (list x 0)))
(setq pt (flatten (to_f pt)))
(setq xy (flatten (to_f xy)))
; (if (equal d nil) (setq d (to_f y)))
; (setq xy (rot xy d))
(if xy
(loop for i in pt
for j in xy
collect (+ i j)
)
x
)
))
(defun ptrot (d x y) ;点 x を 点 y を 中心として 角度 dﾟ だけ回転させて返す
(setq co (cos (* d (/ pi 180))))
(setq si (sin (* d (/ pi 180))))
(multiple-value-setq (x1 y1 x2 y2) (values-list (append x y)))
(list (- (* (+ x1 x2) co) (* (+ y1 y2) si))
(+ (* (+ x1 x2) si) (* (+ y1 y2) co)))
)
(defun offset (w h &optional (pt 5) (opt 5)) ;図心 opt から 基点 pt までの ずれ を返す
(list
(* (/ w 2) (- (mod (- 9 pt) 3) (mod (- 9 opt) 3)))
(* (/ h 2) (- (to_i (/ (- 9 pt) 3))
(to_i (/ (- 9 opt) 3))))
)
)
(defun jish (file hp a b tw tf &optional (r 0) (d *hk*) (pt 5))
(multiple-value-setq (a b tw tf r) (values-list (to_f (list a b tw tf r))))
(setq u 5)
(setq p0 (offset b a pt))
(setq p (list
(list (/ tw 2) (- (/ a 2) tf r))
(list (+ (/ tw 2) r) (- (/ a 2) tf r))
(list (+ (/ tw 2) r) (- (/ a 2) tf))
(list (/ b 2) (- (/ a 2) tf))
(list (/ b 2) (/ a 2))
)
)
(loop for j from 0 to 3
do
(setq a (* 90 (mod (- 1 j) 4)))
(loop for i from 0 to (- u 1)
do
(setq k (if (= (mod j 2) 0) i (- u i 1)))
(multiple-value-setq (x y) (values-list (nth k p)))
(setq px (if (/= (mod j 3) 0) (- x) x))
(setq py (if (> j 1) (- y) y))
(setq pc (moveto hp (ptrot d (list px py) p0)))
(if (and (= k 1) (> r 0))
(setq pc (append (list "ci") pc (list r 0 90 1 (+ a d))))
)
(format file "~{ ~a~}~%" (to_s pc))
)
)
(format file "~{ ~a~}~%" (to_s (moveto hp (ptrot d (nth 0 p) p0))))
(write-line "#" file)
)
(setq hp '( (0 0)))
(setq hpn 1)
(with-open-file (f "jwc_temp.txt" :direction :input)
(loop for line = (read-line f nil) while line do
(setq a (regexp:regexp-split " \\+" line))
(if (regexp:match "^hk" line) (setq hk (cadr a)))
;指示点データ
(if (regexp:match "^hp[1-9][0-9]\\?\\(ln\\|ci\\|ch\\)\\?-\\?" line)
(progn
(setq hpn (gsub "hp" "" (car a)))
(setq hpn (gsub "ln" "" hpn))
(setq hpn (gsub "ci" "" hpn))
(setq hpn (gsub "ch" "" hpn))
(setq hpn (gsub "#" "" hpn))
(setq hpn (parse-integer (gsub "-" "" hpn)))
(if (>= (- hpn (length hp)) 0)
(loop for i to (- hpn (length hp)) do
(setq hp (append hp '( (0 0))))
)
)
(setf (elt hp hpn) (cdr a))
)
)
)
)
( ;準備計算
progn
(setq *hk* (to_f hk))
(setq n (- (length hp) 1))
(setq s (regexp:regexp-split " \\+" (ext:getenv "s")))
(setq h (to_f (nth 0 s)))
(setq b (to_f (nth 1 s)))
(setq t1 (to_f (nth 2 s)))
(setq t2 (to_f (nth 3 s)))
(setq r (to_f (nth 4 s)))
)
(with-open-file (f "jwc_temp.txt" :direction :output)
(loop for i to n
do
(if (> i 0)
(jish f (elt hp i) h b t1 t2 r)
)
)
)
