马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
x
本帖最后由 newer 于 2020-6-27 08:51 编辑
 - (defun c:xdtb_sclori (/ ss p1 p2 x t1 t2 mat scl)
- (if (setq ss
- (xdrx-ssget
- "\n*** 图元原地缩放((物体中心为基点)) ***\n选择要缩放的对象<退出>:"
- )
- )
- (progn
- (xdrx-begin)
- (setvar "lastpoint" '(0 0 0))
- (xdrx-sysvar-push '("osmode" 33))
- (if (and (xdrx-initget 1 "R")
- (setq p0 (getvar "lastpoint"))
- (setq
- p1 (getreal (xdrx-prompt "\n请输入比例因子或[参照(R)]" t))
- )
- )
- (progn
- (cond
- ((= p1 "R")
- (setq pp (getvar "lastpoint"))
- (if (not (setq t1 (getpoint "\n指定参照长度: <1>")))
- (setq dist1 1.0)
- (progn
- (if (= (xdrx-getvar "lastinput") 0)
- (setq dist1 (distance t1 pp))
- (progn (initget 1)
- (if (setq t2 (getpoint t1 "\n指定第二点:"))
- (setq dist1 (distance t2 t1))
- )
- )
- )
- )
- )
- (if
- (and
- dist1
- (setq d1 (getpoint "\n指定新长度:"))
- (progn
- (if (= (xdrx-getvar "lastinput") 0)
- (setq dist2 (distance d1 pp))
- (progn (initget 1)
- (if (setq d2 (getpoint d1 "\n指定第二点:"))
- (setq dist2 (distance d2 d1))
- )
- )
- )
- )
- )
- (setq scl (/ dist2 dist1))
- )
- )
- ((= (type p1) 'real) (setq scl p1))
- )
- )
- (setq v (getvar "ucsydir"))
- )
- (if scl
- (progn (mapcar '(lambda (x)
- (setq mat (xdrx-matrix-setscale
- scl
- (trans (xd::geom:get9pt x 5) 1 0)
- )
- )
- (xdrx-entity-transform x mat)
- )
- (xdrx-pickset->ents ss)
- )
- (xdrx-prompt "\n共原位缩放了 " (sslength ss) " 个对象.")
- )
- )
- (xdrx-sysvar-pop)
- (xdrx-end)
- )
- )
- (princ)
- )
|