[求助]：请教这种情况用lisp怎么样实现，小弟刚学，谢谢

aliu22

要实现选择多个矩形或圆形同时缩放，自动找到各自的中心，按比例缩放后把原来矩形或圆形删除

david96007

圆好解决:

利用entmod修改半径就行了!

至于矩形,就比较麻烦了!至少在r14下比较麻烦!矩形的中心->以中心为相对坐标原点建立用户坐标系->得到各顶点的极坐标->然后按比例缩放,得到新的顶点坐标->更新矩形!

这只是我的思路,并没有写过代码!

下午闲来无事,试着写了一下缩放矩形的:

程序没有对对象是否为矩形进行判断!凡是具有4个顶点的pl线都可缩放!

2. 
   
3. 
   
4. (defun c:tt ()
   
5.   (princ "选择需要缩放的矩形:")
   
6.   (setq        ss (ssget)
   
7.         sl (sslength ss)
   
8.         m  0
   
9.   )
   
10.   (setq sca (getreal "输入缩放比例<1>:"))
    
11.   (if (= nil sca)
    
12.     (setq sca 1)
    
13.   )
    
14.   (while (< m sl)
    
15.     (setq dd (entget (ssname ss m))
    
16.           l  (length dd)
    
17.           n  0
    
18.           dl nil
    
19.     )
    
20.     (while (< n l)
    
21.       (setq d (nth n dd))
    
22.       (if (= 10 (car d))
    
23.         (setq dl (cons (cons n d) dl))
    
24.       )
    
25.       (setq n (1+ n))
    
26.     )
    
27.     (setq l  (length dl)
    
28.           n  0
    
29.           xx 0
    
30.           yy 0
    
31.     )
    
32.     (if        (= 4 l)
    
33.       (progn (while (< n l)
    
34.                (setq pt        (nth n dl)
    
35.                      x        (caddr pt)
    
36.                      y        (cadddr pt)
    
37.                      xx        (+ x xx)
    
38.                      yy        (+ y yy)
    
39.                      n        (1+ n)
    
40.                )
    
41.              )
    
42.              (setq x   (/ xx 4)
    
43.                    y   (/ yy 4)
    
44.                    cen (list x y)
    
45.                    n   0
    
46.              )
    
47.              (while (< n l)
    
48.                (setq pt            (cddr (nth n dl))
    
49.                      ang    (angle cen pt)
    
50.                      dis    (distance cen pt)
    
51.                      newdis (* dis sca)
    
52.                      newpt  (polar cen ang newdis)
    
53.                      num    (car (nth n dl))
    
54.                      newd   (cons 10 newpt)
    
55.                      dd            (subst newd (nth num dd) dd)
    
56.                      n            (1+ n)
    
57.                )
    
58.              )
    
59.              (entmod dd)
    
60.       )
    
61.       (princ "选择的对象不是矩形!")
    
62.     )
    
63.     (setq m (1+ m))
    
64.   )
    
65.   (princ)
    
66. )
    
67. 
    
68. 
    

<br /> <br /> (defun c:tt ()<br />   (princ "选择需要缩放的矩形:")<br />   (setq        ss (ssget)<br />         sl (sslength ss)<br />         m  0<br />   )<br />   (setq sca (getreal "输入缩放比例<1>:"))<br />   (if (= nil sca)<br />     (setq sca 1)<br />   )<br />   (while (< m sl)<br />     (setq dd (entget (ssname ss m))<br />           l  (length dd)<br />           n  0<br />           dl nil<br />     )<br />     (while (< n l)<br />       (setq d (nth n dd))<br />       (if (= 10 (car d))<br />         (setq dl (cons (cons n d) dl))<br />       )<br />       (setq n (1+ n))<br />     )<br />     (setq l  (length dl)<br />           n  0<br />           xx 0<br />           yy 0<br />     )<br />     (if        (= 4 l)<br />       (progn (while (< n l)<br />                (setq pt        (nth n dl)<br />                      x        (caddr pt)<br />                      y        (cadddr pt)<br />                      xx        (+ x xx)<br />                      yy        (+ y yy)<br />                      n        (1+ n)<br />                )<br />              )<br />              (setq x   (/ xx 4)<br />                    y   (/ yy 4)<br />                    cen (list x y)<br />                    n   0<br />              )<br />              (while (< n l)<br />                (setq pt            (cddr (nth n dl))<br />                      ang    (angle cen pt)<br />                      dis    (distance cen pt)<br />                      newdis (* dis sca)<br />                      newpt  (polar cen ang newdis)<br />                      num    (car (nth n dl))<br />                      newd   (cons 10 newpt)<br />                      dd            (subst newd (nth num dd) dd)<br />                      n            (1+ n)<br />                )<br />              )<br />              (entmod dd)<br />       )<br />       (princ "选择的对象不是矩形!")<br />     )<br />     (setq m (1+ m))<br />   )<br />   (princ)<br /> )<br /> <br /> <br />

aliu22

不错不错,谢谢不过我觉得判断不是矩形时没必要每条线都判断,只要判断一次就可以了.