autofont.lsp 的用法

hjj71715

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

前生

(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   testl  n             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

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

bashiyi

把lisp文件copy进SUPPORT文件夹内，使用load命令加载后，在命令行键入“AF”激活程序。

autofont.lsp程序由外国朋友编制，是一个R12下使用的程序，它有使用限制，本想修改它，但因为它在2000、2002、2004下使用已经没有多大意义，故放弃。

find.she

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