[LISP程序]：修改缺少字体定义文件的程序

urljit

2. (defun c:zt ()
   
3.   (setq        tlist (tblnext "STYLE" T)
   
4.         slist nil
   
5.         bgfnt nil
   
6.   )
   
7.   (while tlist
   
8.     (setq sname (cdr (assoc 2 tlist)))
   
9.     (if        (and (/= sname "")
   
10.              (/= (logand 16 (cdr (assoc 70 tlist))) 16)
    
11.         )
    
12.       (setq slist (cons sname slist))
    
13.     )
    
14.     (setq smpfnt (cdr (assoc 3 tlist)))
    
15.     (setq bgfnt (cdr (assoc 4 tlist)))
    
16.     (if
    
17.       (and (/= bgfnt "")
    
18.            (not (or (findfile (strcat bgfnt ".shx")) (findfile bgfnt)))
    
19.       )
    
20.        (progn
    
21.          (princ "\n********")
    
22.          (princ sname)
    
23.          (princ "********\n")
    
24.          (setq tlist(entget(tblobjname "style" sname)))
    
25.          (setq tlist (subst (cons 4 "hztxt.shx") (assoc 4 tlist) tlist))
    
26.          (princ(entmod tlist))
    
27.        )
    
28.     )
    
29.     (if
    
30.       (or (and (/= smpfnt "")
    
31.                (not
    
32.                  (or (findfile (strcat smpfnt ".shx")) (findfile smpfnt))
    
33.                )
    
34.           )
    
35.           (wcmatch smpfnt "*`.ttf")
    
36.       )
    
37.        (progn
    
38.          (princ "\n********")
    
39.          (princ sname)
    
40.          (princ "********\n")
    
41.          (setq tlist(entget(tblobjname "style" sname)))
    
42.          (setq tlist (subst (cons 4 "hztxt.shx") (assoc 4 tlist) tlist))
    
43.          (setq tlist (subst (cons 3 "txt.shx") (assoc 3 tlist) tlist))
    
44.          (princ(entmod tlist))
    
45.          (setq tlist_last tlist)
    
46.        )
    
47.     )
    
48.     (setq tlist (tblnext "STYLE"))
    
49.   )
    
50.   (princ slist)
    
51.   (princ)
    
52. )

(defun c:zt ()<br />   (setq        tlist (tblnext "STYLE" T)<br />         slist nil<br />         bgfnt nil<br />   )<br />   (while tlist<br />     (setq sname (cdr (assoc 2 tlist)))<br />     (if        (and (/= sname "")<br />              (/= (logand 16 (cdr (assoc 70 tlist))) 16)<br />         )<br />       (setq slist (cons sname slist))<br />     )<br />     (setq smpfnt (cdr (assoc 3 tlist)))<br />     (setq bgfnt (cdr (assoc 4 tlist)))<br />     (if<br />       (and (/= bgfnt "")<br />            (not (or (findfile (strcat bgfnt ".shx")) (findfile bgfnt)))<br />       )<br />        (progn<br />          (princ "\n********")<br />          (princ sname)<br />          (princ "********\n")<br />          (setq tlist(entget(tblobjname "style" sname)))<br />          (setq tlist (subst (cons 4 "hztxt.shx") (assoc 4 tlist) tlist))<br />          (princ(entmod tlist))<br />        )<br />     )<br />     (if<br />       (or (and (/= smpfnt "")<br />                (not<br />                  (or (findfile (strcat smpfnt ".shx")) (findfile smpfnt))<br />                )<br />           )<br />           (wcmatch smpfnt "*`.ttf")<br />       )<br />        (progn<br />          (princ "\n********")<br />          (princ sname)<br />          (princ "********\n")<br />          (setq tlist(entget(tblobjname "style" sname)))<br />          (setq tlist (subst (cons 4 "hztxt.shx") (assoc 4 tlist) tlist))<br />          (setq tlist (subst (cons 3 "txt.shx") (assoc 3 tlist) tlist))<br />          (princ(entmod tlist))<br />          (setq tlist_last tlist)<br />        )<br />     )<br />     (setq tlist (tblnext "STYLE"))<br />   )<br />   (princ slist)<br />   (princ)<br /> )

urljit

结果怎样？