[LISP程序]：文字放大、缩小程序

qiaqiadeng

功能：将文字放大或者缩小一倍，点取文字后，程序自动找到文字选取点px，拉出PL线让用户点另一点px1，若px1在px的右或上边，则将文字放大一倍，反之则缩小一倍。

(defun *$dyq-error$* (msg)
  ;(command ".undo" "")
  (setq *error* &olderr&)
  ;(princ)
)

(princ "\nsf  将字体放大缩放")
(defun c:sf (/ zt i shiti h p1 scx px px1)
  (setq &olderr& *error*)
  (setq *error* *$dyq-error$*)
  (setq oldstatus (dyq-get-oldstatus))
  (setvar "ORTHOMODE" 1)
  (setvar "OSMODE" 0)
  (prompt "将字体放大一倍")
  (setq i 0)
  (setq scx 0)
  (while (setq zt (entsel "\n请选择要放大的字体:"))
    (if        (= i 0)
      (progn
        (setq px (cadr zt))
        (setq px1 (getpoint px "\n请选择方向:"))
        (if (= (car px) (car px1)) ;如果X坐标相等
          (if (> (cadr px1) (cadr px))
            (setq scx 2)
            (setq scx 0.5)
          )
          (if (> (car px1) (car px)) ;如果Y坐标相等
            (setq scx 2)
            (setq scx 0.5)
          )
        )
      )
    )
    (if        px1
      (progn
        (setq shiti (entget (car zt)))
        (setq i (+ 1 i))
        (if (or        (= (cdr (assoc 0 shiti)) "TEXT")
                (= (cdr (assoc 0 shiti)) "MTEXT")
            )
          (progn
            (setq h (cdr (assoc '40 shiti)))
            (setq p1 (assoc '10 shiti))
            (setq shiti (subst '(72 . 0) (assoc 72 shiti) shiti))
;改对齐方式
            (setq shiti (subst p1 (assoc '10 shiti) shiti)) ;改起点
            (setq shiti (subst '(41 . 0.7) (assoc 41 shiti) shiti))
;改宽比例
            (setq
              shiti (subst (cons 40 (* scx h)) (assoc 40 shiti) shiti)
            )
;改字高?
            (entmod shiti)
          )
        )
      )
    )
  )
  (setq *error* &olderr&)
  (princ)
)

qsb506

正是我想要的，谢谢楼主！

鬼魔

SCALETEXT这个命令不好吗

qsb506

楼主，载入后键入SF没动静啊！