jw_cad 外部変形 - (1090) clispで2重線を引く(2sen) -

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

 

clispで2重線を引く(2sen)

:clispで2重線を引く(2sen)
@echo off
set w=%1
if %1==1 set w=200
if %1==2 set w=400
if %1==3 set w=120
if %1==4 set w=150
if %1==5 set w=180
if %1==6 set w=220
if %1==7 set w=250
if %1==8 set w=300
if %1==9 set w=350

for /f "delims=:" %%n in ('findstr /n "^#!" %0') do (
  more +%%n %0 | clisp -q > nul
)
goto:eof

REM #jww
REM #1-%d 始点を指示して下さい
REM #2%d 終点を指示して下さい
REM #k 線の幅| 200(L) | 400(R) | 120 | 150 | 180 | 220 | 250 | 300 | 350 |
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)
    )
)
;本文
( ;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 "^hp1" line) (setq p1 (cdr a)))
    (if (regexp:match "^hp2" line) (setq p2 (cdr a)))
  )
)
( ;準備計算
  progn
  (setq x1 (to_f (nth 0 p1)))
  (setq y1 (to_f (nth 1 p1)))
  (setq x2 (to_f (nth 0 p2)))
  (setq y2 (to_f (nth 1 p2)))
  (setq w (to_f (ext:getenv "w")))
  (setq d (atan (- y2 y1) (- x2 x1)))
  (setq yw (/ w (/ 2 (cos d))))
  (setq xw (/ w (/ -2 (sin d))))
  (setq pi (* (atan 1d0 1d0) 4))
)
( ;jwc_temp.txt へ 出力
  with-open-file (f "jwc_temp.txt" :direction :output)
    (format f "~{ ~a~}~%" (to_s (list (+ x1 xw) (+ y1 yw) (+ x2 xw) (+ y2 yw))))
    (if (> w 0)
    (format f "~{ ~a~}~%" (to_s (list (- x1 xw) (- y1 yw) (- x2 xw) (- y2 yw))))
    )
    (setq mode "長穴")
    (if (and (equal mode "長穴") (> w 0))
      (progn
      (setq p (to_f (+ (/ (* d 180) pi) 90)))
      (setq r (/ w 2))
      (format f "ci ~f ~f ~f ~f ~f ~f ~f~%" x1 y1 r p (+ p 180) 1 0)
      (format f "ci ~f ~f ~f ~f ~f ~f ~f~%" x2 y2 r (- p 180) p 1 0)
      )
    )
)

 

 

lisp は独特です。tcl/tk が似ていますが、素人が手を出す代物ではありません。