将含空格的文字分解为单个文字而保持文字位置不变

xshrimp · 发表于 2013-5-31 14:01:30

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

原来下载的eachy的将含空格的文字分解为单个文字而保持文字位置不变
讨论一下,如何实现的?
附件:为eachy的程序

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:将含空格的文字按空格分解为单个文字而保持文字位置不变t.rar
下载次数:105 文件大小:2.17 KB
下载权限: 不限以上 [免费赚D豆]

wowan1314 · 发表于 2013-5-31 14:28:47

真不错！看不出哪里不对！位置相当精确

QiaoCheng · 发表于 2013-5-31 14:29:39

摘人家的行不?好像狂刀的

;;;示例 (txtTolst (ssname (ssget ":s" '((0 . "TEXT"))) 0))
;;;例子 "cad总平面－规划图" -> ("c" "a" "d" "总" "平" "面" "－" "规" "划" "图")
(defun txtTolst (e / txt st stl)
(setq txt (cdr (assoc 1 (entget e))) stl T)
(mapcar 'vl-list->string
(vl-remove-if 'null
(mapcar
'(lambda (x)
(cond
((< x 160) (list x)) ;; 一般汉字编码 > 160. 英文符号<128.!!!
(T (if stl (setq st x stl nil) (setq stl (list st x))));;写法:确保返回值并设开关.
)
)
(vl-string->list txt)
)
)
)
)

wowan1314 · 发表于 2013-5-31 14:36:36

本帖最后由 wowan1314 于 2013-5-31 14:41 编辑

晕！换了几个字体，写了好多乱七八糟的符号，位置都相当精确。 {:soso_e154:}

zyhandw · 发表于 2013-5-31 14:52:52

就是根据字高、宽度比例吧？

Lispboy · 发表于 2013-5-31 15:12:06

晓东工具箱的XDLSP.LSP通用函数库中，提供了一个函数$XDLSP_TXTBRK 就是做这个的，找到文字的打断点，我贴上来，里面有些XDRX的函数，但不影响看思路。

(defun $xdlsp_txtbrk (e pt / e0 e1 p10 le le0 le1 p1 px a a1 d d1 dx dm i i1
txt txt1 cha tfhz tf pos
)
(xdrx_setenttodb e)
(if (= "TEXT" (xdrx_getentdxf 0))
(progn
(setq _pi2 (/ pi 2)
le0 (entget e)
e1 (assoc 1 le0)
txt (cdr e1)
p10 (assoc 10 le0)
p1 (cdr p10)
a (cdr (assoc 50 le0))
a1 (+ a _pi2)
px (trans pt 1 0)
dx (xdrx_p2ldist px p1 (polar p1 a1 1e3))
)
(setq dm (caadr ($xdlsp_textbox le0))
i 1
i1 1
d1 0
txt1 ""
tf T
)
(while (and
tf
(/= "" (setq cha (substr txt i 1)))
)
(if (setq tfhz (> (ascii cha) 159))
(setq cha (substr txt i 2))
)
(setq txt1 (strcat txt1 cha)
le (subst
(cons 1 txt1)
e1
le0
)
d (caadr ($xdlsp_textbox le))
i (+ i (if tfhz
2
1
)
)
tf (> dx d)
)
(if tf
(setq i1 i
d1 d
le1 le
len (strlen (cdr (assoc 1 le)))
)
)
)
(if (< (abs (- d dx)) (abs (- d1 dx)))
(setq i1 i
d1 d
le1 le
)
)
(if (and
(not tf)
(<= 2 i1 (strlen txt))
)
(progn
(setq pos (strlen (xdrx_string_trimRight (cdr (assoc 1 le1))))
le (subst
(cons 1 (substr txt i1))
e1
le0
)
d1 (caadr ($xdlsp_textbox le))
px (polar p1 a (- dm d1))
le (subst
(cons 10 px)
p10
le
)
)
(list pos px)
)
)
)
)
)

(defun $xdlsp_txtbrk (e pt / e0 e1 p10 le le0 le1 p1 px a a1 d d1 dx dm i i1 
                        txt txt1 cha tfhz tf pos 
                     ) 
  (xdrx_setenttodb e) 
  (if (= "TEXT" (xdrx_getentdxf 0)) 
    (progn 
      (setq _pi2 (/ pi 2) 
            le0 (entget e) 
            e1 (assoc 1 le0) 
            txt (cdr e1) 
            p10 (assoc 10 le0) 
            p1 (cdr p10) 
            a (cdr (assoc 50 le0)) 
            a1 (+ a _pi2) 
            px (trans pt 1 0) 
            dx (xdrx_p2ldist px p1 (polar p1 a1 1e3)) 
      ) 
      (setq dm (caadr ($xdlsp_textbox le0)) 
            i 1 
            i1 1 
            d1 0 
            txt1 "" 
            tf T 
      ) 
      (while (and 
               tf 
               (/= "" (setq cha (substr txt i 1))) 
             ) 
        (if (setq tfhz (> (ascii cha) 159)) 
          (setq cha (substr txt i 2)) 
        ) 
        (setq txt1 (strcat txt1 cha) 
              le (subst 
                   (cons 1 txt1) 
                   e1 
                   le0 
                 ) 
              d (caadr ($xdlsp_textbox le)) 
              i (+ i (if tfhz 
                       2 
                       1 
                     ) 
                ) 
              tf (> dx d) 
        ) 
        (if tf 
          (setq i1 i 
                d1 d 
                le1 le 
                len (strlen (cdr (assoc 1 le))) 
          ) 
        ) 
      ) 
      (if (< (abs (- d dx)) (abs (- d1 dx))) 
        (setq i1 i 
              d1 d 
              le1 le 
        ) 
      ) 
      (if (and 
            (not tf) 
            (<= 2 i1 (strlen txt)) 
          ) 
        (progn 
          (setq pos (strlen (xdrx_string_trimRight (cdr (assoc 1 le1)))) 
                le (subst 
                     (cons 1 (substr txt i1)) 
                     e1 
                     le0 
                   ) 
                d1 (caadr ($xdlsp_textbox le)) 
                px (polar p1 a (- dm d1)) 
                le (subst 
                     (cons 10 px) 
                     p10 
                     le 
                   ) 
          ) 
          (list pos px) 
        ) 
      ) 
    ) 
  ) 
)

(setq pt ($xdlsp_txtbrk e p1))
;;(4 (608903.0 4.61917e+006 -282.0)) 断开点P1前面的字符是4，断开点后面的文字的起始点位置是P2=(608903.0 4.61917e+006 -282.0)

ll_j · 发表于 2013-5-31 15:12:11

;;;文字去空格程序
(defun c:ttrim(/ ss i l0 en ne eg ng e0 e1 j)
(if (not acet-tjust) (load "acetutil3.fas"))
(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)
)

;;;文字去空格程序 
(defun c:ttrim(/ ss i l0 en ne eg ng e0 e1 j) 
  (if (not acet-tjust) (load "acetutil3.fas")) 
  (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) 
)

eachy · 发表于 2013-6-1 11:20:10

都不记得写过了，看看还能不能找到源码

taner · 发表于 2013-6-1 11:44:40

(DEFUN STR2CELST (STR / I LST N STRI)
(SETQ I 1
N (STRLEN STR)
)
(WHILE (<= I N)
(SETQ STRI (SUBSTR STR I 1))
(IF (> (ASCII STRI) 159);不知道到底应该是159还是160
(SETQ STRI (SUBSTR STR I 2)
I (+ I 2)
LST (CONS STRI LST)
)
(SETQ I (1+ I)
LST (CONS STRI LST)
)
)
(REVERSE LST)
)
)
;(str2celst "BatchPlot 或 BPlot 启动主程序。")
;("B" "a" "t" "c" "h" "P" "l" "o" "t" " " "或" " " "B" "P" "l" "o" "t" " " "启" "动" "主" "程" "序" "。")

crtrccrt · 发表于 2013-6-1 15:33:14

一个字
很好

仲文玉 · 发表于 2013-6-1 16:07:19

xyp 的函数也不错

;;;******************************************************** xyp-Str1List 将一行字符串拆分转为单独字符表 [e派]
;;;语法：(xyp-Str1List str);str 任意字符串
;;; (xyp-Str1List "工具箱函数再揭秘") → ("工" "具" "箱" "函" "数" "再" "揭" "秘" )
(defun xyp-Str1List (STR / i lst tx)
(setq i 1 lst '())
(while (<= i (strLen STR))
(setq tx (substr STR i 1))
(if (> (ASCII tx) 160)
(setq tx (substr STR i 2)
i (+ i 2)
lst (cons tx lst)
)
(setq i (1+ i)
lst (cons tx lst)
)
)
)
(reverse lst)
)

pzweng · 发表于 2013-6-5 08:47:36

(setq str (cdr (assoc 1 (entget (car (entsel))))))
(setq str (vl-string->list str))
(while str
  (setq a (car str) str (cdr str))
  (if (> a 160)
(setq a (list a (car str)) str (cdr str))
(setq a (list a)))
  (setq new_str (cons a new_str))
  )
(setq new_str )
(mapcar 'vl-list->string  (reverse new_str))

菜鸟献丑

账号		自动登录	找回密码
密码			立即注册

[研讨] 将含空格的文字分解为单个文字而保持文字位置不变

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

评分

点评

评分

评分

评分