重写文本行距调整

尘缘一生 · 发表于 2023-6-28 20:25

本帖最后由尘缘一生于 2023-6-28 20:30 编辑

起先发过一贴，发现使用中些问题，重写贴上，
一：增加首选调整间距相同后，再调整
二：增加中对齐，右对齐
http://bbs.mjtd.com/thread-188017-1-1.html
链接：https://pan.baidu.com/s/1DgiiVQD-lHsjmJZUY6mvAA
提取码：fuq6

;文本间距调整c:m-text-ju
(defun c:tt (/ ss ss1 n e nam tp)
(princ (slmsg "\n 请选取调整文字行距:" "\n 叫匡秸俱ゅ︽禯:" "\n Please select to adjust the text line spacing:"))
(setq ss (ssget '((0 . "TEXT,TCH_TEXT,MTEXT,TCH_MTEXT"))) ss1 (ssadd))
(repeat (setq n (sslength ss))
(setq nam (ssname ss (setq n (1- n))) tp (dxf1 nam 0))
(cond
((member tp '("MTEXT" "TCH_MTEXT"))
(setq e (entlast))
(expmtext nam)
(setq ss1 (sl:pickset-join (last_ent e) ss1))
)
(t
(ssadd nam ss1)
)
)
)
(ss-txt-ju ss1)
)
;TEXT文字间距调整-----(一级)-------
;ss TEXT选择集
(defun ss-txt-ju (ss / lst loop enam ang pt0 pt00 hi pt1 p0 p00 i ptlis p1 p11 p2 p22)
(setq lst '())
(repeat (setq i (sslength ss))
(setq enam (ssname ss (setq i (1- i))))
(entmod (emod (emod enam 72 0) 73 0)) ;先处理为左定位
(setq lst (cons (list (dxf1 enam 10) enam) lst))
)
(setq enam (cadr (nth 0 lst)) ptlis (ss9pt ss nil))
(setq pt0 (dxf1 enam 10))
(setq hi (dxf1 enam 40))
(setq ang (dxf1 enam 50))
(setq lst
(vl-sort
lst
'(lambda (p1 p2)
(if (or (equal ang pi2 0.01) (equal ang 3pi2 0.01))
(cond
((< (caar p1) (caar p2)) T)
((and (= (caar p1) (caar p2)) (< (cadar p1) (cadar p2))) T)
)
(cond
((> (cadar p1) (cadar p2)) T)
((and (= (cadar p1) (cadar p2)) (< (caar p1) (caar p2))) T)
)
)
)
)
)
(setq pt00 (polar pt0 (- ang pi2) 300))
(setq p1 (nth 8 ptlis)) ;右对齐
(setq p11 (polar p1 (- ang pi2) 300))
(setq p2 (cadr ptlis)) ;中对齐
(setq p22 (polar p2 (- ang pi2) 300))
(setq i 0 p00 (dxf1 (cadar lst) 10))
(repeat (length lst);间距先调统一定值
(setq enam (cadr (nth i lst)) pt1 (dxf1 enam 10))
(setq p0 (polar p00 (- ang pi2) (* hi i 2.0)))
(vla-move (en2obj enam) (vlax-3d-point pt1) (vlax-3d-point (pertolinecz pt1 p0 (polar p0 ang 300))))
(setq i (1+ i))
)
(setq loop T)
(princ
(slmsg
"\n [行距+(1-or-左键)/行距-(2)/左对齐(Z)/右对齐(Y)/中对齐(M)][右键/回车/空格.退出]"
"\n [︽禯+(1-or-オ龄)/︽禯-(2)/オ癸霍(Z)/癸霍(Y)/い癸霍(M)][龄/ó/.癶]"
"\n [Line Dis+(1-or-left click)/Line Dis-(2)/Left alignment(Z)/Right alignment(Y)/Mid alignment(M)] [Right click/Enter/Space. Exit]"
)
)
(while loop
(setq bb (grread T 8))
(cond
((or (= (car bb) 3) (equal bb '(2 49))) ;1键左键
(setq i 1)
(repeat (- (length lst) 1)
(setq pt1 (dxf1 (cadr (nth i lst)) 10))
(setq p0 (polar pt1 (- ang pi2) (* hi i 0.05)))
(entmod (emod (cadr (nth i lst)) 10 p0))
(setq i (1+ i))
)
)
((equal bb '(2 50)) ;2
(setq i 1)
(repeat (- (length lst) 1)
(setq pt1 (dxf1 (cadr (nth i lst)) 10))
(setq p0 (polar pt1 (+ ang pi2) (* hi i 0.05)))
(entmod (emod (cadr (nth i lst)) 10 p0))
(setq i (1+ i))
)
)
((member bb '((2 90) (2 122))) ;;左对齐 Z z
(setq i 0)
(repeat (length lst)
(setq pt1 (dxf1 (cadr (nth i lst)) 10))
(setq p0 (pertolinecz pt1 pt0 pt00))
(entmod (emod (cadr (nth i lst)) 10 p0))
(setq i (1+ i))
)
)
((member bb '((2 89) (2 121))) ;;右对齐 Y y
(setq i 0)
(repeat (length lst)
(setq pt1 (cadr (e-box4 (setq enam (cadr (nth i lst))) t)))
(setq p0 (pertolinecz pt1 p1 p11))
(vla-move (en2obj enam) (vlax-3d-point pt1) (vlax-3d-point p0))
(setq i (1+ i))
)
)
((member bb '((2 77) (2 109))) ;;中对齐 M m
(setq i 0)
(repeat (length lst)
(setq enam (cadr (nth i lst)) ptlis (e-box4 enam t))
(setq pt1 (sl:mid (car ptlis) (cadr ptlis)))
(setq p0 (pertolinecz pt1 p2 p22))
(vla-move (en2obj enam) (vlax-3d-point pt1) (vlax-3d-point p0))
(setq i (1+ i))
)
)
((or
(member (car bb) '(11 25)) ;右键
(member bb '((2 32))) ;空格键
(member bb '((2 13))) ;;回车
)
(setq loop nil)
)
)
)
(princ)
)

下文没句号。 · 发表于 2023-6-28 22:20

来坐沙发的...

hzyhzjjzh · 发表于 2023-6-29 12:49

谢谢楼主分享

fupingtang · 发表于 2023-6-30 11:35

缺少函数吗？

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

重写 文本行距调整

评分

重写文本行距调整