批量处理DWG，转换全角文字（TXT,MTEXT）到半角

newer

1、选择文字处理版本

1. (defun c:XDTB_TXTD2SBC (/ ss x txt y second)
   
2.   (if (and (xdrx_initssget "选取要全角转半角的文字<退出>:")
   
3.            (setq ss (xdrx_ssget '((0 . "TEXT,MTEXT"))))
   
4.       )
   
5.     (progn
   
6.       (xdrx_begin)
   
7.       (mapcar
   
8.         '(lambda (x)
   
9.            (setq txt (xdrx_getpropertyvalue x "textstring"))
   
10.            (mapcar '(lambda (y)
    
11.                       (if (= y "　")
    
12.                         (setq txt (xdrx_string_regexpr "　" txt " " 14))
    
13.                         (progn
    
14.                           (setq        first  (substr y 1 1)
    
15.                                 second (ascii (substr y 2 1))
    
16.                                 second (- second 128)
    
17.                                 str    (chr second)
    
18.                           )
    
19.                           (setq txt (xdrx_string_regexpr y txt str 14))
    
20.                         )
    
21.                       )
    
22.                     )
    
23.                    (xdrx_string_regexps "[\\u3000\\uff01-\\uff5f]" txt)
    
24.            )
    
25.            (xdrx_setpropertyvalue x "textstring" txt)
    
26.          )
    
27.         (xdrx_pickset->ents ss)
    
28.       )
    
29.       (xdrx_end)
    
30.     )
    
31.   )
    
32.   (princ)
    
33. )
    

(defun c:XDTB_TXTD2SBC (/ ss x txt y second)<br />   (if (and (xdrx_initssget "选取要全角转半角的文字<退出>:")<br />            (setq ss (xdrx_ssget '((0 . "TEXT,MTEXT"))))<br />       )<br />     (progn<br />       (xdrx_begin)<br />       (mapcar<br />         '(lambda (x)<br />            (setq txt (xdrx_getpropertyvalue x "textstring"))<br />            (mapcar '(lambda (y)<br />                       (if (= y "　")<br />                         (setq txt (xdrx_string_regexpr "　" txt " " 14))<br />                         (progn<br />                           (setq        first  (substr y 1 1)<br />                                 second (ascii (substr y 2 1))<br />                                 second (- second 128)<br />                                 str    (chr second)<br />                           )<br />                           (setq txt (xdrx_string_regexpr y txt str 14))<br />                         )<br />                       )<br />                     )<br />                    (xdrx_string_regexps "[\\u3000\\uff01-\\uff5f]" txt)<br />            )<br />            (xdrx_setpropertyvalue x "textstring" txt)<br />          )<br />         (xdrx_pickset->ents ss)<br />       )<br />       (xdrx_end)<br />     )<br />   )<br />   (princ)<br /> )<br />

下面是不打开DWG，批量处理的。



2、批量处理DWG版本

1. (defun c:XDTB_TxtBatD2SBC (/ txt match n num fns dwg layous lay num1)
   
2.   (defun _replace (o)
   
3.     (setq txt (vla-get-textstring o))
   
4.     (if        (setq
   
5.           match        (xd::string:regexps "[\\u3000\\uff01-\\uff5f]" txt "")
   
6.         )
   
7.       (progn (foreach n        match
   
8.                (if (= n "　")
   
9.                  (setq txt (xd::string:regexpr "　" txt " " ""))
   
10.                  (progn        (setq first  (substr n 1 1)
    
11.                               second (ascii (substr n 2 1))
    
12.                               second (- second 128)
    
13.                               str    (chr second)
    
14.                         )
    
15.                         (setq txt (xd::string:regexpr n txt str ""))
    
16.                  )
    
17.                )
    
18.              )
    
19.              (vla-put-textstring o txt)
    
20.              (setq num        (1+ num)
    
21.                    num1        (1+ num1)
    
22.              )
    
23.       )
    
24.     )
    
25.   )
    
26.   (defun _find_and_replace (doc)
    
27.     (textpage)
    
28.     (setq fns (1+ fns))
    
29.     (setq dwg (vla-get-name doc)
    
30.           dwg (strcat (vl-filename-base dwg) (vl-filename-extension dwg)))
    
31.     (princ (XD::String:TailFill (strcat "\n搜索 " dwg) " " 50))
    
32.     (setq layouts (vla-get-layouts doc))
    
33.     (setq num1 0)
    
34.     (vlax-for lay layouts
    
35.       (setq blk (vla-get-block lay))
    
36.       (vlax-for        o blk
    
37.         (if (or        (= (vla-get-objectname o) "AcDbText")
    
38.                 (= (vla-get-objectname o) "AcDbMText")
    
39.             )
    
40.           (progn (_replace o))
    
41.         )
    
42.       )
    
43.     )
    
44.     (princ (strcat "  替换 " (itoa num1) " 个文字对象."))
    
45.   )
    
46.   (setq        fns 0
    
47.         num 0
    
48.   )
    
49.   (xd::vla:odbx '_find_and_replace nil t)
    
50.   (princ (strcat "\n总共搜索了 "
    
51.                  (itoa fns)
    
52.                  " 个DWG文件，供转码了 "
    
53.                  (itoa num)
    
54.                  " 个文本对象."
    
55.          )
    
56.   )
    
57.   (princ)
    
58. )
    

(defun c:XDTB_TxtBatD2SBC (/ txt match n num fns dwg layous lay num1)<br />   (defun _replace (o)<br />     (setq txt (vla-get-textstring o))<br />     (if        (setq<br />           match        (xd::string:regexps "[\\u3000\\uff01-\\uff5f]" txt "")<br />         )<br />       (progn (foreach n        match<br />                (if (= n "　")<br />                  (setq txt (xd::string:regexpr "　" txt " " ""))<br />                  (progn        (setq first  (substr n 1 1)<br />                               second (ascii (substr n 2 1))<br />                               second (- second 128)<br />                               str    (chr second)<br />                         )<br />                         (setq txt (xd::string:regexpr n txt str ""))<br />                  )<br />                )<br />              )<br />              (vla-put-textstring o txt)<br />              (setq num        (1+ num)<br />                    num1        (1+ num1)<br />              )<br />       )<br />     )<br />   )<br />   (defun _find_and_replace (doc)<br />     (textpage)<br />     (setq fns (1+ fns))<br />     (setq dwg (vla-get-name doc)<br />           dwg (strcat (vl-filename-base dwg) (vl-filename-extension dwg)))<br />     (princ (XD::String:TailFill (strcat "\n搜索 " dwg) " " 50))<br />     (setq layouts (vla-get-layouts doc))<br />     (setq num1 0)<br />     (vlax-for lay layouts<br />       (setq blk (vla-get-block lay))<br />       (vlax-for        o blk<br />         (if (or        (= (vla-get-objectname o) "AcDbText")<br />                 (= (vla-get-objectname o) "AcDbMText")<br />             )<br />           (progn (_replace o))<br />         )<br />       )<br />     )<br />     (princ (strcat "  替换 " (itoa num1) " 个文字对象."))<br />   )<br />   (setq        fns 0<br />         num 0<br />   )<br />   (xd::vla:odbx '_find_and_replace nil t)<br />   (princ (strcat "\n总共搜索了 "<br />                  (itoa fns)<br />                  " 个DWG文件，供转码了 "<br />                  (itoa num)<br />                  " 个文本对象."<br />          )<br />   )<br />   (princ)<br /> )<br />

yangjian001

您有要求需要定制插件

s100sp

谢谢分享，谢谢分享

至尊宝宝

感谢楼主分享

hh_lj007

感谢分享源码