将 Autofont 时间限制去除了！可是谁能告诉我程序中的“files”命令是什么？ (command

darksun1480

;简介：
;    我们经常有打开别人的图提示字体找不到的现象造成ACAD启动中断的现象，
;    用这个软件吧，看它的名字就知道了，AutoFont ;)

2. 
   
3. (setq cm (getvar "cmdecho"))
   
4. (setvar "cmdecho" 0)
   
5. 
   
6. (defun dxf (code elist)
   
7.   (cdr (assoc code elist))
   
8. )
   
9. 
   
10. (defun tnlist (tbname / tdata tblist)
    
11.   (while (setq tdata (tblnext tbname (not tdata)))
    
12.     (setq tblist (append
    
13.                    tblist
    
14.                    (list (dxf 2 tdata))
    
15.                  )
    
16.     )
    
17.   )
    
18. )
    
19. 
    
20. (defun ukword (bit kwd msg def / inp)
    
21.   (if (and
    
22.         def
    
23.         (/= def "")
    
24.       )
    
25.     (setq msg (strcat "\n" msg "<" def ">: ")
    
26.           bit (* 2 (fix (/ bit 2)))
    
27.     )
    
28.     (if (= " " (substr msg (strlen msg) 1))
    
29.       (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ": "))
    
30.       (setq msg (strcat "\n" msg ": "))
    
31.     )
    
32.   )
    
33.   (initget bit kwd)
    
34.   (setq inp (getkword msg))
    
35.   (if inp
    
36.     inp
    
37.     def
    
38.   )
    
39. )
    
40. 
    
41. (defun ustr (bit msg def spflag / inp nval)
    
42.   (if (and
    
43.         def
    
44.         (/= def "")
    
45.       )
    
46.     (setq msg (strcat "\n" msg "<" def ">: ")
    
47.           inp (getstring msg spflag)
    
48.           inp (if (= inp "")
    
49.                 def
    
50.                 inp
    
51.               )
    
52.     )
    
53.     (progn
    
54.       (if (= " " (substr msg (strlen msg) 1))
    
55.         (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ": "))
    
56.         (setq msg (strcat "\n" msg ": "))
    
57.       )
    
58.       (if (= bit 1)
    
59.         (while (= "" (setq inp (getstring msg spflag)))
    
60.           (prompt "\nInvalid string.")
    
61.         )
    
62.         (setq inp (getstring msg spflag))
    
63.       )
    
64.     )
    
65.   )
    
66. )
    
67. 
    
68. (defun C:AF (/ cm l ll counts countn countp fp test testl n fnts fntb fntl
    
69.                uk fntf fntc countp
    
70.             )
    
71.   (setq cm (getvar "cmdecho")
    
72.         l (tnlist "style")
    
73.         ll (length l)
    
74.         counts 0
    
75.         countn 1
    
76.         countp 0
    
77.   )
    
78.   (setvar "cmdecho" 0)
    
79.   (textscr)
    
80.   (setq fp (open "$$temp$$" "w"))
    
81.   (close fp)
    
82.   (setq test (findfile "$$temp$$"))
    
83.   (command "files" 3 test "" "")
    
84.   (setq testl (strlen test))
    
85.   (setq test (substr test 1 (- testl 8)))
    
86.   (command "shell" "md AUTOFONT")
    
87. 
    
88.   (while (setq n (nth counts l))
    
89.     (setq counts (+ counts 1))
    
90.     (setq fnts (dxf 3 (tblsearch "style" n)))
    
91.     (setq fntb (dxf 4 (tblsearch "style" n)))
    
92.     (if (not (eq "txt" fnts))
    
93.       (setq fntl (append
    
94.                    fntl
    
95.                    (list (strcase fnts))
    
96.                  )
    
97.       )
    
98.     )
    
99.     (if (not (eq "" fntb))
    
100.       (setq fntl (append
     
101.                    fntl
     
102.                    (list (strcase fntb))
     
103.                  )
     
104.       )
     
105.     )
     
106.   )
     
107. 
     
108.   (foreach x fntl
     
109.     (if (not (member x fntll))
     
110.       (setq fntll (append
     
111.                     fntll
     
112.                     (list x)
     
113.                   )
     
114.       )
     
115.     )
     
116.   )
     
117.   (foreach x fntll
     
118.     (progn
     
119.       (setq uk (strcat "Include " x " file? "))
     
120.       (setq uk (ukword 1 "Y N" uk "Y"))
     
121.       (if (eq "Y" uk)
     
122.         (progn
     
123.           (if (setq fntf (findfile x))
     
124.             (progn
     
125.               (setq fntc (strcat test "autofont\" x))
     
126.               (command "files" 5 fntf fntc "" "")
     
127.               (setq countp (+ countp 1))
     
128.             )
     
129.             (prompt (strcat "\n****  " x "  is not a file or is not found in ACAD path ****\n"))
     
130.           )
     
131.         )
     
132.       )
     
133.     )
     
134.   )
     
135. 
     
136.   (setq dwgn (strcat (getvar "dwgname") ".dwg"))
     
137.   (setq dirn (strcat test "AUTOFONT\"))
     
138.   (setvar "cmdecho" cm)
     
139.   (prompt (strcat "\n" (rtos countp 5) " font file(s) referenced by " dwgn
     
140.                   " collected in " dirn "\n"
     
141.           )
     
142.   )
     
143.   (command pause)
     
144.   (graphscr)
     
145.   (prompt "\nFor other LSP drafting routines visit web site:")
     
146.   (prompt "\nhttp://ourworld.compuserve.com/homepages/PLANDECK  ")
     
147.   (princ)
     
148. )
     
149. ;;;  AF
     
150. (setvar "cmdecho" cm)
     
151. (prompt "\nType AF to run autofont.LSP \n")
     
152. (princ)
     

<br /> (setq cm (getvar "cmdecho"))<br /> (setvar "cmdecho" 0)<br /> <br /> (defun dxf (code elist)<br />   (cdr (assoc code elist))<br /> )<br /> <br /> (defun tnlist (tbname / tdata tblist)<br />   (while (setq tdata (tblnext tbname (not tdata)))<br />     (setq tblist (append<br />                    tblist<br />                    (list (dxf 2 tdata))<br />                  )<br />     )<br />   )<br /> )<br /> <br /> (defun ukword (bit kwd msg def / inp)<br />   (if (and<br />         def<br />         (/= def "")<br />       )<br />     (setq msg (strcat "\n" msg "<" def ">: ")<br />           bit (* 2 (fix (/ bit 2)))<br />     )<br />     (if (= " " (substr msg (strlen msg) 1))<br />       (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ": "))<br />       (setq msg (strcat "\n" msg ": "))<br />     )<br />   )<br />   (initget bit kwd)<br />   (setq inp (getkword msg))<br />   (if inp<br />     inp<br />     def<br />   )<br /> )<br /> <br /> (defun ustr (bit msg def spflag / inp nval)<br />   (if (and<br />         def<br />         (/= def "")<br />       )<br />     (setq msg (strcat "\n" msg "<" def ">: ")<br />           inp (getstring msg spflag)<br />           inp (if (= inp "")<br />                 def<br />                 inp<br />               )<br />     )<br />     (progn<br />       (if (= " " (substr msg (strlen msg) 1))<br />         (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ": "))<br />         (setq msg (strcat "\n" msg ": "))<br />       )<br />       (if (= bit 1)<br />         (while (= "" (setq inp (getstring msg spflag)))<br />           (prompt "\nInvalid string.")<br />         )<br />         (setq inp (getstring msg spflag))<br />       )<br />     )<br />   )<br /> )<br /> <br /> (defun C:AF (/ cm l ll counts countn countp fp test testl n fnts fntb fntl<br />                uk fntf fntc countp<br />             )<br />   (setq cm (getvar "cmdecho")<br />         l (tnlist "style")<br />         ll (length l)<br />         counts 0<br />         countn 1<br />         countp 0<br />   )<br />   (setvar "cmdecho" 0)<br />   (textscr)<br />   (setq fp (open "$$temp$$" "w"))<br />   (close fp)<br />   (setq test (findfile "$$temp$$"))<br />   (command "files" 3 test "" "")<br />   (setq testl (strlen test))<br />   (setq test (substr test 1 (- testl 8)))<br />   (command "shell" "md AUTOFONT")<br /> <br />   (while (setq n (nth counts l))<br />     (setq counts (+ counts 1))<br />     (setq fnts (dxf 3 (tblsearch "style" n)))<br />     (setq fntb (dxf 4 (tblsearch "style" n)))<br />     (if (not (eq "txt" fnts))<br />       (setq fntl (append<br />                    fntl<br />                    (list (strcase fnts))<br />                  )<br />       )<br />     )<br />     (if (not (eq "" fntb))<br />       (setq fntl (append<br />                    fntl<br />                    (list (strcase fntb))<br />                  )<br />       )<br />     )<br />   )<br /> <br />   (foreach x fntl<br />     (if (not (member x fntll))<br />       (setq fntll (append<br />                     fntll<br />                     (list x)<br />                   )<br />       )<br />     )<br />   )<br />   (foreach x fntll<br />     (progn<br />       (setq uk (strcat "Include " x " file? "))<br />       (setq uk (ukword 1 "Y N" uk "Y"))<br />       (if (eq "Y" uk)<br />         (progn<br />           (if (setq fntf (findfile x))<br />             (progn<br />               (setq fntc (strcat test "autofont\" x))<br />               (command "files" 5 fntf fntc "" "")<br />               (setq countp (+ countp 1))<br />             )<br />             (prompt (strcat "\n****  " x "  is not a file or is not found in ACAD path ****\n"))<br />           )<br />         )<br />       )<br />     )<br />   )<br /> <br />   (setq dwgn (strcat (getvar "dwgname") ".dwg"))<br />   (setq dirn (strcat test "AUTOFONT\"))<br />   (setvar "cmdecho" cm)<br />   (prompt (strcat "\n" (rtos countp 5) " font file(s) referenced by " dwgn<br />                   " collected in " dirn "\n"<br />           )<br />   )<br />   (command pause)<br />   (graphscr)<br />   (prompt "\nFor other LSP drafting routines visit web site:")<br />   (prompt "\nhttp://ourworld.compuserve.com/homepages/PLANDECK  ")<br />   (princ)<br /> )<br /> ;;;  AF<br /> (setvar "cmdecho" cm)<br /> (prompt "\nType AF to run autofont.LSP \n")<br /> (princ)<br />

darksun1480

好久了，怎么没人理我？

szkevin

是r12 dos版本中的一个文件操作对话框,具体功能不记的了.还记的用12版时,文件经常被锁定就无法打开,只好在command中输入files,跳出对话框,有六个功能,unlock files就是解锁的,对这个影象最深,其它就不记的了,有12版运行一下看看就知道了.
另外,你解密完成后,希望能提供出来供大家共享.

zsz9899000

我是菜鸟，不知道怎么用你的程序，我把你编的程序拷贝到NOTOPAD，存为AUTOFONT.lsp,不知道是否正确？