ll_j 发表于 2012-11-21 10:42:10

【文本】文本去空格程序

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

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

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

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

tender138 发表于 2018-7-18 17:02:41

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


删除全部空格，好东西！

20060510412 发表于 2019-2-25 09:53:39

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

kwok 发表于 2012-11-21 13:07:52

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

gaics 发表于 2012-11-29 12:01:01

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

smartstar 发表于 2012-11-29 12:07:23

支持一下。

ll_j 发表于 2012-11-29 13:43:47

gaics 发表于 2012-11-29 12:01 static/image/common/back.gif
acet-tjust 是什么？justifytext不可以吗？

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

gaics 发表于 2012-11-29 18:21:22

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

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

xiabin68 发表于 2012-12-31 18:36:29

学习了，，，，，，

pxt2001 发表于 2012-12-31 22:35:38

楼主乃高人，学习了。

快乐小子春天 发表于 2013-11-3 10:25:15

学习鸟

sicky111 发表于 2013-11-4 22:43:30

需要ET支持。
页: [1] 2 3
查看完整版本: 【文本】文本去空格程序