(defun c:textfit(/ ename textent newend tmp start newpt val ltc_% ss txtsz)(acet-error-init(list(list"cmdecho" 0"snapang" 0"limcheck" 0"orthomode" 1)T))(if(not(and(setq ss(ssget"_i"))(=(sslength ss)1)(setq ename(ssname ss 0))))(setq ename(car(entsel"\n选择要拉伸和收缩的文字:"))))(cond((not(setq textent(if ename(entget ename))))(princ"\n未选中对象!"))((/=(acet-dxf 0 textent)"TEXT")(princ"\n选择的对象不是文字!"))((acet-layer-locked(acet-dxf 8 textent))(princ"\n选中的对象在一个锁定的层上!"))(t(setq txtsz(textbox textent))(setq newend(distance(list(caadr txtsz)(cadar txtsz))(car txtsz)))(setvar"snapang"(angtof(angtos(acet-dxf 50 textent)0 8)0))(initget 0"Start _Start")(setq tmp(getpoint(acet-dxf 10 textent)"\n指定端点或 [起点(S)]: "))(setvar"snapang"0)(cond((=(type tmp)'STR)(setq start(getpoint"\n指定新起点: "))(if start(progn(acet-ucs-cmd(list"_E"(acet-dxf -1 textent)))(setvar"orthomode"1)(setq newpt(if start(getpoint(trans start 0 1)" 端点: ")nil))(if newpt(setq newpt(trans newpt 1 0)))
(setvar"orthomode"0)(acet-ucs-cmd(list"_p"))))if)((not(null tmp))(setq start(acet-dxf 10 textent)newpt tmp))(t(setq start nil newpt nil)))(if(and start newpt)(progn(setq val(assoc 41 textent)val(if val(cdr val)1.0)ltc_%(*(/(distance start newpt)newend)val)textent(subst(cons 41 ltc_%)(assoc 41 textent)textent)textent(subst(cons 10 start)(assoc 10 textent)textent)textent(subst(cons 11 newpt)(assoc 11 textent)textent))(entmod textent)(entupd(acet-dxf -1 textent))))))(acet-error-restore)(princ))(princ)
