[字串处理系列二][编程申请]：求字符串断开程序。

21cn · 发表于 2002-7-31 21:10:06

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

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

×

看论坛上都讲探索者的字处理最好，我不搞结构，用理正多些，再加晓东工具箱，请版主费心在工具箱加强些字处理程序，比如字串打断、字串连接、排版等等。

eachy · 发表于 2002-7-31 23:58:43

我这有个以前的。和天正或理正的效果一样的。
其中：hzbrk－－－－将字串拆成单个字符
wdbrk－－－－在指定点处断开字串

(defun redraw_le ()
(foreach e le_drw (redraw e 4))
(foreach e le_del (entdel e))
(setq le_drw nil
le_del nil
)
)
(defun c:hzbrk (/ ss e le txt p1 a d2 pe n i cha d1 cha1 le1)
(xdrx_begin)
(xdrx_end)
(princ "\n请选取要拆成单字的汉字 <退出>: ")
(setq ss (ssget '((0 . "TEXT"))))
(if ss
(progn
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(setq le (entget e)
txt (xdrx_getentdxf 1) ;字串项
txt (xdrx_string_trimleft txt)
txt (xdrx_string_trimright txt) ;去首尾空格
p1 (mapcar '-
(xdrx_getentdxf 10)
(append (list (caar (textbox le)))
'(0 0) ;消y的偏移如 g 字符
)
)
a (xdrx_getentdxf 50) ;旋转角
d2 (- (caadr (textbox le)) (caar (textbox le))) ;x值
pe (polar p1 a d2) ;字符最右点坐标
)
(entdel e)
(setq i 1)
(while (not (equal txt ""))
(setq cha (substr txt i 1))
(if (> (ascii cha) 159)
(setq n 2)
(if (= (ascii cha) 37) ; 文字是: %
(progn
(setq cha1 (substr txt 2 1))
(if (= (ascii cha1) 37)
(progn
(setq cha2 (substr txt 3 1))
(if (or (= (ascii cha2) 112)
;; %%p
(= (ascii cha2) 100)
;; %%d
)
(setq n 3)
)
(setq n 5)
;;其它控制字符
)
)
)
(setq n 1)
)
)
(setq d1 (- (caadr (textbox (list (cons 1 txt))))
(caar (textbox (list (cons 1 txt))))
)
p1 (polar pe
(+ pi a)
d1
)
)
(setq cha (substr txt i n)
le1 (subst (cons 1 cha) (assoc 1 le) le)
le1 (subst (cons 10 p1) (assoc 10 le) le1)
)
(entmake le1)
(setq txt (xdrx_string_right txt (- (strlen txt) n)))
(if (/= txt "")
(setq txt (xdrx_string_trimleft txt)
txt (xdrx_string_trimright txt)
d1 (- (caadr (textbox (list (cons 1 txt))))
(caar (textbox (list (cons 1 txt))))
)
p1 (polar pe
(+ pi a)
d1
)
)
)
)
)
)
)
(xdrx_ucsoff)
(xdrx_end)
(princ)
)
(defun c:wdbrk (/ e0 e1 e10 le le0 le1 p1 px a a1
d d1 dx dm i i1 js txt0 txt2 txt txt1 cha tfhz tf
)
(if (and (setq e0 (xdrx_entsel "\n请点取要打断的文字 <退出>: "))
(setq e0 (car e0)
le0 (entget e0)
)
(= "TEXT" (cdr (assoc 0 le0)))
(progn (redraw e0 3)
(setq le_drw (cons e0 le_drw)
px (getpoint "\n再点一下要打断的位置 <退出>: ")
)
)
(> (setq e1 (assoc 1 le0)
txt (cdr e1)
e10 (assoc 10 le0)
p1 (cdr e10)
a (cdr (assoc 50 le0))
a1 (+ a (/ pi 2))
dx (xdrx_p2ldist px p1 (polar p1 a1 1e3))
)
0
)
)
(progn
(setq dm (caadr (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 (textbox le))
i (+ i
(if tfhz
2
1
)
)
tf (> dx d)
)
(if tf
(setq i1 i
d1 d
le1 le
)
)
)
(if (< (abs (- d dx)) (abs (- d1 dx)))
(setq i1 i
d1 d
le1 le
)
)
(if (and (not tf)
(<= 2 i1 (strlen txt))
)
(progn
(entmod le1)
(if (not js)
(setq js 0)
)
(setq le (subst (cons 1 (substr txt (- i1 js))) e1 le0)
d1 (caadr (textbox le))
px (polar p1 a (- dm d1))
le (subst (cons 10 px) e10 le)
)
(entmake le)
)
)
)
)
(redraw_le)
(princ)
)

(defun redraw_le () 
  (foreach e le_drw (redraw e 4)) 
  (foreach e le_del (entdel e)) 
  (setq        le_drw nil 
        le_del nil 
  ) 
) 
(defun c:hzbrk (/ ss e le txt p1 a d2 pe n i cha d1 cha1 le1) 
  (xdrx_begin) 
  (xdrx_end) 
  (princ "\n请选取要拆成单字的汉字 <退出>: ") 
  (setq ss (ssget '((0 . "TEXT")))) 
  (if ss 
    (progn 
      (xdrx_setsstodb ss 0) 
      (while (setq e (xdrx_getentdata 0)) 
        (setq le  (entget e) 
              txt (xdrx_getentdxf 1)        ;字串项 
              txt (xdrx_string_trimleft txt) 
              txt (xdrx_string_trimright txt) ;去首尾空格 
              p1  (mapcar '- 
                          (xdrx_getentdxf 10) 
                          (append (list (caar (textbox le))) 
                                  '(0 0) ;消y的偏移如 g 字符 
                          ) 
                  ) 
              a          (xdrx_getentdxf 50)        ;旋转角 
              d2  (- (caadr (textbox le)) (caar (textbox le))) ;x值 
              pe  (polar p1 a d2)        ;字符最右点坐标 
        ) 
        (entdel e) 
        (setq i 1) 
        (while (not (equal txt "")) 
          (setq cha (substr txt i 1)) 
          (if (> (ascii cha) 159) 
            (setq n 2) 
            (if        (= (ascii cha) 37)        ;  文字是: % 
              (progn 
                (setq cha1 (substr txt 2 1)) 
                (if (= (ascii cha1) 37) 
                  (progn 
                    (setq cha2 (substr txt 3 1)) 
                    (if        (or (= (ascii cha2) 112) 
                            ;; %%p 
                            (= (ascii cha2) 100) 
                            ;; %%d 
                        ) 
                      (setq n 3) 
                    ) 
                    (setq n 5) 
                    ;;其它控制字符 
                  ) 
                ) 
              ) 
              (setq n 1) 
            ) 
          ) 
          (setq        d1 (- (caadr (textbox (list (cons 1 txt)))) 
                      (caar (textbox (list (cons 1 txt)))) 
                   ) 
                p1 (polar pe 
                          (+ pi a) 
                          d1 
                   ) 
          ) 
          (setq        cha (substr txt i n) 
                le1 (subst (cons 1 cha) (assoc 1 le) le) 
                le1 (subst (cons 10 p1) (assoc 10 le) le1) 
          ) 
          (entmake le1) 
          (setq txt (xdrx_string_right txt (- (strlen txt) n))) 
          (if (/= txt "") 
            (setq txt (xdrx_string_trimleft txt) 
                  txt (xdrx_string_trimright txt) 
                  d1  (- (caadr (textbox (list (cons 1 txt)))) 
                         (caar (textbox (list (cons 1 txt)))) 
                      ) 
                  p1  (polar pe 
                             (+ pi a) 
                             d1 
                      ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (xdrx_ucsoff) 
  (xdrx_end) 
  (princ) 
) 
(defun c:wdbrk (/    e0          e1   e10  le         le0  le1  p1        px   a          a1 
                d    d1          dx   dm   i         i1  js txt0 txt2 txt  txt1        cha  tfhz tf 
               ) 
  (if (and (setq e0 (xdrx_entsel "\n请点取要打断的文字 <退出>: ")) 
           (setq e0  (car e0) 
                 le0 (entget e0) 
           ) 
           (= "TEXT" (cdr (assoc 0 le0))) 
           (progn (redraw e0 3) 
                  (setq        le_drw (cons e0 le_drw) 
                        px     (getpoint "\n再点一下要打断的位置 <退出>: ") 
                  ) 
           ) 
           (> (setq e1        (assoc 1 le0) 
                    txt        (cdr e1) 
                    e10        (assoc 10 le0) 
                    p1        (cdr e10) 
                    a        (cdr (assoc 50 le0)) 
                    a1        (+ a (/ pi 2)) 
                    dx        (xdrx_p2ldist px p1 (polar p1 a1 1e3)) 
              ) 
              0 
           ) 
      ) 
    (progn 
      (setq dm         (caadr (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 (textbox le)) 
              i           (+ i 
                      (if tfhz 
                        2 
                        1 
                      ) 
                   ) 
              tf   (> dx d) 
        ) 
        (if tf 
          (setq        i1  i 
                d1  d 
                le1 le 
          ) 
        ) 
      ) 
      (if (< (abs (- d dx)) (abs (- d1 dx))) 
        (setq i1  i 
              d1  d 
              le1 le 
        ) 
      ) 
      (if (and (not tf) 
               (<= 2 i1 (strlen txt)) 
          ) 
        (progn 
          (entmod le1) 
          (if (not js) 
            (setq js 0) 
          ) 
          (setq        le (subst (cons 1 (substr txt (- i1 js))) e1 le0) 
                d1 (caadr (textbox le)) 
                px (polar p1 a (- dm d1)) 
                le (subst (cons 10 px) e10 le) 
          ) 
          (entmake le) 
        ) 
      ) 
    ) 
  ) 
  (redraw_le) 
  (princ) 
)

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

[字串处理系列二][编程申请]：求字符串断开程序。

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

相关帖子