希望帮改个文字拉伸代码
之前论坛有个单行文字拉伸程序挺好的，但是拉伸时会改变字高，哪位兄弟能帮我改成字高不变的情况下拉伸，谢谢!http://bbs.mjtd.com/thread-175713-1-1.html
;;; -----------------------------------
;;; 单行文本动态拉伸 by：langjs
;;; -----------------------------------
;;只改一句即可
(defun C:qq (/ box data ent gr h hb hh loop p ss w wb)
(defun emod (h w ent)
(entmod (subst (cons h w) (assoc h ent) ent))
)
(if (setq ss (ssget ":E:S" '((0 . "TEXT"))))
(progn
(setq ent (entget (ssname ss 0))
p (cdr (assoc 10 ent))
h (cdr (assoc 40 ent))
w (cdr (assoc 41 ent))
box (textbox (cdr ent))
hb (/ h (cadr (cadr box)))
wb (/ (car (cadr box)) (* h w))
loop t
)
(princ "\n指定拉伸点:")
(while loop
(setq gr (grread t 15 0)
data (cadr gr)
)
(cond
((= (car gr) 3) (setq loop nil))
((= (car gr) 5)
(setq hhh;;此处修改
ent (emod 40 hh ent)
)
(emod 41 (/ (abs (- (car data) (car p))) (* hh wb)) ent)
)
((member (car gr) '(11 25))
(setq loop nil
ent(emod 40 h ent)
)
(emod 41 w ent)
)
)
)
)
)
(princ)
)
satan421 发表于 2019-11-14 16:57
谢谢，您的回答完美的解决了这个问题，原程序选择文字采用单击选择，能否增加一个框选文字功能，就像CAD的拉伸命令那样直接框选。 qssq 发表于 2019-11-15 09:08
谢谢，您的回答完美的解决了这个问题，原程序选择文字采用单击选择，能否增加一个框选文字功能，就像CAD ...
可以框选改宽度比例，但是框选后动态拉伸比较难。
页:
[1]