【工具】批量对象原地缩放（以自身的几何中心）

marting

1. (defun c:xdtb_sclori (/ ss p1 p2 x t1 t2 mat scl)
   
2.   (if (setq ss
   
3.              (xdrx-ssget
   
4.                "\n*** 图元原地缩放((物体中心为基点)) ***\n选择要缩放的对象<退出>:"
   
5.              )
   
6.       )
   
7.     (progn
   
8.       (xdrx-begin)
   
9.       (setvar "lastpoint" '(0 0 0))
   
10.       (xdrx-sysvar-push '("osmode" 33))
    
11.       (if (and (xdrx-initget 1 "R")
    
12.                (setq p0 (getvar "lastpoint"))
    
13.                (setq
    
14.                  p1 (getreal (xdrx-prompt "\n请输入比例因子或[参照(R)]" t))
    
15.                )
    
16.           )
    
17.         (progn
    
18.           (cond
    
19.             ((= p1 "R")
    
20.              (setq pp (getvar "lastpoint"))
    
21.              (if (not (setq t1 (getpoint "\n指定参照长度: <1>")))
    
22.                (setq dist1 1.0)
    
23.                (progn
    
24.                  (if (= (xdrx-getvar "lastinput") 0)
    
25.                    (setq dist1 (distance t1 pp))
    
26.                    (progn (initget 1)
    
27.                           (if (setq t2 (getpoint t1 "\n指定第二点:"))
    
28.                             (setq dist1 (distance t2 t1))
    
29.                           )
    
30.                    )
    
31.                  )
    
32.                )
    
33.              )
    
34.              (if
    
35.                (and
    
36.                  dist1
    
37.                  (setq d1 (getpoint "\n指定新长度:"))
    
38.                  (progn
    
39.                    (if (= (xdrx-getvar "lastinput") 0)
    
40.                      (setq dist2 (distance d1 pp))
    
41.                      (progn (initget 1)
    
42.                             (if        (setq d2 (getpoint d1 "\n指定第二点:"))
    
43.                               (setq dist2 (distance d2 d1))
    
44.                             )
    
45.                      )
    
46.                    )
    
47.                  )
    
48.                )
    
49.                 (setq scl (/ dist2 dist1))
    
50.              )
    
51.             )
    
52.             ((= (type p1) 'real) (setq scl p1))
    
53.           )
    
54.         )
    
55.         (setq v (getvar "ucsydir"))
    
56.       )
    
57.       (if scl
    
58.         (progn (mapcar '(lambda        (x)
    
59.                           (setq        mat (xdrx-matrix-setscale
    
60.                                       scl
    
61.                                       (trans (xd::geom:get9pt x 5) 1 0)
    
62.                                     )
    
63.                           )
    
64.                           (xdrx-entity-transform x mat)
    
65.                         )
    
66.                        (xdrx-pickset->ents ss)
    
67.                )
    
68.                (xdrx-prompt "\n共原位缩放了 " (sslength ss) " 个对象.")
    
69.         )
    
70.       )
    
71.       (xdrx-sysvar-pop)
    
72.       (xdrx-end)
    
73.     )
    
74.   )
    
75.   (princ)
    
76. )
    
77. 
    

(defun c:xdtb_sclori (/ ss p1 p2 x t1 t2 mat scl)<br />   (if (setq ss<br />              (xdrx-ssget<br />                "\n*** 图元原地缩放((物体中心为基点)) ***\n选择要缩放的对象<退出>:"<br />              )<br />       )<br />     (progn<br />       (xdrx-begin)<br />       (setvar "lastpoint" '(0 0 0))<br />       (xdrx-sysvar-push '("osmode" 33))<br />       (if (and (xdrx-initget 1 "R")<br />                (setq p0 (getvar "lastpoint"))<br />                (setq<br />                  p1 (getreal (xdrx-prompt "\n请输入比例因子或[参照(R)]" t))<br />                )<br />           )<br />         (progn<br />           (cond<br />             ((= p1 "R")<br />              (setq pp (getvar "lastpoint"))<br />              (if (not (setq t1 (getpoint "\n指定参照长度: <1>")))<br />                (setq dist1 1.0)<br />                (progn<br />                  (if (= (xdrx-getvar "lastinput") 0)<br />                    (setq dist1 (distance t1 pp))<br />                    (progn (initget 1)<br />                           (if (setq t2 (getpoint t1 "\n指定第二点:"))<br />                             (setq dist1 (distance t2 t1))<br />                           )<br />                    )<br />                  )<br />                )<br />              )<br />              (if<br />                (and<br />                  dist1<br />                  (setq d1 (getpoint "\n指定新长度:"))<br />                  (progn<br />                    (if (= (xdrx-getvar "lastinput") 0)<br />                      (setq dist2 (distance d1 pp))<br />                      (progn (initget 1)<br />                             (if        (setq d2 (getpoint d1 "\n指定第二点:"))<br />                               (setq dist2 (distance d2 d1))<br />                             )<br />                      )<br />                    )<br />                  )<br />                )<br />                 (setq scl (/ dist2 dist1))<br />              )<br />             )<br />             ((= (type p1) 'real) (setq scl p1))<br />           )<br />         )<br />         (setq v (getvar "ucsydir"))<br />       )<br />       (if scl<br />         (progn (mapcar '(lambda        (x)<br />                           (setq        mat (xdrx-matrix-setscale<br />                                       scl<br />                                       (trans (xd::geom:get9pt x 5) 1 0)<br />                                     )<br />                           )<br />                           (xdrx-entity-transform x mat)<br />                         )<br />                        (xdrx-pickset->ents ss)<br />                )<br />                (xdrx-prompt "\n共原位缩放了 " (sslength ss) " 个对象.")<br />         )<br />       )<br />       (xdrx-sysvar-pop)<br />       (xdrx-end)<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

zero彡

非常有用，多谢大佬分享

lispwei

非常有用，多谢大佬分享