[求助]：哪位大侠帮我修改一下批量绑定外部参照的lisp程序

ppll8016

我有一个批量绑定多文件中的外部参照的程序，不过只能在win98下使用，哪位精通lisp编程的高手帮我修改一下，使它可以在xp下的cad2006下使用，万分感谢
;;; Required AutoCAD 2000i inside Windows 98
;;; For Drawing copy (bind & save your files)
;;; 05-11-2002 revised by Eric Wong
;;; Note: This Lisp required DOSlib 5.x by Robert McNeel & Associate
;;; And required "Express tools V1-9"


(defun my_err  (s) ; If an error (such as CTRL-C) occurs
  (if (/= s "Function cancelled")
    (princ (strcat "\nError: " s)))
  (if olderr
    (setq *error* olderr)) ; Restore old *error* handler
  (if scrfile
    (close scrfile))
  (princ))
;;;new function -- checkbox!!
(defun sdir  (/        PDIR2 PDLIST PDno PDLIST2 PDLIST3 PDF1 PDF2 PDLISTN PDchk
              PDLISTN2 dmsg)
  (if (= PDIR nil)
    (setq PDIR2 (getvar "dwgprefix"))
    (setq PDIR2 PDIR))
  (if (setq PDIR (dos_getdir "Select a Directory first" PDIR2))
    (progn (dos_drive (substr PDIR 1 2)) (dos_chdir PDIR))
    (exit))
  (setq        PDLIST        (dos_dir "*.dwg")
        PDLIST        (reverse (acad_strlsort PDLIST))
        PDno        (length PDLIST)
        PDLIST2        PDLIST
        PDLIST3        nil)
  (repeat PDno
    (setq PDF1          (car PDLIST2)
          PDF2          (cons PDF1 0)
          PDLIST3 (cons PDF2 PDLIST3)
          PDLIST2 (cdr PDLIST2))) ;repeat
  (setq PDLISTN2 nil)
  (setq dmsg (strcat "Select the files to bind: <" PDIR ">"))
  (if (setq PDLISTN (dos_checklist "All Bind Xref" dmsg PDLIST3))
    (repeat PDno
      (setq PDchk (cdr (car PDLISTN)))
      (if (= PDchk 1)
        (setq PDLISTN2 (cons (car (car PDLISTN)) PDLISTN2)))
      (setq PDLISTN (cdr PDLISTN)))
    (exit))
  (setq PDLISTN2 (acad_strlsort PDLISTN2))
  (setq X (cons PDIR PDLISTN2))
  ;(setq TARGETDIR (dos_getdir "Files are copied to..." PDIR2))
  )
;;;

(setq dwgpath nil
      F        nil
      FL nil
      F1 nil
      X        nil
      scrfile nil)

   ;initialize
(defun init  ()
  (sdir)
  (setq dwgpath (car X))
  (setq X (acad_strlsort (cdr X)))
  (setq        n2 (rtos (length X) 2 0)
        n1 "1")
  (if (= n2 1)
    (setq dwgs "Drawing")
    (setq dwgs "Drawings")))
   ;make script file
(DEFUN process        (/ scrfile dmsg)
  (SETQ scrfile (OPEN "c:/allbind.scr" "w"))
  (WRITE-LINE
    (strcat
      "(dos_getprogress
      \"All Bind Xref             " n2 " " dwgs
      " selected total \"
      \"The Selected files is being bind, Please wait...\" "
      n2 ")")
    scrfile)
  (FOREACH dwgfile  X
    (if        (= chksdi 1)
      (WRITE-LINE (STRCAT "open y \"" dwgpath dwgfile "\"") scrfile)
      (WRITE-LINE (STRCAT "open \"" dwgpath dwgfile "\"") scrfile))
      (write-line "bindtype 1" scrfile)
      (write-line "-xref" scrfile)
      (write-line "bind" scrfile)
      (write-line "*" scrfile)
      (write-line "(setvar \"clayer\" \"0\")" scrfile)
      ;(write-line "(c:lfd)" scrfile)
      (write-line "audit y" scrfile)
      (write-line "-PURGE ALL * N" scrfile)
      (WRITE-LINE "QSAVE" scrfile)
    (WRITE-LINE "(dos_getprogress -1)" scrfile)
    (if        (= n1 n2)
        (progn (WRITE-LINE "(dos_getprogress t)" scrfile)
               (WRITE-LINE (strcat "(dos_msgbox \"" n2 " Drawing(s) has been process.\" \"Process\" 1 3 5)") scrfile)
        )
    )
    (setq n1 (rtos (+ 1 (atoi n1)) 2 0))
    (if        (= chksdi 0) (WRITE-LINE "CLOSE" scrfile))
    ;(if        (= chksdi 0) (WRITE-LINE "CLOSE Y" scrfile))
) ;FOREACH

  (close scrfile)
  (command "script" "c:/allbind.scr"))
(defun c:allbind  (/ X dwgpath)
  ;;load Doslib if not loaded
  (cond ((< (atoi (substr (getvar "acadver") 1 2)) 15)
       (alert
         "This Lisp can run only at AutoCAD 2000 & up\nExit Now!"
       )
       (exit)
      ) ; Check for AutoCAD 2000, 2000i, or 2002
      ((= (atoi (substr (getvar "acadver") 1 2)) 15)
       (if (not (member "doslib15.arx" (arx)))
         (if (findfile "doslib15.arx")
           (arxload "doslib15")
         )
       )
      ) ; Check for AutoCAD 2004, or 2005
      ((= (atoi (substr (getvar "acadver") 1 2)) 16)
       (if (not (member "doslib16.arx" (arx)))
         (if (findfile "doslib16.arx")
           (arxload "doslib16")
         )
       )
      (if (= (getvar "sdi") 0)
           (setq chksdi 0)
           (setq chksdi 1))
       )
  )
  (setq        olderr        *error* ; Save error routine
        *error*        my_err ; Substitute ours
        )
  (init)
  (process))

(princ "type \"allbind\" to start")
(princ)

jadekylin

我也很想用这个功能，最好是能在2008上用