文字替代（解决文字乱码用）
本帖最后由 【KAIXIN】 于 2012-4-18 18:22 编辑;文字替代（解决文字乱码用）
(defun c:KK( / lb_eng lb_chn lb_sech lb_tt1 lb_tt2 lb_a1 lb_a2 lb_hh)
(setvar "REGENMODE" 0)
(setq lb_eng (getstring "英文替代<Simplex>:") lb_chn (getstring "中文替代<Hztxt>:"))
(if (= "" lb_eng)(setq lb_eng "simplex"))
(if (= "" lb_chn)(setq lb_chn "hztxt"))
(setq lb_sech (tblnext "style" t))
(while lb_sech
(setq lb_tt1 (cdr(assoc 3 lb_sech)) lb_tt2 (cdr(assoc 4 lb_sech)))
(if (or (<= (strlen lb_tt1) 4)
(/= "." (strcase(substr lb_tt1 (- (strlen lb_tt1) 3) 1)))
)
(setq lb_tt1 (strcat lb_tt1 ".shx"))
)
(if (or (<= (strlen lb_tt2) 4)
(/= "." (strcase(substr lb_tt2 (- (strlen lb_tt2) 3) 1)))
)
(if (/= "" lb_tt2)(setq lb_tt2 (strcat lb_tt2 ".shx")))
)
(if (/= ".TTF" (strcase(substr lb_tt1 (- (strlen lb_tt1) 3) 4)))
(progn
(if (null (findfile lb_tt1))(setq lb_a1 lb_eng)(setq lb_a1 lb_tt1))
(if (= "" lb_tt2)
(setq lb_a2 "")
(if (null (findfile lb_tt2))(setq lb_a2 lb_chn)(setq lb_a2 lb_tt2))
)
(setq lb_hh (strcat lb_a1 "," lb_a2))
(command "-style" (cdr(assoc 2 lb_sech)) lb_hh "" "" "" "" "" "")
)
(if (null (findfile lb_tt1))(command "-style" (cdr(assoc 2 lb_sech)) (strcat lb_eng "," lb_chn) "" "" "" "" "" ""))
)
(setq lb_sech (tblnext "style"))
)
(setvar "REGENMODE" 1)
(command "regen")
) http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 【KAIXIN】的微博 ;修改版本
(defun c:ql (/ lb_eng lb_chn lb_sech lb_tt1 lb_tt2 lb_a1 lb_a2 lb_hh tst)
(setvar "cmdecho" 0)
(setvar "REGENMODE" 0)
(setq lb_eng (getstring "英文替代<Simplex>:")
lb_chn (getstring "中文替代<Hztxt>:")
)
(if (= "" lb_eng)
(setq lb_eng "Simplex")
)
(if (= "" lb_chn)
(setq lb_chn "hztxt")
)
(setq lb_sech (tblnext "style" t))
(while lb_sech
(setq lb_tt1 (cdr (assoc 3 lb_sech))
lb_tt2 (cdr (assoc 4 lb_sech))
tst nil
)
(if (not (wcmatch lb_tt1 "*`.*"))
(setq lb_tt1 (strcat lb_tt1 ".shx"))
)
(if (and
(not (wcmatch lb_tt2 "*`.*"))
(/= "" lb_tt2)
)
(setq lb_tt2 (strcat lb_tt2 ".shx"))
)
(if (not (wcmatch (strcase lb_tt1) "*`.TTF"))
(progn
(if (null (findfile lb_tt1))
(progn
(setq lb_a1 lb_eng
tst t
)
)
(setq lb_a1 lb_tt1)
)
(if (/= "" lb_tt2)
(progn
(if (null (findfile lb_tt2))
(progn
(setq lb_a2 lb_chn
tst t
)
)
(setq lb_a2 lb_tt2)
)
)
)
(if (= "" lb_tt2)
(setq lb_hh lb_a1)
(setq lb_hh (strcat lb_a1 "," lb_a2))
)
(if tst
(command "-style" (cdr (assoc 2 lb_sech)) lb_hh "0" "" "" "" "" "")
)
)
)
(setq lb_sech (tblnext "style"))
)
(setvar "REGENMODE" 1)
(command "regen")
(setvar "cmdecho" 1)
(princ)
)
顶起来，，谢谢楼主及评论区大神的分享 好东西，顶上去，感谢地板的lsp代码 好程序啊，顶一个。 好程序，谢谢。 真是个高手啊 好东西，顶上去！ 好东西，一定要顶上去。 (defun c:nx
(/ thisdrawing acaddocument txtstyles txtlayer fontfile)
(setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
(setq acaddocument (vla-get-activedocument (vlax-get-acad-object)))
(setq txtstyles (vla-get-textstyles thisdrawing))
(vlax-for txtstyle txtstyles
(progn
(setq fontfile (vla-get-fontfile txtstyle))
(setq bigfile (vla-get-bigfontfile txtstyle))
(if (not (wcmatch fontfile "*.ttf,*TTF"))
(progn
(vla-put-fontfile txtstyle "gbenor.shx")
(vla-put-bigfontfile txtstyle "GBCBIG.shx")
(vla-put-width txtstyle 1.0)
)
)
)
)
(vla-regen acadDocument acActiveViewport)
(princ)
)
(defun c:tx (/ acaddocument tstyle textitem textcont seltext i textsel texti)(vl-load-com)(setq acaddocument (vla-get-activedocument (vlax-get-acad-object)))(setq tstyle (vla-get-textstyles acaddocument))
(vla-add tstyle "CXB_txt")(setq textitem (vla-item tstyle "CXB_txt"))(vla-put-fontfile textitem "gbenor.shx") (vla-put-bigfontfile textitem "GBCBIG.shx")(vla-put-width textitem 1)(vla-put-height textitem 0.0)(prompt "\n点选需转换的字体：")(setq seltext (vlax-ename->vla-object (car (entsel))))(setq selstyle (vla-get-stylename seltext))(setq textsel (ssget "_x" (list (cons 0 "TEXT,ATTDEF") (cons 7 selstyle))))(setq i 0)(repeat (sslength textsel) (setq texti (vlax-ename->vla-object (ssname textsel i))) (vla-put-stylename texti "CXB_txt") (vla-put-scalefactor texti 1) (setq i (1+ i)))(vla-regen acadDocument acActiveViewport)(princ))
试试这个
K版，你的是不是有点问题，提示未知命令，是不是哪里多了一个括号？ 能不能解释一下程序的原理？
页:
[1]
2