【文本】文本去空格程序

ll_j

各位好！
       前几天看到一个帖子，需要将文本去掉空格，但显示位置不变，这种程序本人以前也研究过，因为文字占位的算法问题，总是不能如意，这次又看到这种帖子，仔细考虑了一下，决定借用ExpressTools的函数acet-tjust（修改文本对齐方式）来实现，于是有了下面一段程序。
       好久不动Lisp了，命令多记不住了，所以一边翻书、一边构思、一边成文，多少有些凌乱，好在简单测试，目的可以达到。因为不是常用程序，也不准备再作完善了。

1. (defun c:ttrim(/ ss i l0 en ne eg ng e0 e1 j)
   
2.   (command ".color" (getvar "cecolor"))
   
3.   (princ "\n选择需要去空格的文本: ")
   
4.   (setq ss(ssget '((0 . "TEXT") (1 . "* *"))))
   
5.   (if ss
   
6.     (progn
   
7.       (setq l0 (sslength ss)
   
8.      i -1
   
9.       )
   
10.       (acet-tjust ss "R")
    
11.     )
    
12.   )
    
13.   (repeat l0
    
14.     (setq i (1+ i)
    
15.    en (ssname ss i)
    
16.    eg (entget en)
    
17.    e1 (cdr (assoc 1 eg))
    
18.     )
    
19.     (if (wcmatch e1 " *")
    
20.       (progn
    
21. (setq e1 (vl-string-left-trim " " e1)
    
22.        eg (subst (cons 1 e1) (assoc 1 eg) eg)
    
23. )
    
24. (entmod eg)
    
25.       )
    
26.     )
    
27.     (if (wcmatch e1 "* ")
    
28.       (progn
    
29. (acet-tjust (ssadd en) "S")
    
30. (setq eg (entget en)
    
31.        e1 (cdr (assoc 1 eg))
    
32.        e1 (vl-string-right-trim " " e1)
    
33.        eg (subst (cons 1 e1) (assoc 1 eg) eg)
    
34. )
    
35. (entmod eg)
    
36.       )
    
37.       (acet-tjust (ssadd en) "S")
    
38.     )
    
39.     (while (wcmatch e1 "* *")
    
40.       (setq eg (entget en)
    
41.      ng (entmake eg)
    
42.      ne (entlast)
    
43.      ng (entget ne)
    
44.      e0 (cdr (assoc 1 ng))
    
45.      e0 (substr e0 1 (setq j (vl-string-search " " e0)))
    
46.      ng (subst (cons 1 e0) (assoc 1 ng) ng)
    
47.       )
    
48.       (entmod ng)
    
49.       (acet-tjust (ssadd en) "R")
    
50.       (setq eg (entget en)
    
51.      e1 (cdr (assoc 1 eg))
    
52.      e1 (vl-string-left-trim " " (substr e1 (+ j 1)))
    
53.      eg (subst (cons 1 e1) (assoc 1 eg) eg)
    
54.       )
    
55.       (entmod eg)
    
56.       (setq eg (entget en)
    
57.      e1 (cdr (assoc 1 eg))
    
58.       )
    
59.       (acet-tjust (ssadd en) "S")
    
60.     )
    
61.   )
    
62.   (princ)
    
63. )
    

(defun c:ttrim(/ ss i l0 en ne eg ng e0 e1 j)<br />   (command ".color" (getvar "cecolor"))<br />   (princ "\n选择需要去空格的文本: ")<br />   (setq ss(ssget '((0 . "TEXT") (1 . "* *"))))<br />   (if ss<br />     (progn<br />       (setq l0 (sslength ss)<br />      i -1<br />       )<br />       (acet-tjust ss "R")<br />     )<br />   )<br />   (repeat l0<br />     (setq i (1+ i)<br />    en (ssname ss i)<br />    eg (entget en)<br />    e1 (cdr (assoc 1 eg))<br />     )<br />     (if (wcmatch e1 " *")<br />       (progn<br /> (setq e1 (vl-string-left-trim " " e1)<br />        eg (subst (cons 1 e1) (assoc 1 eg) eg)<br /> )<br /> (entmod eg)<br />       )<br />     )<br />     (if (wcmatch e1 "* ")<br />       (progn<br /> (acet-tjust (ssadd en) "S")<br /> (setq eg (entget en)<br />        e1 (cdr (assoc 1 eg))<br />        e1 (vl-string-right-trim " " e1)<br />        eg (subst (cons 1 e1) (assoc 1 eg) eg)<br /> )<br /> (entmod eg)<br />       )<br />       (acet-tjust (ssadd en) "S")<br />     )<br />     (while (wcmatch e1 "* *")<br />       (setq eg (entget en)<br />      ng (entmake eg)<br />      ne (entlast)<br />      ng (entget ne)<br />      e0 (cdr (assoc 1 ng))<br />      e0 (substr e0 1 (setq j (vl-string-search " " e0)))<br />      ng (subst (cons 1 e0) (assoc 1 ng) ng)<br />       )<br />       (entmod ng)<br />       (acet-tjust (ssadd en) "R")<br />       (setq eg (entget en)<br />      e1 (cdr (assoc 1 eg))<br />      e1 (vl-string-left-trim " " (substr e1 (+ j 1)))<br />      eg (subst (cons 1 e1) (assoc 1 eg) eg)<br />       )<br />       (entmod eg)<br />       (setq eg (entget en)<br />      e1 (cdr (assoc 1 eg))<br />       )<br />       (acet-tjust (ssadd en) "S") <br />     )<br />   )<br />   (princ)<br /> )<br />

cabinsummer

1. (defun RemoveSpace (str)
   
2.   (apply 'strcat (mapcar 'vl-prin1-to-string (read (strcat "(" str ")"))))
   
3. )
   
4. ;;;示例
   
5. (RemoveSpace "ABC DEF GHI")
   
6. ;;;返回"ABCDEFGHI"

(defun RemoveSpace (str)<br />   (apply 'strcat (mapcar 'vl-prin1-to-string (read (strcat "(" str ")"))))<br /> )<br /> ;;;示例<br /> (RemoveSpace "ABC DEF GHI")<br /> ;;;返回"ABCDEFGHI"

tender138

cabinsummer 发表于 2017-11-20 10:37

删除全部空格，好东西！

20060510412

谢谢楼主分享，楼主是个热心人！

kwok

支持一下.........

gaics

acet-tjust 是什么？justifytext不可以吗？

smartstar

支持一下。

ll_j

gaics 发表于 2012-11-29 12:01
acet-tjust 是什么？justifytext不可以吗？

acet-tjust就是Justify text所使用的内部函数，是随着ET的加载而加载的。

gaics

ll_j 发表于 2012-11-29 13:43
acet-tjust就是Justify text所使用的内部函数，是随着ET的加载而加载的。

是Justify text所使用的内部函数为什么还要额外加载？

xiabin68

学习了，，，，，，

pxt2001

楼主乃高人，学习了。

快乐小子春天

学习鸟

sicky111

需要ET支持。