实体中心缩放

st788796 · 发表于 2013-12-10 14:42:10

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun c:XDTB_CenterScale (/ scl ss mat)
(initget 128 "R")
(and (setq scl (getdist "\n缩放比例[R - 参照]: "))
(cond
((and (= scl "R")
(setq d0 (getdist "\n指定参照长度: "))
(setq d (getdist "\n指定新的长度: "))
)
(setq scl (/ d d0))
)
((= (type scl) 'REAL) scl)
(t (exit))
)
(/= scl 1.)
(setq ss (ssget))
(setq mat (xdrx_matrix_identity 3))
(xd::begin)
(xdrx_document_ucsoff)
(mapcar '(lambda (x / box)
(setq box (xdrx_entity_box x))
(xdrx_entity_transform
x
(xdrx_matrix_setscale
mat
scl
(xdrx_line_midp (car box) (caddr box))
)
)
)
(xdrx_pickset->ents ss)
)
(xdrx_document_ucson)
(xd::end)
)
(princ)
)

(defun c:XDTB_CenterScale (/ scl ss mat) 
  (initget 128 "R") 
  (and (setq scl (getdist "\n缩放比例[R - 参照]: ")) 
       (cond 
         ((and (= scl "R") 
               (setq d0 (getdist "\n指定参照长度: ")) 
               (setq d (getdist "\n指定新的长度: ")) 
          ) 
          (setq scl (/ d d0)) 
         ) 
         ((= (type scl) 'REAL) scl) 
         (t (exit)) 
       ) 
       (/= scl 1.) 
       (setq ss (ssget)) 
       (setq mat (xdrx_matrix_identity 3)) 
       (xd::begin) 
       (xdrx_document_ucsoff) 
       (mapcar '(lambda        (x / box) 
                  (setq box (xdrx_entity_box x)) 
                  (xdrx_entity_transform 
                    x 
                    (xdrx_matrix_setscale 
                      mat 
                      scl 
                      (xdrx_line_midp (car box) (caddr box)) 
                    ) 
                  ) 
                ) 
               (xdrx_pickset->ents ss) 
       ) 
       (xdrx_document_ucson) 
       (xd::end) 
  ) 
  (princ) 
)

liuyj · 发表于 2013-12-10 16:24:12

以前发过吧

st788796 · 发表于 2013-12-10 16:26:10

liuyj 发表于 2013-12-10 16:24
以前发过吧

在应用版发的，转移过来

1993063 · 发表于 2013-12-10 16:55:19

(Defun C:scsc ( / ENTMID i pt s1 ss )
(Defun ENTMID ( ent / maxp maxp )
(setq ent (vlax-ename->vla-object ent))(vla-getboundingbox ent 'minp 'maxp)
(setq maxp (vlax-safearray->list maxp) minp (vlax-safearray->list minp))
(Mapcar '(Lambda (x) (* x 0.5)) (Mapcar '+ minp maxp))
)
(while (setq ss (ssget ":s")
*scal* (getreal "\n缩放倍数")
i -1
)
(if (/= *scal* 1)
(progn
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq pt (ENTMID s1))
(Command "scale" s1 "" pt *scal*)
)
)
)
)(princ)
)

sachindkini · 发表于 2013-12-10 17:14:46

dear sir, coool

Lisphk · 发表于 2013-12-10 18:28:33

对块，属性这些都可以吗？

st788796 · 发表于 2013-12-10 19:01:27

Lisphk 发表于 2013-12-10 18:28
对块，属性这些都可以吗？

经测试，支持属性块

gzgbzh · 发表于 2014-2-8 22:42:52

看着东西不错,下下来试试怎么样

434939575 · 发表于 2014-2-19 13:23:03

收藏了。可惜这些XD函数还看不懂。

liuchong1988 · 发表于 2014-10-29 13:18:46

以前发过吧!!!
-

hn10183051 · 发表于 2019-1-10 13:29:36

真历害呀.....

364041954 · 发表于 2019-3-25 16:51:35

大哥们，为啥我加载后提示错误啊

364041954 · 发表于 2019-3-25 16:55:15

364041954 发表于 2019-3-25 16:51
大哥们，为啥我加载后提示错误啊

很好很强大，弄好了

hphkjz · 发表于 2019-5-30 14:17:16

大哥能帮小弟编个lisp程序吗，实现下图中的缩放功能呢？

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

[工具] 实体中心缩放

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

点评

点评