[LISP程序]：对圆，文字和直线以中心点进行缩放
;;;对圆，文字和直线以中心点进行缩放(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请选择缩放实体类别：///[回车选择圆进行缩放]: ")))
(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文字的缩放比例:")))
(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圆的缩放比例:")))
(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)
) no function definition: @MPT (defun @mpt (pt1 pt2)
(polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2))
) 谢谢分享。
请在程序中加入说明，以方便阅读。 程序思路不错，用起来也挺方便。就是感觉在选择缩放类型时能有一项是“全选”的就好了。 刚试用了,感觉还是不错,多谢分享. 感谢分享 好资料 收藏 谢谢 我修改了一下实现了想要的功能 代码有点长，得慢慢学习。感谢分享。 谢谢分享{:1_12:}{:1_12:}{:1_12:}
页:
[1]