- 积分
- 3252
- 明经币
- 个
- 注册时间
- 2011-9-17
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2011-11-26 22:21:28
|
显示全部楼层
本帖最后由 wade320 于 2011-11-26 22:27 编辑
;;; Required AutoCAD 2000i inside Windows 98
;;; For Drawing copy (bind & save your files)
;;; 2/2/2004 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)
)
(if SCRFILE
(close SCRFILE)
)
(princ)
)
;;;new function -- checkbox!!
(defun SDIR (/ PDIR2 PDLIST PDLISTN PDLISTN2 PSDIRLT PSDIR DMSG)
(if (= PDIR NIL)
(setq PDIR2 (getvar "dwgprefix"))
(setq PDIR2 PDIR)
) ;_ end of if
(if (setq PDIR (dos_getdir "Select a Directory to plot" PDIR2))
(progn (dos_drive (substr PDIR 1 2)) (dos_chdir PDIR))
(exit)
) ;_ end of if
(setq DMSG (strcat "Select the files to register: <" PDIR ">"))
(setq PSDIRLT (dos_subdir PDIR)
PDLIST (dos_dir "*.dwg")
) ;_ end of setq
(foreach PSDIR PSDIRLT
(setq PSDLIST (dos_dir (strcat PDIR PSDIR "\\*.DWG"))
PSDLIST (mapcar '(lambda (%1) (strcat PSDIR "\\" %1)) PSDLIST)
PDLIST (append PDLIST PSDLIST)
) ;_ end of setq
) ;_ end of foreach
(setq PDLIST (mapcar '(lambda (%1) (cons %1 0)) PDLIST))
(setq PDLISTN (dos_checklist "ALL PART REG." DMSG PDLIST))
(setq PDLISTN2 (vl-remove-if '(lambda (%1) (= (cdr %1) 0)) PDLISTN))
(if PDLISTN2
(setq PDLISTN2 (mapcar '(lambda (%1) (car %1)) PDLISTN2))
(exit)
) ;_ end of IF
(setq PDLISTN2 (acad_strlsort PDLISTN2))
(setq X (cons PDIR PDLISTN2))
) ;_ end of defun
;;;
(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:/allpart.scr" "w"))
(write-line
(strcat
"(dos_getprogress
\"All Part reg "
N2
" "
DWGS
" selected total \"
\"The Selected files is being progress, Please wait...\" "
N2
")"
)
SCRFILE
)
(write-line "(setvar \"cmddia\" 0)" SCRFILE)
(foreach DWGFILE X
;(write-line "(load \"allpart.lsp\")" SCRFILE)
;(write-line (strcat "(AP_OPENP \" DWGPATH DWGFILE " \ ")") SCRFILE)
(if (= CHKSDI 1)
(write-line (strcat "open y \"" DWGPATH DWGFILE "\"") SCRFILE)
(write-line (strcat "open \"" DWGPATH DWGFILE "\"") SCRFILE)
)
(write-line "anew" SCRFILE);anew是一个lisp函数就是图纸打开后执行anew这个lisp程序
(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))
(write-line ".CLOSE N" SCRFILE)
)
(write-line "(setvar \"cmddia\" 1)" SCRFILE)
(close SCRFILE)
(command "script" "c:/allpart.scr")
)
(defun AP_OPENP (DWGNAME)
(if (= NIL (dos_openp DWGNAME))
(vla-open DBXDOC (findfile DWGNAME))
(progn
(defun WAITTIME ()
(princ
(strcat
"\rThis file is opened by someone, now waiting for file "
DWGNAME
"... "
(menucmd
"M=$(edtime,$(-,$(getvar,date),$(getvar,userr5)),HH:MM:SS.MSEC)"
)
)
)
)
(setvar "USERR5" (getvar "date"))
(while (dos_openp DWGNAME) (WAITTIME))
(setq WAITTIME NIL)
(princ "\n")
)
)
)
(defun C:ALLPART (/ X DWGPATH)
;;load Doslib if not loaded
(defun LOAD_DOSLIB (/ LIBFILE FOUND ARXFILE)
(if (= "15" (substr (getvar "acadver") 1 2))
(setq LIBFILE "doslib2k.arx")
(setq LIBFILE "doslib2004.arx")
)
(setq FOUND (member LIBFILE (arx)))
(if (not FOUND)
(setq FOUND (arxload (findfile LIBFILE) NIL))
)
(if FOUND
t
NIL
)
)
(cond ((< (atoi (substr (getvar "acadver") 1 2)) 15)
(alert "This Lisp can run only at AutoCAD 2000 & up\nExit Now!")
(exit)
)
((= (atoi (substr (getvar "acadver") 1 2)) 15) (LOAD_DOSLIB))
((> (atoi (substr (getvar "acadver") 1 2)) 15) (LOAD_DOSLIB))
)
(if (= (getvar "sdi") 0)
(setq CHKSDI 0)
(setq CHKSDI 1)
) ;if sdi
(setq OLDERR *ERROR* ; Save error routine
*ERROR* MY_ERR ; Substitute ours
)
(INIT)
(PROCESS)
)
(princ "type \"allpart\" to start")
(princ)
这是我以前在网上找到的程序,保持了原作者,但是在2006中运行不了,这个程序就是脚本和LISP结合的例子,请高手找出程序中的问题。这个程序使用时要加载doslib文件,以前在2004版本中可以使用,但在2006版本中不知道为什么就不可以了。怎么也找不出问题. |
|