yang686526

有没有这样的lsp程序-请高手看看
www.dimcax.com
有没有这样的lsp程序-请高手看看
有没有这样的lsp程序
当我们打开一个cad dwg文档时候，里面的字体我们没有，
这个时候会跳出让你选择字体的对话框。
能不能开发一个lsp，能够自动将找不到的字体替换成一种指定的字体
从而绕开这个选择字体的对话框呢？
不知道用lsp写一个这样的程序难不难，我想vba是挺难做到的。
但是我只懂一点vba，所以要来lsp版块请教高手了。
d
晕，发错版子了，请版主帮忙转到lsp区。
易桥工具箱里面对这项功能有个介绍，不过我不太清楚是打开dwg时候自动替换，
还是怎么样？
“增加字体替代程序，在定义的字体不存在时用指定字体进行替代”
d
找到一个东西，不知道该怎么修改才好呢？
;将不认识的字体自动替换成,自己定义的字体。
;|
****readme text to autofont.lsp sept. 1, 1996***********
developed by peter allen landeck. all rights reserved @ 1996

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 \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
"\neck "
)
(princ)
)
(setvar "cmdecho" cm)
(princ)
)
)
d
巧用cad字体替换法...以后再也不需要求助cad字体了...
我们经常遇到这种情况：当打开别人图时，找不到原文件的字体，怎么办？
打开别人一张图时，要不停的替换我没有的字体文件，怎样才能一劳永逸？
　　下面就给你介绍一种很好的方法！拿来跟大家分享！！！
答：有两种办法，
　　一：复制要替换的字库为将被替换的字库名，如，打开一幅图，提示找不到jd字库，你想用hztxt.shx替换它，那么你可以把hztxt.shx 复制一份，命名为jd.shx,就可以解决了。不过这种办法的缺点显而易见，太占用磁盘空间。最好用下面这种办法。
　　二：在autocad r14/support 目录下创建acad.fmp文件，如果原来有此文件直接打开，这是一个ascii文件， 输入"jd;hztxt"， 如果还有别的字体要替换，可以另起一行，如“jh;hztxt"， 存盘退出， 以后如果你打开的图包含jd和jh这样你机子里没有的字库，就再也不会不停的要你找字库替换了。　　　　
　　当然有的朋友可能不是用r14，默认目录不在那里。
　　那么，下面我就告诉你一种方法：怎么样找到我的cad里面的acad.fmp文件？
在“开始”菜单 (windows) 中，单击“所有程序”（或“程序”） “autodesk” autocad
d