[分享]lee-mac的文字按字符打断

tigcat · 发表于 2021-8-15 00:15:20

本帖最后由 tigcat 于 2021-8-15 00:18 编辑

这个程序可以实现文字按字符打断,但不适合中文字符,比如有个ABC,输入B后,变成了2行字符A和C,A和C的位置不变化.

;;--------------------=={ Text to Words }==-------------------;;
;; ;;
;; Prompts the user for a selection of Text objects and ;;
;; converts each object in the selection into separate Text ;;
;; objects for each word, retaining all properties of the ;;
;; original objects. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright ?2013 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
(defun c:t2w (/ _splitwords _textwidth ang dxf
ent enx fun inc lst pnt sel
spc tot wid
)
(defun _splitwords (str / pos)
(if (setq pos (vl-string-position chrx str))
;|获取要分割的字符串|;
(cons (cons 1 (substr str 1 pos))
;|组成字首到切割符号前的字符串点对|;
(_splitwords (substr str (+ pos 2)))
;|组成切割字符串后面字符|;
)
(list (cons 1 str))
)
)
(defun _textwidth (enx)
((lambda (lst) (- (caadr lst) (caar lst))) (textbox enx))
)
(setq chrx (ascii (LM:editbox "-")))
;| (setq chrx (ascii "你"))|;
(if (setq sel (ssget
'((0 . "TEXT")
(-4 . "<NOT")
(-4 . "<OR")
(72 . 3)
(72 . 4)
(72 . 5)
(-4 . "OR>")
(-4 . "NOT>")
)
)
)
(repeat (setq inc (sslength sel))
(setq ent (ssname sel (setq inc (1- inc)))
enx (entget ent)
tot 0.0
lst nil
)
(foreach item (_splitwords (cdr (assoc 1 enx)))
(if (= "" (cdr item))
(setq lst (cons '(nil . 0.0) lst))
(setq dxf (entget (entmakex (subst item (assoc 1 enx) enx)))
;|获取新生成字符串的数据表,entmakex函数最后会返回一个图元名,所以用entget获取数据表|;
wid (_textwidth dxf)
tot (+ tot wid)
lst (cons (cons dxf wid) lst)
)
)
)
(if (< 1 (length lst))
(progn
(setq wid (_textwidth enx)
spc (/ (- wid tot) (float (1- (length lst))))
lst (reverse lst)
ang (cdr (assoc 50 enx))
)
(if
(and
(= 0 (cdr (assoc 72 enx)))
(= 0 (cdr (assoc 73 enx)))
)
(setq pnt (cdr (assoc 10 enx)))
(setq pnt (cdr (assoc 11 enx)))
)
(cond
((= (cdr (assoc 72 enx)) 0)
(setq fun (lambda (a b) (+ spc (cdr a))))
)
((= (cdr (assoc 72 enx)) 1)
(setq fun (lambda (a b) (+ spc (/ (+ (cdr a) (cdr b)) 2.0)))
pnt (polar pnt (+ ang pi) (/ (- wid (cdar lst)) 2.0))
)
)
((= (cdr (assoc 72 enx)) 2)
(setq fun (lambda (a b) (+ spc (cdr b)))
pnt (polar pnt (+ ang pi) (- wid (cdar lst)))
)
)
)
(mapcar
(function
(lambda (a b / dxf)
(if (setq dxf (car a))
(entmod
(subst (cons 10 pnt)
(assoc 10 dxf)
(subst (cons 11 pnt) (assoc 11 dxf) dxf)
)
)
)
(setq pnt (polar pnt ang (fun a b)))
)
)
lst
(append (cdr lst) '((nil . 0.0)))
)
(entdel ent)
)
)
)
)
(princ)
)
(princ)
(defun LM:editbox ( str1 / han )
(and (< 0 (setq han (load_dialog "acad")))
(new_dialog "acad_txtedit" han)
(set_tile "text_edit" str1)
(action_tile "text_edit" "(setq str1 $value)")
(if (zerop (start_dialog)) (setq str1 nil))
)
(if (< 0 han) (unload_dialog han))
str1
)

;;--------------------=={ Text to Words }==-------------------;; 
;;                                                            ;; 
;;  Prompts the user for a selection of Text objects and      ;; 
;;  converts each object in the selection into separate Text  ;; 
;;  objects for each word, retaining all properties of the    ;; 
;;  original objects.                                         ;; 
;;------------------------------------------------------------;; 
;;  Author: Lee Mac, Copyright ?2013 - <a href="http://www.lee-mac.com" target="_blank">www.lee-mac.com</a>       ;; 
;;------------------------------------------------------------;; 
 
(defun c:t2w (/        _splitwords     _textwidth      ang     dxf 
        ent     enx     fun     inc     lst     pnt     sel 
        spc     tot     wid 
       ) 
 
  (defun _splitwords (str / pos) 
    (if  (setq pos (vl-string-position chrx str)) 
  ;|获取要分割的字符串|; 
      (cons (cons 1 (substr str 1 pos)) 
      ;|组成字首到切割符号前的字符串点对|; 
      (_splitwords (substr str (+ pos 2))) 
      ;|组成切割字符串后面字符|; 
      ) 
      (list (cons 1 str)) 
    ) 
  ) 
 
  (defun _textwidth (enx) 
    ((lambda (lst) (- (caadr lst) (caar lst))) (textbox enx)) 
  ) 
 
  (setq chrx (ascii (LM:editbox "-"))) 
;| (setq chrx (ascii "你"))|; 
  (if (setq sel  (ssget 
           '((0 . "TEXT") 
       (-4 . "<NOT") 
       (-4 . "<OR") 
       (72 . 3) 
       (72 . 4) 
       (72 . 5) 
       (-4 . "OR>") 
       (-4 . "NOT>") 
      ) 
    ) 
      ) 
    (repeat (setq inc (sslength sel)) 
      (setq ent  (ssname sel (setq inc (1- inc))) 
      enx  (entget ent) 
      tot  0.0 
      lst  nil 
      ) 
      (foreach item (_splitwords (cdr (assoc 1 enx))) 
  (if (= "" (cdr item)) 
    (setq lst (cons '(nil . 0.0) lst)) 
    (setq  dxf (entget (entmakex (subst item (assoc 1 enx) enx))) 
        ;|获取新生成字符串的数据表,entmakex函数最后会返回一个图元名,所以用entget获取数据表|; 
    wid (_textwidth dxf) 
    tot (+ tot wid) 
    lst (cons (cons dxf wid) lst) 
    ) 
  ) 
      ) 
      (if (< 1 (length lst)) 
  (progn 
    (setq  wid (_textwidth enx) 
    spc (/ (- wid tot) (float (1- (length lst)))) 
    lst (reverse lst) 
    ang (cdr (assoc 50 enx)) 
    ) 
    (if 
      (and 
        (= 0 (cdr (assoc 72 enx))) 
        (= 0 (cdr (assoc 73 enx))) 
      ) 
       (setq pnt (cdr (assoc 10 enx))) 
       (setq pnt (cdr (assoc 11 enx))) 
    ) 
    (cond 
      ((= (cdr (assoc 72 enx)) 0) 
       (setq fun (lambda (a b) (+ spc (cdr a)))) 
      ) 
      ((= (cdr (assoc 72 enx)) 1) 
       (setq fun (lambda (a b) (+ spc (/ (+ (cdr a) (cdr b)) 2.0))) 
       pnt (polar pnt (+ ang pi) (/ (- wid (cdar lst)) 2.0)) 
       ) 
      ) 
      ((= (cdr (assoc 72 enx)) 2) 
       (setq fun (lambda (a b) (+ spc (cdr b))) 
       pnt (polar pnt (+ ang pi) (- wid (cdar lst))) 
       ) 
      ) 
    ) 
    (mapcar 
      (function 
        (lambda (a b / dxf) 
    (if (setq dxf (car a)) 
      (entmod 
        (subst (cons 10 pnt) 
         (assoc 10 dxf) 
         (subst (cons 11 pnt) (assoc 11 dxf) dxf) 
        ) 
      ) 
    ) 
    (setq pnt (polar pnt ang (fun a b))) 
        ) 
      ) 
      lst 
      (append (cdr lst) '((nil . 0.0))) 
    ) 
    (entdel ent) 
  ) 
      ) 
    ) 
  ) 
  (princ) 
) 
(princ) 
(defun LM:editbox ( str1 / han ) 
  (and (< 0 (setq han (load_dialog "acad"))) 
    (new_dialog  "acad_txtedit" han) 
    (set_tile    "text_edit"    str1) 
    (action_tile "text_edit" "(setq str1 $value)") 
    (if (zerop (start_dialog)) (setq str1 nil)) 
  ) 
  (if (< 0 han) (unload_dialog han)) 
  str1 
)

guosheyang · 发表于 2021-8-15 11:05:02

谢谢共享！

追寻 · 发表于 2021-9-13 14:12:05

nice

tigcat · 发表于 2021-9-13 21:19:12

追寻发表于 2021-9-13 14:12
nice

中文不支持,可能需要正则匹配,但我不会改,有哪位前辈愿意改改,在此感谢!

664571221 · 发表于 2024-4-27 17:11:00

楼主你好，这个功能搞定了吗

tigcat · 发表于 2024-4-27 18:22:35

664571221 发表于 2024-4-27 17:11
楼主你好，这个功能搞定了吗

没有搞定中文呢

xiang19751218 · 发表于 2024-4-27 19:43:37

用正则表达式修改成功。收2币。勿喷！

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

[源码] [分享]lee-mac的文字按字符打断

本帖子中包含更多资源

点评

评分