本帖最后由 叮咚 于 2021-3-5 15:38 编辑
D:\下载\1.gif
GIFhttps://share.weiyun.com/8UtuMrIF
VLX文件
https://share.weiyun.com/T19PTR20
试试这个
(DEFUN C:MKG ()
(VL-LOAD-COM)
(PRINC "\Select Text(s) 选择文字 :")
(IF (SETQ SS (ssget '((-4 . "<and")(0 . "MTEXT")(1 . "*\\P\\P*")(-4 . "and>"))))
(PROGN
(SETQ I -1)
(REPEAT (SSLENGTH SS)
(SETQ ENT (ENTGET (SSNAME SS (SETQ I (1+ I))))
AA(CDR (ASSOC 1 ENT))
)
(WHILE (vl-string-search "\\P\\P" AA) ;; 搜索指定字符串位置,0开始,即空行还在
(SETQ AA (vl-string-subst "\\P" "\\P\\P" AA)) ;; 则用"\\P"替换"\\P\\P"
(SETQ ENT (SUBST (CONS 1 AA) (ASSOC 1 ENT) ENT))
(ENTMOD ENT)
)
)
)
)
(PRINC)
)
cshimao 发表于 2021-3-5 16:53
试试这个
(DEFUN C:MKG ()
(VL-LOAD-COM)
附件放在1楼了,没有换行符的,麻烦下载看看能不能解决。感激
本帖最后由 vitalgg 于 2021-3-6 10:48 编辑
自己试一下吧,因为 2016 会直接把最后那个空行删除了。(至少我这里是这样的)
(defun string:from-lst(lst Separator)"列表转成字符串"
(if (cdr lst)
(strcat (car lst) Separator (string:from-lst (cdr lst) Separator))
(car lst)))
(defun string:to-lst (str Separator / pos)
"字符串转成列表"
(if (setq pos (vl-string-search Separator str))
(cons (substr str 1 pos)
(string:to-lst (substr str (+ pos 1 (strlen Separator))) Separator))
(list str)))
(defun remove-mtext-lastspace (en0);;"去多行文本最后一行的空格(只有一个空格,多了还得改,还有最后的空格不能有自己样式。就是一个纯空格)"
(setq strlst (string:to-lst (cdr (assoc 1 (entget en0))) "\\n"))
(if (or (= " " (last strlst))
(= "" (last strlst)))
(progn
(entmod
(subst
(cons 1 (string:from-lst (reverse (cdr (reverse strlst))) "\\n"))
(assoc 1 (entget en0)) (entget en0)))
(entupd en0)
)
))
(defun c:tt (/ i% ss-mtext)
(setq ss-mtext (ssget '((0 . "MTEXT"))))
(setq i% 0)
(while (< i% (sslength ss-mtext))
(remove-mtext-lastspace (ssname ss-mtext i%))
(setq i% (1+ i%))))
vitalgg 发表于 2021-3-6 10:45
自己试一下吧,因为 2016 会直接把最后那个空行删除了。(至少我这里是这样的)
不行呀
本帖最后由 cshimao 于 2021-3-9 08:33 编辑
把\\p换成\n就可以了,在CAD06上试试
(DEFUN C:MKG ()
(VL-LOAD-COM)
(PRINC "\Select Text(s) 选择文字 :")
(IF (SETQ SS (ssget '((-4 . "<and")(0 . "MTEXT")(1 . "*\n\n*")(-4 . "and>"))))
(PROGN
(SETQ I -1)
(REPEAT (SSLENGTH SS)
(SETQ ENT (ENTGET (SSNAME SS (SETQ I (1+ I))))
AA(CDR (ASSOC 1 ENT))
)
(WHILE (vl-string-search "\n\n" AA) ;; 搜索指定字符串位置,0开始,即空行
还在
(SETQ AA (vl-string-subst "\n" "\n\n" AA)) ;; 则用"\n"替换"\n\n"
(SETQ ENT (SUBST (CONS 1 AA) (ASSOC 1 ENT) ENT))
(ENTMOD ENT)
)
)
)
)
(PRINC)
)
cshimao 发表于 2021-3-9 08:14
把\\p换成\n就可以了,在CAD06上试试
(DEFUN C:MKG ()
(VL-LOAD-COM)
不能选中,怎么回事?
本帖最后由 cshimao 于 2021-3-9 14:33 编辑
把多行文字的最后换行符删除即可,即"12546\ncfgr\n12489\ndsyso\n"->"12546\ncfgr\n12489\ndsyso"
(DEFUN C:MKH ()
(defun I:StrRightTrim
(TrimStr ; string to trim out
FullStr ; string to trim from
/ ; local variables
lenStr ; length of full string
lenTrim ; length of trim string
) ;_ closes variable declare
(if
(and ; if still enough string to search
(> (setq lenStr (strlen FullStr))
(setq lenTrim (strlen TrimStr))
) ;_ closes >
(not ; and not too far
(wcmatch FullStr (strcat "*" TrimStr))
) ;_ closes not
) ;_ closes and
(I:StrRightTrim ; then go futher
TrimStr
(substr FullStr 1 (1- (strlen FullStr)))
) ;_ closes I:StrRightTrim
(if (> lenStr lenTrim) ; else if found
(substr FullStr 1 (- lenStr lenTrim)) ; return trimmed str
nil ; else return nil
) ;_ closes if
) ;_ closes if
) ;_ closes
(VL-LOAD-COM)
(PRINC "\Select Text(s) 选择文字 :")
(IF (SETQ
SS (ssget
'((-4 . "<and") (0 . "MTEXT") (1 . "*\n") (-4 . "and>"))
)
)
(PROGN
(SETQ I -1)
(REPEAT (SSLENGTH SS)
(SETQ ENT (ENTGET (SSNAME SS (SETQ I (1+ I))))
AA(CDR (ASSOC 1 ENT))
)
(setq AA (I:STRRIGHTTRIM "\n" AA))
(SETQ ENT (SUBST (CONS 1 AA) (ASSOC 1 ENT) ENT))
(ENTMOD ENT)
;)
)
)
)
(PRINC)
)
(DEFUN C:MKG ()
(VL-LOAD-COM)
(PRINC "\Select Text(s) 选择文字 :")
(IF (SETQ SS (ssget '((-4 . "<and")(0 . "MTEXT")(1 . "*\n")(-4 . "and>"))))
(PROGN
(SETQ I -1)
(REPEAT (SSLENGTH SS)
(SETQ ENT (ENTGET (SSNAME SS (SETQ I (1+ I))))
AA(CDR (ASSOC 1 ENT))
)
(SETQ AA (vl-string-right-trim "\n" AA))
(SETQ ENT (SUBST (CONS 1 AA) (ASSOC 1 ENT) ENT))
(ENTMOD ENT)
)
)
)
(PRINC)
)
845245015 发表于 2021-3-9 11:27
(DEFUN C:MKG ()
(VL-LOAD-COM)
(PRINC "\Select Text(s) 选择文字 :")
用自带函数vl-string-right-trim,简洁。