关于文本行距调整

尘缘一生 · 发表于 2023-6-13 22:28:07

本帖最后由尘缘一生于 2023-6-13 22:48 编辑

http://bbs.mjtd.com/forum.php?mo ... hlight=%BC%E4%BE%E0

http://bbs.mjtd.com/forum.php?mo ... hlight=%BC%E4%BE%E0

鉴于有人要这个功能，哪么本坛也有涉及，然而...
既然调整，要支持MTEXT，并且任意角度的文本都应该支持，为此，组织写下代码，

我自己写的代码也不喜欢写自己痕迹，涉及其他人的，没有注明，不接收辩驳
已集成《三领设计 V3.0》之内，关于这个问题，完善提高还是必要，空间还是很大...

链接：https://pan.baidu.com/s/1DgiiVQD-lHsjmJZUY6mvAA
提取码：fuq6

;文本间距调整
(defun c:m-text-ju (/ 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 pt1-1 n i)
(setq lst '())
(repeat (setq n (sslength ss))
(setq enam (ssname ss (setq n (1- n))))
(entmod (emod (emod enam 72 0) 73 0)) ;先处理为左定位
(setq lst (cons (list (dxf1 enam 10) enam) lst))
)
(setq enam (cadr (nth 0 lst)))
(setq pt0 (dxf1 enam 10))
(setq hi (dxf1 enam 40))
(setq ang (dxf1 enam 50))
(setq pt00 (polar pt0 (- ang pi2) 300))
(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 loop T)
(princ
(slmsg
"\n [行距+(1左键)/行距-(2)/左对齐(3)][右键/回车/空格.退出]"
"\n [︽禯+(1オ龄)/︽禯-(2)/オ癸霍(3)][龄/ó/.癶]"
"\n [Line spacing+(1 left click)/Line spacing - (2)/Left justified (3)] [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 pt1-1 (polar pt1 (- ang pi2) (* hi i 0.05)))
(vla-put-insertionpoint (en2obj (cadr (nth i lst))) (vlax-3d-point pt1-1))
(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 pt1-1 (polar pt1 (+ ang pi2) (* hi i 0.05)))
(vla-put-insertionpoint (en2obj (cadr (nth i lst))) (vlax-3d-point pt1-1))
(setq i (1+ i))
)
)
((equal bb '(2 51)) ;左对齐
(setq i 1)
(repeat (- (length lst) 1)
(setq pt1 (dxf1 (cadr (nth i lst)) 10))
(setq pt1-1 (pertolinecz pt1 pt0 pt00))
(vla-put-insertionpoint (en2obj (cadr (nth i lst))) (vlax-3d-point pt1-1))
(setq i (1+ i))
)
)
((or
(member (car bb) '(11 25)) ;右键
(member bb '((2 32))) ;空格键
(member bb '((2 13))) ;;回车
)
(setq loop nil)
)
)
)
(princ)
)

mokson · 发表于 2023-6-14 08:01:36

这个用途非常实用，感谢分享！

loveu515 · 发表于 2023-6-14 09:31:06

很有用途的，谢谢分享

sammy · 发表于 2023-6-14 10:23:38

缺少子函数

guosheyang · 发表于 2023-6-16 18:12:23

能否将多行文字的字高快速调整到一个特定值，比如现在字高50 调到60 ？

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

关于文本行距调整

本帖子中包含更多资源

评分