【工具】局部重新生成

Lispboy

1. (defun c:xdtb_partregen (/ box p1 p2 p3 p4 ss v)
   
2.   (xdrx-begin)
   
3.   (if (and (setq p1 (getpoint "\n窗口第一点<屏幕范围>:"))
   
4.            (setq p3 (getcorner p1 "\n窗口第二点<屏幕范围>:"))
   
5.       )
   
6.     (progn (setq v   (mapcar '- p3 p1)
   
7.                  p2  (mapcar '+ p1 (list (car v) 0 0))
   
8.                  p4  (mapcar '+ p1 (list 0.0 (cadr v) 0.0))
   
9.                  box (list p1 p2 p3 p4)
   
10.            )
    
11.     )
    
12.     (progn (setq box (xdrx-get-screenbox)
    
13.                  box (xdrx-points-wcs2ucs box)
    
14.            )
    
15.     )
    
16.   )
    
17.   (if (setq ss (ssget "cp" box))
    
18.     (progn (xdrx-object-regen ss)
    
19.            (xdrx-prompt "\n局部重新生成完毕.")
    
20.     )
    
21.     (xdrx-prompt "\n没有发现对象.")
    
22.   )
    
23.   (xdrx-end)
    
24.   (princ)
    
25. )
    
26. 
    

(defun c:xdtb_partregen (/ box p1 p2 p3 p4 ss v)<br />   (xdrx-begin)<br />   (if (and (setq p1 (getpoint "\n窗口第一点<屏幕范围>:"))<br />            (setq p3 (getcorner p1 "\n窗口第二点<屏幕范围>:"))<br />       )<br />     (progn (setq v   (mapcar '- p3 p1)<br />                  p2  (mapcar '+ p1 (list (car v) 0 0))<br />                  p4  (mapcar '+ p1 (list 0.0 (cadr v) 0.0))<br />                  box (list p1 p2 p3 p4)<br />            )<br />     )<br />     (progn (setq box (xdrx-get-screenbox)<br />                  box (xdrx-points-wcs2ucs box)<br />            )<br />     )<br />   )<br />   (if (setq ss (ssget "cp" box))<br />     (progn (xdrx-object-regen ss)<br />            (xdrx-prompt "\n局部重新生成完毕.")<br />     )<br />     (xdrx-prompt "\n没有发现对象.")<br />   )<br />   (xdrx-end)<br />   (princ)<br /> )<br /> <br />