删除文字的首尾空格后原地保持文字位置

dcl1214

1. (DEFUN C:TT ()
   
2. (PRINC "\Select Text(s) 选择文字 :")
   
3. (IF (SETQ SS (SSGET '((0 . "TEXT") (1 . "* *")))) (PROGN
   
4.   (SETQ I -1)
   
5.   (REPEAT (SSLENGTH SS)
   
6.    (SETQ ENT (ENTGET (SSNAME SS (SETQ I (1+ I))))
   
7.   AA (CDR (ASSOC 1 ENT))
   
8.   CC ""
   
9.   J 0)
   
10.    (REPEAT (STRLEN AA)
    
11.     (IF (/= (SETQ TMP (SUBSTR AA (SETQ J (1+ J)) 1)) " ")
    
12.      (SETQ CC (STRCAT CC TMP))
    
13.     )
    
14.    )
    
15.    (SETQ ENT (SUBST (CONS 1 CC) (ASSOC 1 ENT) ENT))
    
16.    (ENTMOD ENT)
    
17.   )
    
18. ))
    
19. (PRINC)
    
20. )
    

复制代码

这个是ZZXXQQ写的，删除空格后文字好像会移动，而且文字中间的空格也被删了，最好是原地保持文字，同时要提示用户是否删除文字中间的空格
哪位师傅看看有没有高招啊？？
谢谢！！！

psdcdr

删除空格前把文字修改成正中格式即可

Gu_xl

1. (DEFUN C:TT ()
   
2. (PRINC "\Select Text(s) 选择文字 :")
   
3. (IF (SETQ SS (SSGET '((0 . "TEXT") (1 . "* *")))) (PROGN
   
4.   (SETQ I -1)
   
5.   (initget "Yes No")
   
6.   (setq kd (getkword "\n[删全部空格Yes/删头尾空格No]<No>"))
   
7.   (if (null kd) (setq kd "No"))
   
8.   (REPEAT (SSLENGTH SS)
   
9.    (SETQ ENT (ENTGET (SSNAME SS (SETQ I (1+ I))))
   
10.   AA (CDR (ASSOC 1 ENT))
    
11.   CC ""
    
12.   J 0)
    
13.     (setq p1 (car (textbox ent)))
    
14.     (if (= "Yes" kd)
    
15.    (REPEAT (STRLEN AA)
    
16.     (IF (/= (SETQ TMP (SUBSTR AA (SETQ J (1+ J)) 1)) " ")
    
17.      (SETQ CC (STRCAT CC TMP))
    
18.     )
    
19.    )
    
20.       (setq CC (vl-string-trim " " AA))
    
21.       )
    
22.    (SETQ ENT (SUBST (CONS 1 CC) (ASSOC 1 ENT) ENT))
    
23.    (ENTMOD ENT)
    
24.     (setq p2 (car (textbox ent)))
    
25.     (command "move" (cdr (assoc -1 ent)) "" p2 p1)
    
26.   )
    
27. ))
    
28. (PRINC)
    
29. )
    

(DEFUN C:TT ()<br /> (PRINC "\Select Text(s) 选择文字 :")<br /> (IF (SETQ SS (SSGET '((0 . "TEXT") (1 . "* *")))) (PROGN<br />   (SETQ I -1)<br />   (initget "Yes No")<br />   (setq kd (getkword "\n[删全部空格Yes/删头尾空格No]<No>"))<br />   (if (null kd) (setq kd "No"))<br />   (REPEAT (SSLENGTH SS)<br />    (SETQ ENT (ENTGET (SSNAME SS (SETQ I (1+ I))))<br />   AA (CDR (ASSOC 1 ENT))<br />   CC ""<br />   J 0)<br />     (setq p1 (car (textbox ent)))<br />     (if (= "Yes" kd)<br />    (REPEAT (STRLEN AA)<br />     (IF (/= (SETQ TMP (SUBSTR AA (SETQ J (1+ J)) 1)) " ")<br />      (SETQ CC (STRCAT CC TMP))<br />     )<br />    )<br />       (setq CC (vl-string-trim " " AA))<br />       )<br />    (SETQ ENT (SUBST (CONS 1 CC) (ASSOC 1 ENT) ENT))<br />    (ENTMOD ENT)<br />     (setq p2 (car (textbox ent)))<br />     (command "move" (cdr (assoc -1 ent)) "" p2 p1)<br />   )<br /> ))<br /> (PRINC)<br /> )<br />

dcl1214

Gu_xl 发表于 2012-11-15 13:19

师傅：如果首端有空格的话，执行后文字会往前移动，不会原地保留
中间的空格删除不掉
师傅再看看
谢谢！！

dcl1214

我做了一个gif的动画，执行完毕后文字就跑了

dcl1214

dcl1214 发表于 2012-11-15 13:36
师傅：如果首端有空格的话，执行后文字会往前移动，不会原地保留
中间的空格删除不掉
师傅再看看

执行完毕后文字跑了

KO你

Gu_xl 发表于 2012-11-15 13:19

多行文本删不了

guankuiwu

太好了，学习了！