[求助]打开图纸开始时能否自动替换字体

tywsc · 发表于 2007-1-31 19:32:00

打开图纸开始时能自动替换字体的lisp：打开CAD图纸没有勾选大字体的勾选并用gbcbig代替，找不到英文字体的自动替换为txt，并选取大字体用gbcbig代替

我下面的例图：aa8.dwg,您下载用AutoCAD R14打开时会提示：

第一次提示 specfy font for fontalt 要求我选字体
我选择Hztxt
第二次提示 select shape file 要求我选自定义的字体
我选择Ex.shp

这个问题还挺关键的,如果打开图纸,选择字体时按"取消",后面程序中凡是有用"insert"命令时,程序就会出错.

不知道字体信息存在什么地方了,(系统变量里没有)

而且我每次打开图都有这个提示。

***注意：不是打开图之后，才替换字体，是打开一张图时，能否自动cad对字体的提问。

请斑竹指点一下吧!谢谢了。我怎么才能不用每次回答提示啊？

allen_lee · 发表于 2007-2-1 19:09:00

你在surport目录下找一个叫acad.fmp的文件,在那里面修改一下就行了,不过你的先知道哪个你没有的字体名字,在specfy font for fontalt 时会有提示,但是有的时候也不行,我也没搞太懂

Ea · 发表于 2007-2-1 19:24:00

这样的程序仅见过一个高人写过, ARX 程序用于 CAD2002，加载后只要打开图自动在后台按 INI 配置的字体自动替换，不会出现选择字体对话框

ygrzz · 发表于 2007-2-1 20:37:00

以下内容出自ShlispCAD，未经测试，因为我很少打开别人的图

;将不认识的字体自动替换成,自己定义的字体。
(defun c:gps_rep ( / cn elist en enl nm gps_hzstyle)

(if (not $gps_hztxt_e) (setq $gps_hztxt_e "hztxt_e.shx"))
(if (not $gps_hztxt)   (setq $gps_hztxt "hztxt.shx"))
(setq gps_hzstyle (strcat $gps_hztxt_e "," $gps_hztxt ))

    (setq elist (tblnext "STYLE" T))
    (while (/= elist nil)
      (setq nm (cdr (assoc 2 elist))
            en (cdr (assoc 3 elist))
            cn (cdr (assoc 4 elist))
           enl (strlen en)
      )
      (if (and
             (/= en nil)
             (= cn nil)
             (= (findfile en) nil)
             (= (strcase (substr en (- enl 2))) "SHX")
           )
         (command "_style" nm $gps_hztxt_e "0.0" "0.7" "" "" "" "")
      )
      (if (and
             (/= cn nil)
             (= (findfile cn) nil)
           )
         (command "_style" nm gps_hzstyle "0.0" "0.7" "" "" "" "")
      )
     (setq elist (tblnext "STYLE"))
   )
)

无痕 · 发表于 2007-2-1 22:12:00

本帖最后由作者于 2007-2-2 13:38:13 编辑

写过一个,但不是反应器类型.需要调用函数名开图.
不够完善,还没时间整,不好意思拿出来.
贴一个以前收集的 (未经测试)

;|
****Readme text to AUTOFONT.LSP Sept. 1, 1996***********
Developed by Peter Allen Landeck. All rights reserved @ 1996
100314.1364@compuserve.com
More LSP drafting routines may be found at:
http://ourworld.compuserve.com/homepages/PLANDECK
Thanks to J. Smith & R. Gesner authors of "Maximizing Autocad Volume II" some of whose subroutines are used in AUTOFONT.LSP.
AUTOFONT.LSP collects and assembles in a separate directory named AUTOFONT all big and small font files required to open a given drawing. This is usually an .SHX font file. However, any other referenced font file will be collected. If no special font files are referenced by the drawing (i.e. only the TXT.SHX font is used) user is prompted that no font files are referenced. Typically, special font files are used in title blocks and company logos which appear on Autocad drawings. User may also be prompted regarding named font styles which are not actually files. These are not assembled in the AUTOFONT directory and the user is prompted accordingly. It should not be necessary to export these with a drawing to have that drawing successfully opend on another computer system.
The AUTOFONT directory is automatically created in the Autocad path, usually at C:/ACAD/AUTOFONT. The user is prompted regarding its exact location. The directory may be deleted after use. Files in AUTOFONT directory will be overwritten by new font files with the same name when routine is used again.
This program is useful when transferring Autocad drawings to another computer or computer system which may not have the same set of font files.
LOADING: To load, make sure the AUTOFONT.LSP is in your ACAD path, usually ACAD/SUPPORT is a good location for LSP files. From the Autocad command line type (LOAD "AUTOFONT") including the parentheses and quotation marks. After the user prompt type AF to run the routine. Follow the prompts regarding files to be assembled in AUTOFONT directory.
If you load another drawing or quit the drawing editor you need to manually reload AUTOFONT.LSP as described above. This process may be automated in your ACAD.LSP file. See the Autocad reference manual for instructions how to automatically load LSP files when opening a drawing.
AUTOLOCK: AUTOFONT.LSP is equipped with another LSP program which will limit your use of AUTOFONT.LSP to 10 loadings, afterwhich AUTOFONT.LSP will cease to function. To obtain a copy with unlimited use send $20 to the following address:
Peter Landeck
606 West 49th Terrace
Kansas City, MO 64112
|;
(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)
)
)

;|
            ****Readme text to AUTOFONT.LSP Sept. 1, 1996***********
Developed by Peter Allen Landeck.  All rights reserved @ 1996
  100314.1364@compuserve.com
More LSP drafting routines may be found at:
  http://ourworld.compuserve.com/homepages/PLANDECK
Thanks to J. Smith & R. Gesner authors of "Maximizing Autocad Volume II" some of whose subroutines are used in AUTOFONT.LSP.
AUTOFONT.LSP collects and assembles in a separate directory named AUTOFONT all big and small font files required to open a given drawing.  This is usually an .SHX font file.  However, any other referenced font file will be collected.  If no special font files are referenced by the drawing (i.e. only the TXT.SHX font is used) user is prompted that no font files are referenced.  Typically, special font files are used in title blocks and company logos which appear on Autocad drawings.  User may also be prompted regarding named font styles which are not actually files.  These are not assembled in the AUTOFONT directory and the user is prompted accordingly.  It should not be necessary to export these with a drawing to have that drawing successfully opend on another computer system.
The AUTOFONT directory is automatically created in the Autocad path, usually at C:/ACAD/AUTOFONT.  The user is prompted regarding its exact location.  The directory may be deleted after use.  Files in AUTOFONT directory will be overwritten by new font files with the same name when routine is used again.  
This program is useful when transferring Autocad drawings to another computer or computer system which may not have the same set of font files.
LOADING:  To load, make sure the AUTOFONT.LSP is in your ACAD path, usually ACAD/SUPPORT is a good location for LSP files.  From the Autocad command line type (LOAD "AUTOFONT") including the parentheses and quotation marks. After the user prompt type AF to run the routine.  Follow the prompts regarding files to be assembled in AUTOFONT directory. 
If you load another drawing or quit the drawing editor you need to manually reload AUTOFONT.LSP as described above.  This process may be automated in your ACAD.LSP file.  See the Autocad reference manual for instructions how to automatically load LSP files when opening a drawing.
AUTOLOCK:  AUTOFONT.LSP is equipped with another LSP program which will limit your use of AUTOFONT.LSP to 10 loadings, afterwhich AUTOFONT.LSP will cease to function.  To obtain a copy with unlimited use send $20 to the following address:
        Peter Landeck
        606 West 49th Terrace
        Kansas City, MO  64112
|;
(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)
  )
)

tywsc · 发表于 2007-2-2 11:18:00

多谢楼上几位答复.

我下载先试一下.谢谢了.

好为人师 · 发表于 2008-2-11 16:16:00

请问有那位测试过了吗？有没有问题？？

xxxtttxxx · 发表于 2008-11-16 22:58:00

谁能帮忙把无痕版主发的lsp修改一下，

以方便用自己指定的字体替换未知字体呢？

不懂lsp，请高人帮忙！

coolpoom · 发表于 2008-11-18 09:28:00

给你做一个LISP
(defun c:stt()
(command"style""standard""宋体"""""""""""))

【KAIXIN】 · 发表于 2012-4-15 10:02:24

本帖最后由【KAIXIN】于 2012-4-15 10:02 编辑

这里有你要的答案

http://bbs.mjtd.com/thread-93031-1-1.html

账号		自动登录	找回密码
密码			注册

[求助]打开图纸开始时能否自动替换字体

本帖子中包含更多资源