[分享]：出学lsp,作了一个自动归档的程序

brainstorm

;;;程序由两个缺点：1。不能通过对话框指定文件的保存目录2。如果有同名文件存在的话就会出错，请各位老大帮帮新手，我觉得这个程序听实用的
(defun c:bblk (/ dwglist dwgname i k )
(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))
(prompt "\n请选择图纸(每次选择一张图纸):")
(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
       (prompt "\n请继续选择图纸(每次选择一张图纸):")
       (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)) "")
      (setq i (+ i 1))
      )
)
              
        
   
);;;end mark