重写 文本行距调整
本帖最后由 尘缘一生 于 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 "
[*] )
[*])
[*](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)
[*])
来坐沙发的...;P 谢谢楼主分享 缺少函数吗？
页:
[1]