[LISP程序]：对圆，文字和直线以中心点进行缩放

hnfsf

;;;对圆，文字和直线以中心点进行缩放
(defun c:msc ( / en ent ll gr ga gb mpt n new num @os sbn sbo sc ss ur)
  (setvar "cmdecho" 0)
  (setq @os (getvar "osmode"))(setvar "osmode" 0)  
  (command "undo" "begin")
  (initget "T Y L")
  (if (not (setq num (getkword "\n请选择缩放实体类别：[Y-圆]/[T-文字]/[L-线]/[回车选择圆进行缩放]: ")))
    (setq num "Y")
  )  
  (cond   
    ((= "T" num)
      (defun @getboundingbox (ent / ll ur)
        (vl-load-com)
        (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
        (@mpt (vlax-safearray->list ll) (vlax-safearray->list ur))
      )
      (princ "选择要缩放大小的文字:")
      (if (setq ss (ssget '((0 . "text,mtext"))))
        (progn
          (if (not (setq n 0 sc (getreal "\n文字的缩放比例[0.7]:")))
            (setq sc 0.7)
          )
          (repeat (sslength ss)
            (setq mpt (@getboundingbox (setq en (ssname ss n))))
            (command ".scale" en "" mpt sc)
            (setq n (1+ n))
          )
        )
      )
    )
    ((= "L" num)
      (princ "选择要缩放长度的线:")
      (if (setq ss (ssget '((0 . "LINE"))))
        (progn
          (setq sc (getreal "\n线长度的缩放比例:")n 0)
          (repeat (sslength ss)
            (setq en (ssname ss n)
                  sbo (entget en)
                  mpt (@mpt (cdr (assoc 10 sbo)) (cdr (assoc 11 sbo)))
            )
            (command ".scale" en "" mpt sc)
            (setq n (1+ n))
          )
        )
      )
    )
    ((= "Y" num)
      (princ "选择要改变缩放大小的圆:")
      (if (setq ss (ssget '((0 . "CIRCLE"))))
        (progn
          (if (not (setq n 0 sc (getreal "\n圆的缩放比例[0.7]:")))
            (setq sc 0.7)
          )
          (repeat (sslength ss)
            (setq sbo (entget (ssname ss n))
                  new (* sc (cdr (assoc 40 sbo)))
                  sbn (subst (cons 40 new) (assoc 40 sbo) sbo)
            )
            (entmod sbn)
            (setq n (+ n 1))
          )
        )
      )
    )
  )
  (setvar "osmode" @os)
  (command "undo" "end")
  (princ)
)

szx025

no function definition: @MPT

hnfsf

(defun @mpt (pt1 pt2)
  (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2))
)

limingqian

谢谢分享。
请在程序中加入说明，以方便阅读。

Archs

程序思路不错，用起来也挺方便。就是感觉在选择缩放类型时能有一项是“全选”的就好了。

522892119

刚试用了,感觉还是不错,多谢分享.

xdcad9819

感谢分享 好资料 收藏 谢谢

创佳

我修改了一下实现了想要的功能