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

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

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

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

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

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

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
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函数我就不会用!

账号		自动登录	找回密码
密码			注册

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

点评