用text写的字体放大

citykunan

我编了一个改变字高的程序，这个程序对mtext的字很好用，可是对于text写的字却不管用。因为若用text写了多行字，再用此程序放大字体，字就会挤在一起，不知如何解决？可能一张图纸上有多处用text写的多行字。 (defun c:sct (/ ss texthight i ent ents ents_new)
(prompt "Select text...")
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(setq texthight (getreal "\nEnter text hight:"))
(setq i 0)
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq ents (entget ent))
(setq ents_new (subst (cons 40 texthight) (assoc 40 ents) ents))
(entmod ents_new)
(setq i (1+ i))
);end repeat
(princ)
) (princ)
(prompt "\nType sct to run")
(princ)

meflying

按比例挪一下位置不就可以了吗

citykunan

我也这样想过，但也不行，有的地方text写的字为3行，而有的地方用text写的字有5行。他们需要移的距离是不同的。

meflying

算一个行距，有几行，在第几行就乘几倍行距不就行了？

citykunan

是这样的飞版主，我有一张图纸，在很多地方都有TEXT，而且其行数都不一样，


我想把他们一下子变成同样的高度，此高度就是键盘输入的值。不知怎么实现？


谢谢。


       

meflying

前面不已经说了吗，按你的程序修改，然后挪一下位置。

meflying

参考一下，根据你自己的需要进行修改，如需要，最后还可将其炸开

2. (defun MakeText(pt1 str h lay style / ptInsert TextDxf)
3.    (setq TextDxf '(
4.        (0 . "MTEXT")
5.        (100 . "AcDbEntity")
6.        (100 . "AcDbMText")
7.            )
8.    )
9.    (setq TextDxf (append TextDxf (list
10.            (cons 10 pt1)
11.            (cons 1 str)
12.            (cons 40 h)
13.            (cons 7   style)
14.            (cons 8 lay)
15.         )
16.     )
17.    )
18.    (entmake TextDxf)
19.    (princ)
20. )
21. (defun text->Mtext(ent_Texts h / h1   i ent_Text ents pt str lay style)
22.    (setq i 1)
23.    (setq ent_Texts (vl-sort ent_Texts
24.            '(lambda (e1 e2) (> (cadr (cdr (assoc 10 (entget e1)))) (cadr (cdr (assoc 10 (entget e2))))))))
25.    (setq ent_Text (car ent_Texts))
26.    (setq ents (entget ent_Text))
27.    (setq pt (cdr (assoc 10 ents)))
28.    (setq h1 (cdr (assoc 40 ents)))
29.    (setq pt (list (car pt) (+ (cadr pt) h1) (last pt)))
30.    (setq str (cdr (assoc 1 ents)))
31.    (setq lay (cdr (assoc 8 ents)))
32.    (setq style (cdr (assoc 7 ents)))
33.    (repeat (1- (length ent_Texts))
34.        (setq ents (entget (nth i ent_Texts)))
35.        (setq str (strcat str "\n" (cdr (assoc 1 ents))))
36.        (setq i (1+ i))
37.    )
38.    (mapcar 'entdel ent_Texts)
39.    (MakeText pt str h lay style)
40. )(defun main( / ss i ent_Texts h)
41.    (setq ss (ssget '((0 . "text"))))
42.    (setq i 0)
43.    (setq ent_Texts nil)
44.    (repeat (sslength ss)
45.        (setq ent_Texts (append ent_Texts (list (ssname ss i))))
46.        (setq i (1+ i))
47.    )
48.    (setq h (getreal "输入字高:"))
49.    (text->Mtext ent_Texts h)
50. )

(defun MakeText(pt1 str h lay style / ptInsert TextDxf)    (setq TextDxf '(        (0 . "MTEXT")        (100 . "AcDbEntity")        (100 . "AcDbMText")            )    )    (setq TextDxf (append TextDxf (list            (cons 10 pt1)            (cons 1 str)            (cons 40 h)            (cons 7   style)            (cons 8 lay)         )     )    )    (entmake TextDxf)    (princ) ) (defun text->Mtext(ent_Texts h / h1   i ent_Text ents pt str lay style)    (setq i 1)    (setq ent_Texts (vl-sort ent_Texts            '(lambda (e1 e2) (> (cadr (cdr (assoc 10 (entget e1)))) (cadr (cdr (assoc 10 (entget e2))))))))    (setq ent_Text (car ent_Texts))    (setq ents (entget ent_Text))    (setq pt (cdr (assoc 10 ents)))    (setq h1 (cdr (assoc 40 ents)))    (setq pt (list (car pt) (+ (cadr pt) h1) (last pt)))    (setq str (cdr (assoc 1 ents)))    (setq lay (cdr (assoc 8 ents)))    (setq style (cdr (assoc 7 ents)))    (repeat (1- (length ent_Texts))        (setq ents (entget (nth i ent_Texts)))        (setq str (strcat str "\n" (cdr (assoc 1 ents))))        (setq i (1+ i))    )    (mapcar 'entdel ent_Texts)    (MakeText pt str h lay style) )(defun main( / ss i ent_Texts h)    (setq ss (ssget '((0 . "text"))))    (setq i 0)    (setq ent_Texts nil)    (repeat (sslength ss)        (setq ent_Texts (append ent_Texts (list (ssname ss i))))        (setq i (1+ i))    )    (setq h (getreal "输入字高:"))    (text->Mtext ent_Texts h) )