[分享]lee-mac的文字按字符打断
本帖最后由 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)
tot0.0
lstnil
)
(foreach item (_splitwords (cdr (assoc 1 enx)))
(if (= "" (cdr item))
(setq lst (cons '(nil . 0.0) lst))
(setqdxf (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
(setqwid (_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
)
谢谢共享！ nice 追寻 发表于 2021-9-13 14:12
nice
中文不支持,可能需要正则匹配,但我不会改,有哪位前辈愿意改改,在此感谢! 楼主你好，这个功能搞定了吗 664571221 发表于 2024-4-27 17:11
楼主你好，这个功能搞定了吗
没有搞定中文呢 用正则表达式修改成功。收2币。勿喷！
页:
[1]