[求助]：有没有命令可以删除多边形以外的图元，期待高手

bagpipe80

前些天，在论坛学会了extrim 命令，非常好用，但只是剪裁相交图元，不相交的图元仍然在。
于是就想是不是有命令或是lisp可以把多边形外不相交的图元也删掉。
呵呵，期待有高手能解决。

————————————————————————————

找到一个gysjy 大大发的lisp，很是强啊，不过是用选框的矩形来，期望有可以选择已有多边形的，这样在实际使用中比较常用。

gysjy

请参阅：
http://www.xdcad.net/forum/showt ... y=&pagenumber=1

bagpipe80

呵呵，谢谢gysjy 大大的关注！
不过那个贴子我看过，是点什么剪什么。
我想找一个类似于extrim命令的，不过还能把多边形以外不相交的图元删掉，类似于窗口的效果，不过这样比较方便于工程出图和电子文件归档。
我找到过你做的一个lisp，如附件，但就是不能选多边形，也能把多边形以外不相交的图元删掉。如果你能帮我改一下，非常非常谢谢。

gysjy

最初由 bagpipe80 发布
[B]
我想找一个类似于extrim命令的，不过还能把多边形以外不相交的图元删掉，类似于窗口的效果，不过这样比较方便于工程出图和电子文件归档。
我... [/B]

看看下面这个适合不适合你？

2. 
   
3.   [FONT=courier new]
   
4. (defun to(n)
   
5.   (cdr (assoc n (entget sn)))
   
6. )
   
7. (defun MODES (a)
   
8.   (setq MLST '())
   
9.   (repeat (length a)
   
10.     (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
    
11.     (setq a (cdr a))
    
12.   )
    
13. )
    
14. 
    
15. (defun MODER ()
    
16.   (repeat (length MLST)
    
17.     (setvar (caar MLST) (cadar MLST))
    
18.     (setq MLST (cdr MLST))
    
19.   )
    
20. )
    
21. 
    
22. (princ "\n删除多边形外图元 --- GYSJY, 2007.10.5 ")
    
23. (defun c:nn( / lst n p0 p1 s1 s2 sn ss)
    
24.   (command "undo" "g")  
    
25.   (modes '("cmdecho" "osmode" ))
    
26.   (setvar "cmdecho" 0)
    
27.   (setvar "osmode" 0)   
    
28.   (graphscr)
    
29.   (setq sn (entsel "\n选择多边形:"))
    
30.     (setq p0 (cadr sn) sn (car sn) p1 (polar p0 0 100000))
    
31.     (if (= (to 0) "LWPOLYLINE")
    
32.       (progn
    
33.         (command "offset" "0.1" sn p1 "")
    
34.         (setq s1 sn sn (entlast))
    
35.         (cond
    
36.           ((= "LWPOLYLINE" (to 0))
    
37.             (plpoint)
    
38.             (repeat 5
    
39.               (command "trim" s1 "" "f" (foreach n lst (command n) "" ) "")
    
40.             )
    
41.             (if (setq s2 (ssget "f" lst))(command "erase" s2 ""))
    
42.           )
    
43.         )
    
44.         (setq ss (ssget "wp" lst))
    
45.         (command "erase" "all" "r" s1 ss "")
    
46.       )
    
47.       (princ "\n>>>界线类型应为 LWPOLYLINE")
    
48.     )
    
49.   (moder)
    
50.   (command "undo" "e")
    
51.   (princ)
    
52. )
    
53. (defun plpoint(/ en n ei )
    
54.     (setq en (entget sn)
    
55.             n 0 lst '()
    
56.     )
    
57.     (while (/= (setq ei (nth n en)) nil)
    
58.             (if        (= (car ei) 10)
    
59.                 (setq lst (cons (cdr ei) lst))
    
60.             )
    
61.             (setq n (1+ n))
    
62.     )
    
63.     (setq lst (reverse lst)); lst (cons (last lst) lst))
    
64.     (if (= (to 70) 1)(setq lst (cons (last lst) lst)))
    
65.     (princ)
    
66. )
    
67. 
    
68.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun to(n)<br />   (cdr (assoc n (entget sn)))<br /> )<br /> (defun MODES (a)<br />   (setq MLST '())<br />   (repeat (length a)<br />     (setq MLST (append MLST (list (list (car a) (getvar (car a))))))<br />     (setq a (cdr a))<br />   )<br /> )<br /> <br /> (defun MODER ()<br />   (repeat (length MLST)<br />     (setvar (caar MLST) (cadar MLST))<br />     (setq MLST (cdr MLST))<br />   )<br /> )<br /> <br /> (princ "\n删除多边形外图元 --- GYSJY, 2007.10.5 ") <br /> (defun c:nn( / lst n p0 p1 s1 s2 sn ss)<br />   (command "undo" "g")  <br />   (modes '("cmdecho" "osmode" )) <br />   (setvar "cmdecho" 0) <br />   (setvar "osmode" 0)   <br />   (graphscr)<br />   (setq sn (entsel "\n选择多边形:"))<br />     (setq p0 (cadr sn) sn (car sn) p1 (polar p0 0 100000))<br />     (if (= (to 0) "LWPOLYLINE")<br />       (progn<br />         (command "offset" "0.1" sn p1 "") <br />         (setq s1 sn sn (entlast))<br />         (cond<br />           ((= "LWPOLYLINE" (to 0))<br />             (plpoint)<br />             (repeat 5 <br />               (command "trim" s1 "" "f" (foreach n lst (command n) "" ) "")<br />             )<br />             (if (setq s2 (ssget "f" lst))(command "erase" s2 ""))<br />           )<br />         )<br />         (setq ss (ssget "wp" lst))<br />         (command "erase" "all" "r" s1 ss "")<br />       )<br />       (princ "\n>>>界线类型应为 LWPOLYLINE")<br />     )<br />   (moder) <br />   (command "undo" "e")<br />   (princ)<br /> )<br /> (defun plpoint(/ en n ei )<br />     (setq en (entget sn)<br />             n 0 lst '() <br />     )<br />     (while (/= (setq ei (nth n en)) nil)<br />             (if        (= (car ei) 10)<br />                 (setq lst (cons (cdr ei) lst))<br />             )<br />             (setq n (1+ n))<br />     )<br />     (setq lst (reverse lst)); lst (cons (last lst) lst))<br />     (if (= (to 70) 1)(setq lst (cons (last lst) lst)))<br />     (princ)<br /> )<br /> <br />   [/FONT]<br />

bagpipe80

呵呵，非常适用。非常感谢！有个问题，就是使用命令时，屏幕不显示的图元也都被删除了，不知道为什么。呵呵，不过使用时注意一下也就ok了，再次感谢！