jw_cad 外部変形 - (1097) clispで円に+を記入する -

外部変形は データのやり取りをテキストファイルで行うので プログラム言語は 自由に選ぶことができます。図形は機能的かつシンプルなため、数多くのユーザーに受け入れられています。

 

clispで円に+を記入する

:clispで円に+を記入する
@echo off
for /f "delims=:" %%n in ('findstr /n "^#!" %0') do (
  more +%%n %0 | clisp -q > nul
)
goto:eof

REM #jww
REM #h1
REM #g1
REM #hc 円を選択してください
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)
    )
)
( ;数値 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)
    )
)
;本文
(setq pi (* (atan 1d0 1d0) 4)) ;3.141592653589793d0
(setq bai 0.25d0)
( ;jwc_temp.txt へ 出力
  with-open-file (g "jwc_temp.bak" :direction :output)
    (write-line "bz" g)
( ;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 "^ci" line)
        (progn
          (setq x (to_f (nth 1 a)))
          (setq y (to_f (nth 2 a)))
          (setq r (to_f (nth 3 a)))
          (setq n (length a))
          (if (> n 4)
              (psetq w (to_f (nth 6 a)) d (to_f (nth 7 a)))
              (psetq w 1d0 d 0d0)
          )
          (setq co (cos (* d (/ pi 180))))
          (setq si (sin (* d (/ pi 180))))
          (setq l (* r bai))
          (setq mx (+ r l))
          (setq my (+ (* r w) l))
          (setq l1 (list 
                     (to_s (- x (* mx co)))
                     (to_s (- y (* mx si)))
                     (to_s (+ x (* mx co)))
                     (to_s (+ y (* mx si)))
                   )
          )
          (setq l2 (list 
                     (to_s (+ x (* my si)))
                     (to_s (- y (* my co)))
                     (to_s (- x (* my si)))
                     (to_s (+ y (* my co)))
                   )
          )
          (format g "~{ ~a~}~%" l1)
          (format g "~{ ~a~}~%" l2)
        )
    )
  )
)
)
(delete-file "jwc_temp.txt")
(rename-file "jwc_temp.bak" "jwc_temp.txt")