文字替代（解决文字乱码用）

【KAIXIN】 · 发表于 2011-12-11 10:10

本帖最后由【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")
)

;文字替代（解决文字乱码用） 
(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") 
)

该贴已经同步到【KAIXIN】的微博

999999 · 发表于 2020-9-27 10:43

顶起来，，谢谢楼主及评论区大神的分享

vlisp2012 · 发表于 2011-12-11 10:27

好程序啊，顶一个。

nyistjz · 发表于 2011-12-11 13:12

好程序，谢谢。

wudechao · 发表于 2011-12-12 03:13

;修改版本
(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)
)

梦与现实交替 · 发表于 2011-12-12 10:18

真是个高手啊

【KAIXIN】 · 发表于 2012-4-11 19:27

好东西，顶上去！

smartstar · 发表于 2012-4-29 08:50

好东西，一定要顶上去。

xiguao · 发表于 2012-4-29 09:25

(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))
试试这个

自贡黄明儒 · 发表于 2012-11-5 14:07

K版，你的是不是有点问题，提示未知命令，是不是哪里多了一个括号？

poople · 发表于 2012-11-6 12:53

能不能解释一下程序的原理？

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

文字替代（解决文字乱码用）

评分

点评

点评