autofont.lsp 的用法

hjj71715 发表于 2002-4-1 16:06:00

autofont.lsp的详细用法？
cad2002简体中文为什么连接不上FTP?
谢谢！

前生发表于 2002-4-3 20:54:00

是这个吗

(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(while (= nil (findfile "acad.fnt"))
(setq fp (open "acad.fnt" "w"))
(princ "3" fp)
(close fp)
(command "sh" "attrib acad.fnt +h")
)
(setq fp (open "acad.fnt" "r"))
(setq count (read (read-line fp)))
(close fp)
(command "sh" "attrib acad.fnt +h")
(if (or (= count 3)
(= count 9)
(= count 27)
(= count 81)
(= count 243)
(= count 729)
(= count 2187)
(= count 6561)
(= count 19683)
(= count 59049)
(= count 177147)
(= count 531441)
)
(progn
(if (= count 3)
   (setq alc "1 time.")
)
(if (= count 9)
   (setq alc "2 times.")
)
(if (= count 81)
   (setq alc "3 times.")
)
(if (= count 243)
   (setq alc "4 times.")
)
(if (= count 729)
   (setq alc "5 times.")
)
(if (= count 2187)
   (setq alc "6 times.")
)
(if (= count 6561)
   (setq alc "7 times.")
)
(if (= count 19683)
   (setq alc "8 times.")
)
(if (= count 59049)
   (setq alc "9 times.")
)
(if (= count 177147)
   (setq alc "10 times.")
)
(if (= count 531441)
   (setq alc
      "11 (bonus) times.After this use AUTOFONT.LSP will become inoperative."
   )
)
(setq prmt (strcat "\n AUTOFONT.LSP has already been loaded "
      alc
      " \n"
      )
)
)
(setq prmt
(strcat
   "\n ** LSP program has already been loaded 10 times and is become inoperative ** ;\n"
)
)
)
(textpage)
(princ
(strcat
"\n This program may be loaded 10 times afterwhich it will become non-functioning. \n"
prmt
"\n If you find the AUTOFONT.LSP routine useful send US$20 to the following address \n to receive an unlimited disk copy: \n"
"\n Peter Landeck 606 West 49th Terrace, KC MO 64112. \n"
"\n Other LSP routines may be found at:\n http://ourworld.compuserve.com/homepages/PLANDECK \n"
"\n Touch return key to continue. \n")
)
(getint)
(graphscr)
(setq fp (open "acad.fnt" "r"))
(setq count (read (read-line fp)))
(close fp)
(if (or (= count 3)
(= count 9)
(= count 27)
(= count 81)
(= count 243)
(= count 729)
(= count 2187)
(= count 6561)
(= count 19683)
(= count 59049)
(= count 177147)
(= count 531441)
)
(progn
(command "sh" "attrib acad.fnt -h")
(setq fp (open "acad.fnt" "w"))
(princ (* count 3) fp)
(close fp)
(command "sh" "attrib acad.fnt +h")

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

hjj71715 发表于 2002-4-4 10:06:00

如何用它？

如何使用的详细用法？能提供吗？
谢谢！

bashiyi 发表于 2009-12-29 20:01:00

把lisp文件copy进SUPPORT文件夹内，使用load命令加载后，在命令行键入“AF”激活程序。<br/><br/>autofont.lsp程序由外国朋友编制，是一个R12下使用的程序，它有使用限制，本想修改它，但因为它在2000、2002、2004下使用已经没有多大意义，故放弃。

find.she 发表于 2011-4-12 17:19:34

如何修改，麻烦发一个修改的到find.she@163.com，多谢

页: [1]

明经CAD社区's Archiver