关于文本行距调整
本帖最后由 尘缘一生 于 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 "
[*] )
[*])
[*](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)
[*])
这个用途非常实用，感谢分享！ 很有用途的，谢谢分享 缺少子函数 能否将多行文字的字高快速调整到一个特定值，比如现在字高50调到60 ？
页:
[1]