[LISP程序]：全角字符转半角字符

lihb

　请问各位如何能在CAD中实现半角字符->全角字符,全角字符->半角字符的转换.因为以前的DWG数据全都是以半角输入的(有数字,有英文字母,还有一些特殊的符号．如～，！％等等，现在要求将这些注记全都改成全角．请问各位有没有好的方法来解决这个问题．最好能用ＬＩＳＰ编一个这样的转换程序．

zxq0220

根据主题写了一个函数
[php]
;全角数字转换成半角数字
;zxq0220 2005.11.19
(DEFUN HARF (STR / SL I ST STS)
(SETQ SL (STRLEN STR) I 1 STS "")
(WHILE (< I SL)
  (IF (> (ASCII (SETQ ST (SUBSTR STR I 1))) 160)
   (SETQ STS (STRCAT STS (ITOA (- (ASCII (SUBSTR STR (1+ I) 1)) 176)))
         I (+ I 2))
   (SETQ STS (STRCAT STS ST) I (1+ I))
  )
)
STS
)
[/php]

测试有问题：
(HARF"晓东ＣＡＤ")→"78-5191720"
by xyp1964[/COLOR]

xyp1964

2. [FONT=courier new]
   
3. (load "xyp_lib.vlx")
   
4. ;|加载通用函数(可在签名栏直接下载)
   
5. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
   
6. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
   
7. ★1·在acad.lsp中增加(load"xyp_lib")
   
8. ■2·在每个程序内增加(load"xyp_lib")
   
9. ■3·在command下，输入(load"xyp_lib")
   
10. ■4·在菜单.mnl中增加(load"xyp_lib")
    
11. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
    
12. [COLOR=red] ★通用函数下载地址：[/COLOR]
    
13. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
    
14. |;
    
15. 
    
16. ;;;半角字符转全角字符
    
17. (defun c:test ()
    
18.   (setq        ss (ssget '((0 . "*TEXT")))
    
19.         i  -1
    
20.   )
    
21.   (while (setq s1 (ssname ss (setq i (1+ i))))
    
22.     (setq T-old        (cdr (assoc 1 (entget s1)))
    
23.           T-new        (xyp-Strcase T-old 0)
    
24.     )
    
25.     (if        (/= T-old T-new)
    
26.       (sub_upd s1 1 T-new)
    
27.     )
    
28.   )
    
29. )[/FONT]

[FONT=courier new]<br /> (load "xyp_lib.vlx")<br /> ;|加载通用函数(可在签名栏直接下载)<br /> 如果已经下载xyp_lib并放到搜索路径下可以不再下载!<br /> 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：<br /> ★1·在acad.lsp中增加(load"xyp_lib")<br /> ■2·在每个程序内增加(load"xyp_lib")<br /> ■3·在command下，输入(load"xyp_lib")<br /> ■4·在菜单.mnl中增加(load"xyp_lib")<br /> ■5·将xyp_lib.vlx文件直接拽到cad屏幕<br /> [COLOR=red] ★通用函数下载地址：[/COLOR]<br /> [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]<br /> |;<br /> <br /> ;;;半角字符转全角字符<br /> (defun c:test ()<br />   (setq        ss (ssget '((0 . "*TEXT")))<br />         i  -1<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq T-old        (cdr (assoc 1 (entget s1)))<br />           T-new        (xyp-Strcase T-old 0)<br />     )<br />     (if        (/= T-old T-new)<br />       (sub_upd s1 1 T-new)<br />     )<br />   )<br /> )[/FONT]

zxq0220

[php]
;全角字符转换成半角字符
;zxq0220 2005.11.20
(DEFUN HARF (STR / SL I ST STS)
(SETQ SL (STRLEN STR) I 1 STS "")
(WHILE (<= I SL)
  (IF (> (ASCII (SETQ ST (SUBSTR STR I 1))) 160)
   (SETQ STS (STRCAT STS (CHR (- (ASCII (SUBSTR STR (1+ I) 1)) 128)))
         I (+ I 2))
   (SETQ STS (STRCAT STS ST) I (1+ I))
  )
)
STS
)
[/php]

[php]
;半角字符转换成全角字符
;zxq0220 2005.11.20
(DEFUN FULL (STR / SL I ST STS)
(SETQ SL (STRLEN STR) I 1 STS "")
(WHILE (<= I SL)
  (IF (> (ASCII (SETQ ST (SUBSTR STR I 1))) 160)
   (SETQ STS (STRCAT STS (SUBSTR STR I 2)) I (+ I 2))
   (SETQ STS (STRCAT STS (CHR 163) (CHR (+ (ASCII ST) 128)))
        I (1+ I))
  )
)
STS
)
[/php]

xyp1964

最初由 zxq0220 发布
[B][php]
;全角字符转换成半角字符
;zxq0220 2005.11.20
(DEFUN HARF (STR / SL I ST STS)
(SETQ SL (STRLEN STR) I 1 STS "")
(WHILE (<= I SL)
  (IF (> (ASCII (SETQ ST (SUBSTR STR I 1))) 160)
   (SETQ ... [/B]

测试：

1. [FONT=courier new]
   
2. (FULL "晓东CAD")→"晓东ＣＡＤ"
   
3. (HARF"晓东ＣＡＤ")→"~+CAD"
   
4. [/FONT]

复制代码

HARF函数有点问题！

zxq0220

谢斑竹指正。
[php]
;全角字符转换成半角字符
;zxq0220 2005.11.20
(DEFUN HARF (STR / SL I ST STS)
(SETQ SL (STRLEN STR) I 1 STS "")
(WHILE (<= I SL)
  (IF (> (ASCII (SETQ ST (SUBSTR STR I 1))) 160)
   (IF (= (ASCII ST) 163)
    (SETQ STS (STRCAT STS (CHR (- (ASCII (SUBSTR STR (1+ I) 1)) 128)))
          I (+ I 2))
    (SETQ STS (STRCAT STS (SUBSTR STR I 2)) I (+ I 2))
   )
   (SETQ STS (STRCAT STS ST) I (1+ I))
  )
)
STS
)
[/php]
“收藏了！”by xyp1964[/COLOR]