[编程交流] 使LISP适应201

;script file generator for multiple automated editing of drawings
;by Clint Moore
;;
;;
;;Revision:2.0
;;
(defun c:gscript()
(setq templ (getstring "\nName of Template script file :"))
(initget 1 "Yes No")
(setq ans (getkword "\nSave Changes made to drawings Yes/No: "))
(if (= ans "Yes")
   (setq ans "No")
   (setq ans "Yes")
)
(setq str nil)
(if (setq addscr (findfile (strcat templ ".scr")))
 (progn
  (setq dwglist nil)
  (while (setq dwg (getfiled "Select a Drawing File" "" "dwg" 0))
    (progn
        (setq cnt (strlen dwg)
              str nil
        )
        (while (and (> cnt 0) (/= str "\"))
          (setq str (substr dwg cnt 1))
          (setq cnt (1- cnt))
        )
        (if (= str "\")
          (setq su 2)
          (setq su 1)
        )
        (setq s3 (substr dwg (+ su cnt)))
        (setq dpth (substr dwg 1 (- (strlen dwg) (strlen s3))))
        (setq s3 (substr s3 1 (- (strlen s3) 4)))
        (setq dwglist (append  dwglist (list (list s3 dpth))))
        (command "shell" (strcat "dir /b " dpth "*.dwg >" s3 ".lst" ""))
     )
  )
  (setq wlst "dwgprp.lst"
        wname "begin.scr"
        fnwl  (open wlst "r")
        fnw (open wname "w")
  )
  (foreach dwgnm dwglist
    (setq rname (strcat (nth 0 dwgnm) ".lst"))
    (setq fnr (open rname "r"))
    (while (setq dwg (read-line fnr))
      (write-line "Open" fnw)
      (write-line (strcat (nth 1 dwgnm) dwg) fnw)
      (setq tscr (open addscr "r"))
      (while (setq outline (read-line tscr))
         (write-line outline fnw)
      )
      (close tscr)
    )
    (close fnr)
  )
  (if (= ans "Yes")
     (write-line "exit  " fnw)
     (write-line "QSAVE" fnw)
  )
  (close fnw)
 )
 (prompt "Template script file not found")
)
; (command "script" "begin")
)