429014673 发表于 2011-11-26 00:05:46

[求] [助] 文字原位缩放

如题,在论坛中找了许久,但一直找不到合适的.....哪位有时间帮忙一下,谢谢....

xiaohahamail 发表于 2020-11-5 22:42:48

cuyongping 发表于 2011-12-3 13:53
我是这样做的(defun C:tt();中心点缩放文字
(setq scl (getreal "\n缩放比例："))
(setq ss (ssget '(( ...

能以左方缩放文字吗

cabinsummer 发表于 2011-11-26 04:34:33

本帖最后由 cabinsummer 于 2011-11-26 09:34 编辑

就是一个改字高的程序，论坛里多如牛毛。以下部分只改一般文本，多行文本自己动手吧。

(setq scl (getreal "\n缩放比例："))
(setq ss (ssget '((0 . "TEXT"))))
(setq n 0)
(repeat (sslength ss)
(setq ename (ssname ss n))
(setq edata (entget ename))
(setq height (assoc 40 edata))
(setq edata (subst (cons 40 (* scl (cdr height))) height edata))
(entmod edata)
(entupd ename)
(setq n (1+ n))
)

无痕月色 发表于 2011-11-26 09:15:26

cabinsummer 发表于 2011-11-26 04:34 static/image/common/back.gif
就是一个改字高的程序，论坛里多如牛毛。以下部分只改一般文本，多行文本自己动手吧。

试了下还是不行,让你见笑了...

cabinsummer 发表于 2011-11-26 09:34:39

无痕月色 发表于 2011-11-26 09:15 static/image/common/back.gif
试了下还是不行,让你见笑了...

ssname函数写反了，你再试一下

byghbcx 发表于 2011-11-26 10:35:27

原位缩放，是否指在文字中心缩放？

byghbcx 发表于 2011-11-26 10:52:23

本帖最后由 byghbcx 于 2011-11-26 10:53 编辑

(defun tt();中心点缩放文字
(setq scl (getreal "\n缩放比例："))
(setq ss (ssget '((0 . "TEXT"))))
(setq n 0)
(repeat (sslength ss)
(setq ename (ssname ss n))
(setq edata (entget ename))
(setq height (assoc 40 edata))
(setq pt (cdr (assoc 10 edata)))
(setq corn (textbox edata))
(setq mid (midpt (car corn) (cadr corn)))
(setq pt_n (mapcar '+ pt mid))
(setq edata (subst (cons 40 (* scl (cdr height))) height edata))
(setq edata (subst (cons 72 4) (assoc 72 edata) edata))
(setq edata (subst (cons 11 pt_n) (assoc 11 edata) edata))
(entmod edata)
(entupd ename)
(setq n (1+ n))
)
)

cuyongping 发表于 2011-12-2 17:03:35

byghbcx 发表于 2011-11-26 10:52 static/image/common/back.gif


6楼的程序好像有点问题！

byghbcx 发表于 2011-12-3 11:50:36

midpt是求中点函数，(defun midpt (pta ptb)
   (mapcar '(lambda (x y) (/ (+ x y) 2.0)) pta ptb)
)
另针对有角度的文字处理，自己再修改一下即可。

cuyongping 发表于 2011-12-3 13:53:24

byghbcx 发表于 2011-12-3 11:50 static/image/common/back.gif
midpt是求中点函数，(defun midpt (pta ptb)
   (mapcar '(lambda (x y) (/ (+ x y) 2.0)) pta ptb)
)
...

我是这样做的(defun C:tt();中心点缩放文字
(setq scl (getreal "\n缩放比例："))
(setq ss (ssget '((0 . "TEXT"))))
(setq n 0)
(repeat (sslength ss)
(setq ename (ssname ss n))
(setq edata (entget ename))
(setq height (assoc 40 edata))
(setq pt (cdr (assoc 10 edata)))
(setq corn (textbox edata))
(setq p1 (car corn))
(setq p3 (cadr corn))
(setq p2 (list (car p3)(cadr p1)))
(setq p4 (list (car p1)(cadr p3)))
(setq dda (+ (/ (distance p1 p2) 2)))
(setq cen (inters p1 p3 p2 p4 ))
(setq pt_n (mapcar '+ pt cen))
(setq edata (subst (cons 40 (* scl (cdr height))) height edata))
(setq edata (subst (cons 72 4) (assoc 72 edata) edata))
(setq edata (subst (cons 11 pt_n) (assoc 11 edata) edata))
(entmod edata)
(entupd ename)
(setq n (1+ n))
)
)
也可以实现

cuyongping 发表于 2011-12-3 13:53:58

lambda函数我就不会用!
页: [1] 2
查看完整版本: [求] [助] 文字原位缩放