[分享]：初学lisp，编写了自动写块文件的程序，与大家分享

brainstorm

;程序有两个缺点
;1.不能通过对话框选择文件目录
;2.如果有重名文件程序会出错
;请高手给完善以下，程序主要用于电子版文件自动归档
(defun c:bblk (/ dwglist dwgname i k )
(princ "\n根据公司电子版文件归档要求编制，用于文件自动归档，输出文件在d:\下。天辰公司")
(regapp "dwgname")
(setq newlist
      (list -3
      (list "dwgname" (cons 1000 "dwgname"))
      )
)
(prompt "\n请选择图纸名称")
(setq dwgsuffix (getstring "\n请输入图纸编号关键字:"))
(while (= dwgsuffix "")
       (prompt "\n图纸编号关键字不能为空:")
       (setq dwgsuffix (getstring "\n请输入图纸编号关键字:"))
)
(setq dwgsuffix (strcase dwgsuffix))

(setq dwgname (ssget (list '(0 . "text") (cons 1 (strcat dwgsuffix "*")))))
(setq i 0)
(repeat (sslength dwgname)
        (setq ent (ssname dwgname i))
        (setq endata (entget ent))
        (setq endata (append endata (list newlist)))
        (entmod endata)
        (setq i (+ i 1))
)
(setq dwglist '(dwglist))
(setq i 1)
(prompt (strcat "\n请选择第" (rtos i ) "张图纸(每次选择一张图纸):"))
(setq dwg (ssget))
(setq dwgname (ssget "p" '((-3 ("dwgname")))))
(setq dwgname (cdr (assoc 1 (entget (ssname dwgname 0)))))
(setq dwglist (append dwglist (list (cons dwgname dwg))))
(while dwg
       (setq i (+ i 1))
       (prompt (strcat "\n请选择第" (rtos i ) "张图纸(每次选择一张图纸,右键退出):"))
       (setq dwg (ssget))
       (setq dwgname (ssget "p" '((-3 ("dwgname")))))
       (setq dwgname (cdr (assoc 1 (entget (ssname dwgname 0)))))
       (setq dwglist (append dwglist (list (cons dwgname dwg))))
)
(setq k (length dwglist))
(setq i 1)
(while (< i (- k 1))
      (repeat (- k 2)
      (command ".wblock" (strcat "d:/" (car (nth i dwglist)) ) "" "0,0" (cdr (nth i dwglist)) "")
      (command "oops")
      (setq i (+ i 1))
      )
)
              
        
   
);;;end mark
(princ "\n以bblk启动程序")