[求助]：圖塊自動入庫(#debk)用不了。。。

zctao1966

估计是少了一个$$a.txt，内容是$$_1之类的，但攺了之后还是用不了。。。请高人修改，不胜感激！
[CODE]
;----------------
;  #debk.lsp
;  功能:将所定义的图块自动入库
;----------------
(defun c:#debk ( / dbkerr olderr oldcmd oldos pt1 pt2 pt3 ss ent aa scr_h fp n )
     ;定义错误处理子程序
  (defun dbkerr(s)
    (if (and (/= s "console break") (/= s "Function cancelled"))
        (princ (strcat "\nError: " s))
    )
    (setq ss nil)
    (if olderr (setq *error* olderr))
    (if oldcmd (setvar "cmdecho" oldcmd))
    (if oldos (setvar "osmode" oldos))
    (princ)
  )
(setq olderr *error*
       *error* dbkerr
       oldcmd (getvar "cmdecho")
       oldos (getvar "osmode")
)
(setvar "cmdecho" 0)
(setvar "osmode"  37)
(setq pt1 (getpoint "\n 请选择要入图库的实体的一个对角点: ")
       pt2 (getcorner pt1 "\n 另一对角点: ")
       pt3 (getpoint "\n 插入基点: ")
)
(command "_zoom" "w" pt1 pt2)
(setq scr_h (getvar "viewsize"))
(command "_circle" pt3 (* 0.03 scr_h)  ""
          "_change" "L" "" "p" "c" 1 ""
)
(setq ent (entlast) ss (ssget "w" pt1 pt2))
(ssdel ent ss)
(setq n 0)
(if (findfile (STRCAT BLOCKPATH "$$a.txt"))
   (progn
     (setq fp (open (STRCAT BLOCKPATH "$$a.txt") "r"))
     (while (read-line fp) (setq n (1+ n)) )
     (close fp)
     (setq fp (open (STRCAT BLOCKPATH "$$a.txt") "a"))
   )
   (setq fp (open (STRCAT BLOCKPATH "$$a.txt") "w"))
  )
(setq aa (strcat "$$_" (itoa n)))
(write-line aa fp)
(close fp)
(command "mslide" (strcat  BLOCKPATH  aa))
(command "wblock" (strcat  BLOCKPATH  aa) "" pt3 ss "" "oops")
(entdel ent)
(command "zoom" "p")
(setq *error* olderr)
(setvar "osmode" oldos)
(setvar "cmdecho" oldcmd)
(princ)
)
;;;圖塊調用(#ubk).LSP
(defun c:#ubk( / oldcmd olderr which which2 OK sldno dcl_id sld_list now_page explode
                 insbk in_sldno selno diag update init get_no selsld page #z_in ubkerr)
  (defun dbkerr(s)
    (if (and (/= s "console break") (/= s "Function cancelled"))
        (princ (strcat "\nError: " s))
    )
    (setq ss nil)
    (if olderr (setq *error* olderr))
    (if oldcmd (setvar "cmdecho" oldcmd))
    (if oldos (setvar "osmode" oldos))
    (princ)
  )

(defun diag( / n slide i)
   (if (> (setq dcl_id (load_dialog (STRCAT BLOCKPATH "ubk.dcl"))) 0)
     (progn
        (if (new_dialog "slide" dcl_id)
          (progn
           (setq in_sldno (get_no) i 0)
           (repeat (length in_sldno)                 
              (setq slide (strcat "slide" (nth i sldno))) ;图象选项名列表,slide1 slide2
              (disp slide (nth i in_sldno))
              (setq i (1+ i))
            )
            (mode_tile (strcat "slide" which) 2)  
            (foreach n sldno
                 (action_tile (strcat "slide" n) "(setq which $key) (selsld)")
             )
            (if (= now_page 0)
               (mode_tile "page_up" 1)
               (mode_tile "page_up" 0)
             )
  ;          (set_tile "page" "0")(set_tile "which" "1")
            (action_tile "page_up" "(page 1)")
            (action_tile "page_dn" "(page 2)")
            (action_tile "zoomin" "(#z_in)")
            (action_tile "accept" "(update) (done_dialog) (unload_dialog dcl_id)")
            (action_tile "cancel" "(unload_dialog dcl_id)")
            (start_dialog)
           );END PROGN
          (prompt "\n  无法显示对话框SLIDE!")
         );END IF
        )
       (prompt "\n 无法加载对话框文件UBK.DCL,请检查文件是否存在!")
     )
  )
;子程序init
(defun init(/ fp a)
   (if (not (setq fp (open (STRCAT BLOCKPATH "$$a.txt") "r") ) )
     (progn (princ "\n 图块无") (exit) )
    )
   (setq sld_list '())
   (while (setq a (read-line fp))
       (setq sld_list (cons (strcat BLOCKPATH a) sld_list)) ;文件名列表
    )
   (close fp)
   (setq sld_list (reverse sld_list)  ;表倒置
         now_page 0
         which "1"
         selno 1
         which2 which
         insbk (nth 0 sld_list)
    )
  )
;子程序disp
(defun disp (name sld)
   (start_image name)
   (slide_image 0 0 (- (dimx_tile name) 1) (- (dimy_tile name) 1) sld )
   (end_image)
)
;子程序get_no 功能:将要显示于当前页中的图象名称存入表中
(defun get_no (/ n sld_t start left)
   (setq sld_t '())
   (setq start (+ (* 12 now_page) 1))                 ;当前页图象起始号
   (setq left (- (length sld_list) (* 12 now_page ))) ;所剩图象数目
   (if (> left 12)
     (progn (setq n 12)   (mode_tile "page_dn" 0) )
     (progn (setq n left) (mode_tile "page_dn" 1) )
    )
   (repeat n
      (setq sld_t (cons (nth (1- start) sld_list ) sld_t))
      (setq start (1+ start))
    )
   (reverse sld_t)
  )
;子程序selsld 将所选择图块存入insbk中
(defun selsld (/ lsd_t n)
   (setq n (+ (* now_page 12) (atoi (substr which 6)))) ;"which" equale $key ,look as slide11
   (if (> n (length sld_list))
     (setq which which2)        ;no graphs
     (progn
       (setq which (substr which 6))   ;"which" form "slide11" to "11"
       (setq selno n)                  ;实际图形编号
       (set_tile "which" (itoa selno)) ;"which" 是一个选项名
       (setq insbk (nth (1- (atoi which )) in_sldno ))  ;选择图块
       (setq which2 which)
      )
    )
  )
;子程序#z_in
(defun #z_in()
   (if (new_dialog "zoomin" dcl_id)
     (progn
       (disp "fd" insbk)
       (start_dialog)
     )
     (prompt "\n 无法显示")
    )
   (if (member (strcat "c/sld/$$_" (itoa (1- selno))) in_sldno)
      (mode_tile (strcat "slide" which) 2 )
   )
  )
;子程序page
(defun page( what / slide n)
   (if (= what 1)
     (setq now_page (1- now_page))
     (setq now_page (1+ now_page))
    )
   (setq in_sldno (get_no))
   (set_tile "page" (itoa now_page))
   (foreach n sldno
       (setq slide (strcat "slide" n ))
       (start_image slide)
       (fill_image 0 0 (dimx_tile slide) (dimy_tile slide) -2)
       (end_image)
    )
    (setq n 0)
    (repeat  (length in_sldno)
       (setq slide (strcat "slide" (nth n sldno)))
       (disp slide (nth n in_sldno))
       (setq n (1+ n))
     )
    (if (= now_page 0)
       (mode_tile "page_up" 1) (mode_tile "page_up" 0)
     )
    (if (member (strcat BLOCKPATH "$$_" (itoa (1- selno))) in_sldno)
       (mode_tile (strcat "slide" which) 2)
     )
   )
;子程序update
(defun update() (setq OK T  explode (get_tile "toggle") ) )
;主程序
(setq olderr *error*
       *error* ubkerr
       oldcmd (getvar "cmdecho")
  )
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setq sldno (list "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12"))
(init)
(diag)
(if OK (command "_insert" insbk pause "" "" pause) )
(if (= "1" explode) (command "_explode" (entlast)) )
(setq *error* olderr)
(setvar "cmdecho" oldcmd)
(princ)
)
;;;圖塊調用(#ubk).DCL
slide : dialog{
  label = "插入图块";
  :text {
    label = "自定义图块";
        }
  :row  {
      :image_button {
            key = "slide1";
            height=6;
            aspect_ratio = 1.25;
            color = 0;
                    }
      :image_button {
            key = "slide2";
            height=6;
            aspect_ratio = 1.25;
            color = 0;
                    }
      :image_button {
            key = "slide3";
            height=6;
            aspect_ratio = 1.25;
            color = 0;
                    }
      :image_button {
            key = "slide4";
            height=6;
            aspect_ratio = 1.25;
            color = 0;
                    }
        }
  :row  {
      :image_button {
            key = "slide5";
            height=6;
            aspect_ratio = 1.25;
            color = 0;
                    }
      :image_button {
            key = "slide6";
            height=6;
            aspect_ratio = 1.25;
            color = 0;
                    }
      :image_button {
            key = "slide7";
            height=6;
            aspect_ratio = 1.25;
            color = 0;
                    }
      :image_button {
            key = "slide8";
            height=6;
            aspect_ratio = 1.25;
            color = 0;
                    }
        }
  :row  {
      :image_button {
            key = "slide9";
            height=6;
            aspect_ratio = 1.25;
            color = 0;
                    }
      :image_button {
            key = "slide10";
            height=6;
            aspect_ratio = 1.25;
            color = 0;
                    }
      :image_button {
            key = "slide11";
            height=6;
            aspect_ratio = 1.25;
            color = 0;
                    }
      :image_button {
            key = "slide12";
            height=6;
            aspect_ratio = 1.25;
            color = 0;
                    }
        }
  :row {
  :edit_box {
    label = "选中:";
    key = "which";
    value = 1;
            }
  :edit_box {
    label = "当前页号:";
    key = "page";
    value = 0 ;
            }
   spacer;
   spacer;
   :toggle  {
         label = "插入时炸开";
         value = 0;
         key = "toggle";
            }
       }
   :row {
   :button {
         label = "<< 前页";
         key = "page_up";
           }
   :button {
         label = "后页 >>";
         key = "page_dn";
           }
   :button {
         label = "放大-->";
         key = "zoomin";
           }
         }
   ok_cancel;
              }


zoomin : dialog {
        label = "放大详图" ;
        :image_button {
            key = "fd";
            height=35;
            aspect_ratio = 1.25;
            color = 0;
                    }
         ok_only;
                 }


[CODE]