dcl1214 发表于 2012-11-15 11:22:24

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

(DEFUN C:TT ()
(PRINC "\Select Text(s) 选择文字 :")
(IF (SETQ SS (SSGET '((0 . "TEXT") (1 . "* *")))) (PROGN
(SETQ I -1)
(REPEAT (SSLENGTH SS)
   (SETQ ENT (ENTGET (SSNAME SS (SETQ I (1+ I))))
AA (CDR (ASSOC 1 ENT))
CC ""
J 0)
   (REPEAT (STRLEN AA)
    (IF (/= (SETQ TMP (SUBSTR AA (SETQ J (1+ J)) 1)) " ")
   (SETQ CC (STRCAT CC TMP))
    )
   )
   (SETQ ENT (SUBST (CONS 1 CC) (ASSOC 1 ENT) ENT))
   (ENTMOD ENT)
)
))
(PRINC)
)

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

psdcdr 发表于 2012-11-15 12:49:39

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

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


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

dcl1214 发表于 2012-11-15 13:36:55

Gu_xl 发表于 2012-11-15 13:19 static/image/common/back.gif


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

dcl1214 发表于 2012-11-15 15:07:04

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

dcl1214 发表于 2012-11-15 15:08:53

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


执行完毕后文字跑了

KO你 发表于 2019-6-22 02:06:18

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


多行文本删不了

guankuiwu 发表于 2022-8-25 11:11:38

太好了，学习了！
页: [1]
查看完整版本: 删除文字的首尾空格后原地保持文字位置