[编程申请]：对话框图像显示技术

pin

这个函数该怎样写（cline_cir）
下面是天正代码
(defun c:getfont (/           check_in show_list              pop_c    pop_e
                  defaults do_edit  do_fontig              onff     w_c
                  slt           clist    elist    lstyle   cstyle   cstrhw
                  estyle   estrsh   estrsw   tstyle   tstrhw   tftn
                  tfchh           tfnof    tfdo     fn              lst      is_win
                 )
  (defun check_in (input format kk /)
    (if        (and (distof input 2) (> (atof input) 0))
      (progn (rs_error) input)
      (progn (set_tile "error" (strcat "无效的" format "输入"))
             (mode_tile kk 2)
             nil
      )
    )
  )
  (defun show_list (k1 l1)
    (start_list k1)
    (mapcar 'add_list l1)
    (end_list)
  )
  (defun pop_c (pos)
    (if        clist
      (progn (setq cstyle (nth (atoi pos) clist)) (do_fontig))
    )
  )
  (defun pop_e (pos)
    (if        elist
      (progn (setq estyle (nth (atoi pos) elist)) (do_fontig))
    )
  )
  (defun defaults (/ c lpth lfn l)
    (if        (and (not (and _lhz _lxw))
             (setq fn (open (strcat _prefix1 "fonts.dat") "r"))
             (setq _lhz        (read-line fn)
                   _lxw        (read-line fn)
             )
        )
      (setq _lhz (read _lhz)
            _lxw (read _lxw)
            _ltt (read-line fn)
            _ltt (if _ltt
                   (read _ltt)
                 )
      )
    )
    (if        fn
      (close fn)
    )
    (if        (and _lhz _lxw)
      (setq cstyle (strcase (car _lhz))
            cstrhw (cadr _lhz)
            estyle (strcase (car _lxw))
            estrsh (cadr _lxw)
            estrsw (last _lxw)
      )
      (setq cstyle "HZTXT"
            estyle "SIMPLEX"
            cstrhw 0.8
            estrsw 0.6
            estrsh 0.8
      )
    )
    (if        _ltt
      (setq tstyle (car _ltt)
            tstrhw (cadr _ltt)
            tfchh  (caddr _ltt)
            tftn   (last _ltt)
      )
      (setq tstyle "宋体"
            tstrhw 0.8
            tfchh  nil
            tftn   nil
      )
    )
    (setq lpth (cons "" (getpfxl)))
    (foreach pth lpth
      (setq lfn (append (fdfiles (strcat (TgAddPathTail pth) "*.SHX") 4 T) lfn))
    )
    (setq lfn (range1 lfn))
    (foreach ll        lfn
      (if (> (cadr ll) 1e5)
        (setq clist (cons (strcase (car ll)) clist))
        (setq elist (cons (strcase (car ll)) elist))
      )
    )
    (if        clist
      (progn (setq l         clist
                   clist (reverse clist)
                   c         (member cstyle l)
             )
             (show_list "c_list" clist)
             (if (not c)
               (progn (setq tfnof  T
                            cstyle "HZTXT"
                            c           (member cstyle l)
                      )
                      (if (not c)
                        (setq cstyle (car clist)
                              c             (list cstyle)
                        )
                      )
               )
             )
             (set_tile "c_list" (itoa (1- (length c))))
      )
    )
    (if        elist
      (progn (setq l         elist
                   elist (reverse elist)
                   c         (member estyle l)
             )
             (show_list "e_list" elist)
             (if (not c)
               (progn (setq tfnof  T
                            estyle "TXT"
                            c           (member estyle l)
                      )
                      (if (not c)
                        (setq estyle (car elist)
                              c             (list estyle)
                        )
                      )
               )
             )
             (set_tile "e_list" (itoa (1- (length c))))
      )
    )
    (if        tfnof
      (setq _lhz (list cstyle cstrhw)
            _lxw (list estyle estrsh estrsw)
            _ltt (list tstyle tstrhw tfchh tftn)
      )
    )
    (set_tile "cstr_hw" (rtos cstrhw 2 2))
    (set_tile "estr_sw" (rtos estrsw 2 2))
    (set_tile "estr_sh" (rtos estrsh 2 2))
    (set_tile "win_cad"
              (if tftn
                "1"
                "0"
              )
    )
    (set_tile "chht"
              (if tfchh
                "1"
                "0"
              )
    )
    (set_tile "ttype" tstyle)
    (do_fontig)
  )
  (defun do_edit (n m / temp)
    (cond ((= n 1)
           (if (and (setq temp (check_in m "高宽比" "cstr_hw"))
                    (< 0.02 (atof temp) 50)
               )
             (setq cstrhw (atof temp))
             (set_tile "error" "高宽比超出有效范围")
           )
          )
          ((= n 2)
           (if (and (setq temp (check_in m "字宽方向比例" "estr_sw"))
                    (< 0.02 (atof temp) 50)
               )
             (setq estrsw (atof temp))
             (set_tile "error" "字宽方向比例超出有效范围")
           )
          )
          ((= n 3)
           (if (and (setq temp (check_in m "字高方向比例" "estr_sh"))
                    (< 0.02 (atof temp) 50)
               )
             (setq estrsh (atof temp))
             (set_tile "error" "字高方向比例超出有效范围")
           )
          )
    )
    (do_fontig)
  )
  (defun do_fontig (/ stl p1 p2 p3 p4 p5 p6 p7 p8 ll plist)
    (if        (not
          (equal lst
                 (setq ll (list estrsh estrsw cstrhw estyle cstyle))
          )
        )
      (progn (setq lst         ll
                   ll         (rdshx "建筑" '(0 0) 1 cstrhw estyle cstyle)
                   plist (append '(nil "7")
                                 (cdr ll)
                                 (cdr (rdshx (If _is_v14
                                               "3.0"
                                               "1.8"
                                             )
                                             (if ll
                                               (car ll)
                                               '(0 0)
                                             )
                                             estrsh
                                             (/ (* estrsw cstrhw) estrsh)
                                             estyle
                                             cstyle
                                      )
                                 )
                         )
             )
             (start_image "font_ig")
             (fill_image 0 0 winx winy -2)
             (foreach sublt (apply 'cline_cir plist)
               (apply 'vector_image sublt)
             )
             (end_image)
      )
    )
  )
  (defun onff (tf)
    (if        tf
      (progn (mode_tile "cstr_hw" 1)
             (mode_tile "c_list" 1)
             (mode_tile "estr_sw" 1)
             (mode_tile "estr_sh" 1)
             (mode_tile "e_list" 1)
             (mode_tile "ttype" 0)
             (mode_tile "select" 0)
             (setq is_win T)
             ;(setvar "TEXTSTYLE" "
      )
      (progn (mode_tile "cstr_hw" 0)
             (mode_tile "c_list" 0)
             (mode_tile "estr_sw" 0)
             (mode_tile "estr_sh" 0)
             (mode_tile "e_list" 0)
             (mode_tile "ttype" 1)
             (mode_tile "select" 1)
             (setq is_win nil)
      )
    )
  )
  (defun w_c (tf) (setq tftn (= tf "1")) (onff tftn))
  (defun slt (/ ll)
    (if        (setq ll (ttfont tstyle tstrhw))
      (setq tstyle (car ll)
            tstrhw (cadr ll)
      )
    )
    (set_tile "ttype" tstyle)
  )
  (if
    (and (not fnt_id)
         (< (setq fnt_id (load_dialog (strcat _prefix "getfont.dcl")))
            0
         )
    )
     (exit)
  )
  (setq what_next 5)
  (if (not (new_dialog "getfont" fnt_id))
    (exit)
  )
  (setq        winx (dimx_tile "font_ig")
        winy (dimy_tile "font_ig")
  )
  (transws winx winy)
  (defaults)
  (onff tftn)
  (action_tile "cstr_hw" "(do_edit 1 $value)")
  (action_tile "estr_sw" "(do_edit 2 $value)")
  (action_tile "estr_sh" "(do_edit 3 $value)")
  (action_tile "c_list" "(pop_c $value)")
  (action_tile "e_list" "(pop_e $value)")
  (action_tile "win_cad" "(w_c $value)")
  (action_tile "chht" "(setq tfchh(=\"1\"$value))")
  (action_tile "select" "(slt)")
  (action_tile "help" "(do_help \"getfont\")")
  (if (setq tfdo (= 1 (start_dialog)))
    (setq _lhz (list cstyle cstrhw)
          _lxw (list estyle estrsh estrsw)
          _ltt (list tstyle tstrhw tfchh tftn)
    )
  )
  (if (or tfdo tfnof)
    (progn (setq fn (open (strcat _prefix1 "fonts.dat") "w"))
           (prin1 _lhz fn)
           (print _lxw fn)
           (print _ltt fn)
           (close fn)
    )
  )
;;;  (if        (and _ltt (last _ltt))
;;;    (setvar "TEXTSTYLE" (car _ltt))
;;;    (setvar "TEXTSTYLE" "standard")
;;;    )
  (setstyle)
   
  (princ)
)
  (defun setstyle( / sna stwin winf dhx hzh xwh sthz stxw hzf xwf )
    (if        is_win
      (progn
        (setq sna   (car _ltt)
              stwin (if        (= "@" (substr sna 1 1))
                      (strcat "--" (substr sna 2))
                      (strcat "-" sna)
                    )
              winf  (cadr _ltt)
              dhx   (* 0.5 winf)
        )
        (if (not (tblsearch "style" stwin))
          (progn
            (command ".style" stwin sna)
            (if        (= 0 (getvar "cmdactive"))
              (progn
                (setq sna "宋体")
                (command ".style" stwin sna)
                (if (= 0 (getvar "cmdactive"))
                  (progn (setq sna "Arial")
                         (command ".style" stwin sna)
                  )
                )
                (princ (strcat "\n*** 请使用 'style' 命令, 将样式名 '"
                               stwin
                               "' 的字体名, 由 '"
                               sna
                               "' 改为 '"
                               (car _ltt)
                               "'。"
                       )
                )
              )
            )
            (command 0 winf 0 "" "")
          )
          (setvar "TEXTSTYLE" stwin)
        )
      )
      (progn
        (cond ((not hzh) (setq hzh 1.))
              ((< hzh 0)
               (setq xwh (abs hzh)
                     hzh (/ xwh (cadr _lxw))
               )
              )
              ((setq xwh (* hzh (cadr _lxw))))
        )
        (setq sthz (strcat "_" (car _lhz))
              stxw (strcat "_" (car _lxw))
              hzf  (cadr _lhz)
              xwf  (/ (cadr _lhz) (apply '/ (cdr _lxw)))
              dhx  (* 0.09 hzh hzf (1+ (caddr _lxw)))
        )
        (if
          (and
            (not (and (tblsearch "style" sthz) (tblsearch "style" stxw))
            )
            (findshx (strcat (car _lhz) ".shx"))
            (findshx (strcat (car _lxw) ".shx"))
          )
           (progn (command ".style"
                           sthz
                           (strcat "txt," (car _lhz))
                           0
                           hzf
                           0
                           ""
                           ""
                  )
                  (dstop)
                  (command ".style" stxw (car _lxw) 0 xwf 0 "" "")
                  (dstop)
           )
          (setvar "TEXTSTYLE" sthz)
        )
       
      )
    )
      )