(defun c:gctk( / ty h w dw e pt0 pt1 pt2 pt3 my fa p1 p2 p3 p0 zg fa_d　x0 y0　xn yn x y i j k x1 y1 wg p4 p5 p6 pt4 pt5 pt6 jdb jds xx chdw chrq chmj)
　 (setq dcl_dtszh (load_dialog "jzth.dcl"))
　 (if(not(new_dialog "tk" dcl_dtszh)) (exit))
　 (setq w 840 h 594 dw 0 blc 0.5 e 1 ty 0) (hk)
　 (if (/= tfm "") (set_tile "gcmc" tfm))
　 (mode_tile "ds" 1) (mode_tile "fa" 1)
　 (action_tile "bl_1" "(setq blc 0.5)")
　 (action_tile "bl_2" "(setq blc 1.0)")
　 (action_tile "bl_3" "(setq blc 2.0)")

　 (action_tile "th_1" "(progn (setq h 594 w 840 dw 0) (hk))")
　 (action_tile "th_2" "(progn (setq h 420 w 594 dw 0) (hk))")
　 (action_tile "th_3" "(progn (setq h 297 w 420 dw 0) (hk))")

　 (action_tile "jc" "(jch)")
　 (action_tile "ds" "(progn (setq dw (atoi (get_tile \"ds\"))) (hk))")

　 (action_tile "accept" "(tk_ok)")
　 (action_tile "cancel" "(progn (done_dialog) (setq e 0))")
　 (start_dialog)
　 (unload_dialog dcl_dtszh)
　 (setq　w (+ w dw))
　 (if (= e 1) (progn
　　　 (command "layer" "m" "901" "c" 7 "" "")
　　　 (setq my nil)
　　　 (while (/= my "Y")
　(setq pt0 (getpoint "\n请指定图廓左下角"))
　(setq fa　(getangle pt0 "\n请指定图框的方向"))
　(setq pt1 (polar pt0 fa (* w blc))
pt2 (polar pt1 (+ fa (/ pi 2)) (* h blc))
pt3 (polar pt0 (+ fa (/ pi 2)) (* h blc))
　)
　(command "pline" pt0 "w" 0 0 pt1 pt2 pt3 "c")
　(setq my (strcase (getstring "\n 是否满意? 回车重来, 打 Y 确定")))
　(if (/= my "Y") (command "erase" "l" ""))
　　　 )
　　　 (setq zg (* blc 4) fa_d (/ (* fa 180) pi))
　　　 (setq pt (polar pt0 fa (* blc 10.0)))
　　　 (setq p0 (polar pt (+ fa (/ pi 2)) (* blc 10))
　　　　　　 p1 (polar p0 fa (* (- w 20) blc))
　　　　　　 p2 (polar p1 (+ fa (/ pi 2)) (* (- h 20) blc))
　　　　　　 p3 (polar p0 (+ fa (/ pi 2)) (* (- h 20) blc))
　　　 )
　　　 (command "pline" p0 "w" 0 0 p1 p2 p3 "c")

　　　 (if (= ty 1) (command "insert" "gctk" p1 blc blc fa_d chmj chrq
　　　　　　　　　　　　　　 (strcat "1:" (itoa (fix (+ (* blc 1000) 0.5)))) chdw tfm))
　　　 (setq x0 (car p0) y0 (cadr p0) xn x0 yn y0)
　　　
　　　 (setq x0 (min x0 (car p1)) y0 (min y0 (cadr p1)))
　　　 (setq x0 (min x0 (car p2)) y0 (min y0 (cadr p2)))
　　　 (setq x0 (min x0 (car p3)) y0 (min y0 (cadr p3)))
　　　
　　　 (setq xn (max xn (car p1)) yn (max yn (cadr p1)))
　　　 (setq xn (max xn (car p2)) yn (max yn (cadr p2)))
　　　 (setq xn (max xn (car p3)) yn (max yn (cadr p3)))

　　　 (setq p4 (polar p1 (+ pi fa) (* blc 100))
　　　p5 (polar p4 (+ fa (/ pi 2)) (* blc 45))
　　　p6 (polar p5 fa (* blc 100))
　　　 d (list p0 p4 p5 p6 p2 p3)
　　　 )
　　　 (if (< x0 0)(setq fh 0)(setq fh 1))

　　　 (setq wg (* blc 100)
　　　y (* (fix (/ y0 wg)) wg)
　　　x (* (+ fh (fix (/ x0 wg))) wg)
　　　 )
　　　 (while (< y yn)
(setq jdb (pb_jdb (list x y) d))
(setq jds (length jdb) i 0)

(while (< i jds)
　　(setq x1 (nth i jdb) x2 (nth (1+ i) jdb))
　　(setq pt1 (list x1 y) pt2 (list x2 y))
　　(command "line" pt1 (polar pt1 pi (* blc 5)) "")
　　(command "line" pt2 (polar pt2 0 (* blc 5)) "")
　　　　　 (if (< x2 0) (setq fh 0)(setq fh 1))
　　　　　
　　(setq xx2 (* (+ fh (fix (/ x2 wg))) wg)
　 xx xx2
　　)
　　(while (< xx x1)
(setq pt (list xx y))
(command "line" (polar pt pi (* blc 5)) (polar pt 0 (* blc 5)) "")
(command "line" (polar pt (/ pi 2) (* blc 5)) (polar pt (* pi 1.5) (* blc 5)) "")
(setq xx (+ xx wg))
　　)
　　(setq i (+ i 2))
)
(setq y (+ y wg))
　　　)
　 ))
　 (princ)
)

(defun tk_ok()
　 (if (= "1" (get_tile "ty")) (setq ty 1))
　 (setq tfm (get_tile "gcmc"))
　 (setq chdw (get_tile "chdw"))
　 (setq chmj (get_tile "chmj"))
　 (setq chrq (get_tile "chrq"))
　 (done_dialog)
　 (princ)
)

(defun jch()
　 (if (= "1" (get_tile "jc"))(mode_tile "ds" 0)(mode_tile "ds" 1))
)

(defun hk()
　 (set_tile "size" (strcat "图廓尺寸大小为　" (itoa h) " * " (itoa (+ w dw)) "　毫米"))
)