（完成）[编程申请]：解决中英文等高。

XDSoft · 发表于 2002-8-12 17:56:17

程序写好了，请试用...

登录/注册后可看大图

[FONT=courier new]
;|
命令：txt_hzen
功能：将一个包含汉字和英文的字符串，按照汉字和英文分开，英文高度可以缩小
说明：1、对于标点符号，定义在plist，这个里面的标点如果紧跟汉字后面，当汉字整体不进行处理。
|;
(defun c:txt_hzen (/ $txt_hzen_pro ss e str)
(defun $txt_hzen_pro (e / $txt_enamke1 $txt_enamke2 hztxt entxt pj box ed
ed1 thigh oldpj oldtxt oldhigh ang str cha tf
plist
)
(defun $txt_entmake1 ()
(if (/= entxt "")
(progn
(setq pj1 pj)
(if (/= $txt_hzen_enpos 0)
(setq pj1 (mapcar
'+
pj
(list 0.0 (/ thigh $txt_hzen_enpos) 0.0)
)
)
)
(setq ed1 (subst
(cons 1 entxt)
oldtxt
ed
)
ed1 (subst
(cons 10 pj1)
oldpj
ed1
)
ed1 (subst
(cons 40 (* $txt_hzen_enhigh thigh))
oldhigh
ed1
)
)
(entmake ed1)
(setq box ($xdlsp_textbox (entget (entlast)))
pj (polar pj ang (+ (/ thigh $txt_hzen_endis) (-
(caadr box)
(caar box)
)
)
)
)
(setq entxt "")
)
)
)
(defun $txt_entmake2 ()
(if (/= hztxt "")
(progn
(setq ed1 (subst
(cons 1 hztxt)
oldtxt
ed
)
ed1 (subst
(cons 10 pj)
oldpj
ed1
)
)
(entmake ed1)
(setq box ($xdlsp_textbox (entget (entlast)))
pj (polar pj ang (+ (/ thigh $txt_hzen_endis) (-
(caadr box)
(caar box)
)
)
)
)
(setq hztxt "")
)
)
)
(setq plist ".,;:") ; 标点符号过滤表
(setq pj (xdrx_getentdxf 10)
str (xdrx_getentdxf 1)
ang (xdrx_getentdxf 50)
thigh (xdrx_getentdxf 40)
ed (entget e)
oldtxt (cons 1 str)
oldpj (cons 10 pj)
oldhigh (cons 40 thigh)
entxt ""
hztxt ""
)
($xdlsp_text_todb str)
(while (setq cha ($xdlsp_text_getstr))
(if ($xdlsp_text_ishz cha)
(progn
($txt_entmake1)
(setq hztxt (strcat hztxt cha))
)
(progn
(setq tf nil)
(if (/= "" hztxt)
(progn
(if (xdrx_string_find plist cha)
(setq hztxt (strcat hztxt cha)
tf t
)
)
)
)
(if (not tf)
(progn
(setq entxt (strcat entxt cha))
($txt_entmake2)
)
)
)
)
)
($txt_entmake1)
($txt_entmake2)
(entdel e)
(princ)
)
;|
主程序
|;
(prompt "\n请选取要中英文处理的文字[All-全选]<退出>:")
(if (setq ss (ssget '((0 . "text"))))
(progn
(if (not $txt_hzen_enhigh)
(setq $txt_hzen_enhigh 0.8)
)
(if (not $txt_hzen_enpos)
(setq $txt_hzen_enpos 8)
)
(if (not $txt_hzen_endis)
(setq $txt_hzen_endis 8)
)
(setq tf t)
(while tf
(initget "H P D")
(prompt (strcat "\n{英文字高系数：" (rtos $txt_hzen_enhigh 2 2)
" / 英文上移系数：" (itoa $txt_hzen_enpos)
" / 英汉间距系数：" (itoa $txt_hzen_endis) "}"
)
)
(if (setq tf (getkword "\n修改英文系数: [H-字高/ P-上移/ D-英汉间距]<不变>:"))
(progn
(initget 6)
(cond
((= "H" tf)
(if (setq thigh (getreal (strcat "\n英文和中文字高比<"
(rtos $txt_hzen_enhigh 2 2)
">:"
)
)
)
(setq $txt_hzen_enhigh thigh)
)
)
((= "P" tf)
(initget 4)
(if (setq pos (getint (strcat "\n英文从基线上移高度(字高几分之一)<"
(itoa $txt_hzen_enpos) ">:"
)
)
)
(setq $txt_hzen_enpos pos)
)
)
((= "D" tf)
(if (setq endis (getint (strcat "\n英汉间距(字高几分之一)<"
(itoa $txt_hzen_endis) ">:"
)
)
)
(setq $txt_hzen_endis endis)
)
)
)
)
)
)
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(setq str (xdrx_getentdxf 1))
(if (and
($xdlsp_text_hasHz str)
($xdlsp_text_hasEn str)
)
(progn
($txt_hzen_pro e)
)
)
)
)
)
(princ)
)[/FONT]

[FONT=courier new] 
;| 
   命令：txt_hzen 
    
   功能：将一个包含汉字和英文的字符串，按照汉字和英文分开，英文高度可以缩小 
    
   说明：1、对于标点符号，定义在plist，这个里面的标点如果紧跟汉字后面，当汉字整体不进行处理。 
|; 
(defun c:txt_hzen (/ $txt_hzen_pro  ss e str) 
  (defun $txt_hzen_pro (e / $txt_enamke1 $txt_enamke2 hztxt entxt pj box ed 
                          ed1 thigh oldpj oldtxt oldhigh ang str cha tf 
                          plist 
                       ) 
    (defun $txt_entmake1 () 
      (if (/= entxt "") 
        (progn 
          (setq pj1 pj) 
          (if (/= $txt_hzen_enpos 0) 
            (setq pj1 (mapcar 
                        '+ 
                        pj 
                        (list 0.0 (/ thigh $txt_hzen_enpos) 0.0) 
                      ) 
            ) 
          ) 
          (setq ed1 (subst 
                      (cons 1 entxt) 
                      oldtxt 
                      ed 
                    ) 
                ed1 (subst 
                      (cons 10 pj1) 
                      oldpj 
                      ed1 
                    ) 
                ed1 (subst 
                      (cons 40 (* $txt_hzen_enhigh thigh)) 
                      oldhigh 
                      ed1 
                    ) 
          ) 
          (entmake ed1) 
          (setq box ($xdlsp_textbox (entget (entlast))) 
                pj (polar pj ang (+ (/ thigh $txt_hzen_endis) (- 
                                                                 (caadr box) 
                                                                 (caar box) 
                                                              ) 
                                 ) 
                   ) 
          ) 
          (setq entxt "") 
        ) 
      ) 
    ) 
    (defun $txt_entmake2 () 
      (if (/= hztxt "") 
        (progn 
          (setq ed1 (subst 
                      (cons 1 hztxt) 
                      oldtxt 
                      ed 
                    ) 
                ed1 (subst 
                      (cons 10 pj) 
                      oldpj 
                      ed1 
                    ) 
          ) 
          (entmake ed1) 
          (setq box ($xdlsp_textbox (entget (entlast))) 
                pj (polar pj ang (+ (/ thigh $txt_hzen_endis) (- 
                                                                 (caadr box) 
                                                                 (caar box) 
                                                              ) 
                                 ) 
                   ) 
          ) 
          (setq hztxt "") 
        ) 
      ) 
    ) 
    (setq plist ".,;:")                       ; 标点符号过滤表 
    (setq pj (xdrx_getentdxf 10) 
          str (xdrx_getentdxf 1) 
          ang (xdrx_getentdxf 50) 
          thigh (xdrx_getentdxf 40) 
          ed (entget e) 
          oldtxt (cons 1 str) 
          oldpj (cons 10 pj) 
          oldhigh (cons 40 thigh) 
          entxt "" 
          hztxt "" 
    ) 
    ($xdlsp_text_todb str) 
    (while (setq cha ($xdlsp_text_getstr)) 
      (if ($xdlsp_text_ishz cha) 
        (progn 
          ($txt_entmake1) 
          (setq hztxt (strcat hztxt cha)) 
        ) 
        (progn 
          (setq tf nil) 
          (if (/= "" hztxt) 
            (progn 
              (if (xdrx_string_find plist cha) 
                (setq hztxt (strcat hztxt cha) 
                      tf t 
                ) 
              ) 
            ) 
          ) 
          (if (not tf) 
            (progn 
              (setq entxt (strcat entxt cha)) 
              ($txt_entmake2) 
            ) 
          ) 
        ) 
      ) 
    ) 
    ($txt_entmake1) 
    ($txt_entmake2) 
    (entdel e) 
    (princ) 
  ) 
;| 
  主程序 
|; 
  (prompt "\n请选取要中英文处理的文字[All-全选]<退出>:") 
  (if (setq ss (ssget '((0 . "text")))) 
    (progn 
      (if (not $txt_hzen_enhigh) 
        (setq $txt_hzen_enhigh 0.8) 
      ) 
      (if (not $txt_hzen_enpos) 
        (setq $txt_hzen_enpos 8) 
      ) 
      (if (not $txt_hzen_endis) 
        (setq $txt_hzen_endis 8) 
      ) 
      (setq tf t) 
      (while tf 
        (initget "H P D") 
 
        (prompt (strcat "\n{英文字高系数：" (rtos $txt_hzen_enhigh 2 2) 
                        " / 英文上移系数：" (itoa $txt_hzen_enpos) 
                        " / 英汉间距系数：" (itoa $txt_hzen_endis) "}" 
                ) 
        ) 
        (if (setq tf (getkword "\n修改英文系数: [H-字高/ P-上移/ D-英汉间距]<不变>:")) 
          (progn 
            (initget 6) 
            (cond 
              ((= "H" tf) 
                (if (setq thigh (getreal (strcat "\n英文和中文字高比<" 
                                                 (rtos $txt_hzen_enhigh 2 2) 
                                                 ">:" 
                                         ) 
                                ) 
                    ) 
                  (setq $txt_hzen_enhigh thigh) 
                ) 
              ) 
              ((= "P" tf) 
                (initget 4) 
                (if (setq pos (getint (strcat "\n英文从基线上移高度(字高几分之一)<" 
                                              (itoa $txt_hzen_enpos) ">:" 
                                      ) 
                              ) 
                    ) 
                  (setq $txt_hzen_enpos pos) 
                ) 
              ) 
              ((= "D" tf) 
                (if (setq endis (getint (strcat "\n英汉间距(字高几分之一)<" 
                                                (itoa $txt_hzen_endis) ">:" 
                                        ) 
                                ) 
                    ) 
                  (setq $txt_hzen_endis endis) 
                ) 
              ) 
            ) 
          ) 
        ) 
      ) 
      (xdrx_setsstodb ss 0) 
      (while (setq e (xdrx_getentdata 0)) 
        (setq str (xdrx_getentdxf 1)) 
        (if (and 
              ($xdlsp_text_hasHz str) 
              ($xdlsp_text_hasEn str) 
            ) 
          (progn 
            ($txt_hzen_pro e) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)[/FONT]

下面程序是这个程序发布时候，以前写过的所有“文字处理”的程序，其中部分程序修改了功能，请下载最新的附件...

hcy1119 · 发表于 2009-2-23 13:38:38

好东西

idchris · 发表于 2009-3-7 12:27:24

鼓励一下。收藏借鉴参考

longer1000 · 发表于 2009-3-8 00:19:49

用了字符没有变化啊，我用的是2006版本

xiayouxyj1 · 发表于 2014-11-30 17:58:10

请问楼主，这段程序如何用？

XDSoft · 发表于 2014-11-30 18:01:51

xiayouxyj1 发表于 2014-11-30 17:58
请问楼主，这段程序如何用？

12年前的帖子给翻出来了，

拷贝回去，保存成扩展名LSP的文件，在CAD下加载，然后用命令： txt_hzen 执行。

如果你怎么加载也不会，那么需要在论坛多看看置顶的帖子，多学学相关知识了。

xiayouxyj1 · 发表于 2014-11-30 18:03:27

XDSoft 发表于 2014-11-30 18:01
12年前的帖子给翻出来了，

拷贝回去，保存成扩展名LSP的文件，在CAD下加载，然后用命令： txt_hzen 执 ...

谢谢。lisp程序，我会用。只是没有提示是什么代码。

XDSoft · 发表于 2014-11-30 18:06:46

xiayouxyj1 发表于 2014-11-30 18:03
谢谢。lisp程序，我会用。只是没有提示是什么代码。

在论坛上，你能看到明文的代码，基本上是LISP，如果你发现里面有 defun ，那就肯定是LISP了。这个程序12年了，不保证还是否能正常，试试吧。你可以下载晓东工具箱3.0版本，2005年以前论坛所有的工具基本都在里面了，安装直接运行。

xiayouxyj1 · 发表于 2014-11-30 18:23:31

XDSoft 发表于 2014-11-30 18:06
在论坛上，你能看到明文的代码，基本上是LISP，如果你发现里面有 defun ，那就肯定是LISP了。这个程序12 ...

谢谢，测试　不正常。

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

（完成）[编程申请]：解决中英文等高。

程序写好了，请试用

点评

点评

点评

点评