[LISP函数]：從選擇集刪除特定特性的實體

taner

2. 
   
3.   [FONT=courier new]
   
4. ;;;參考[url]http://intervision.hjem.wanadoo.dk/[/url]
   
5. (defun th-ssdel-prop-and (sset proplst / ent i ss)
   
6.   (setq i -1
   
7.         ss (ssadd)
   
8.   )
   
9.   (setq proplst (mapcar
   
10.                   (function (lambda (x)
    
11.                               (cons (car x) (strcase (cdr x)))
    
12.                             )
    
13.                   )
    
14.                   proplst
    
15.                 )
    
16.   )
    
17.   (repeat (sslength sset)
    
18.     (setq ent (ssname sset (setq i (1+ i))))
    
19.     (if (eval (cons 'or (mapcar
    
20.                           (function (lambda (x)
    
21.                                       (not (member x (entget ent)))
    
22.                                     )
    
23.                           )
    
24.                           proplst
    
25.                         )
    
26.               )
    
27.         )
    
28.       (ssadd ent ss)
    
29.     )
    
30.   )
    
31.   ss
    
32. )
    
33. ;;; e.g. to remove all circles on layer pipe from sset1
    
34. ;;; (th-ssdel-prop-and sset1 '((0 . "circle")(8 . "pipe")))
    
35. (defun th-ssdel-prop-or (sset proplst / ent i ss)
    
36.   (setq i -1
    
37.         ss (ssadd)
    
38.   )
    
39.   (setq proplst (mapcar
    
40.                   (function (lambda (x)
    
41.                               (cons (car x) (strcase (cdr x)))
    
42.                             )
    
43.                   )
    
44.                   proplst
    
45.                 )
    
46.   )
    
47.   (repeat (sslength sset)
    
48.     (setq ent (ssname sset (setq i (1+ i))))
    
49.     (if (eval (cons 'and (mapcar
    
50.                            (function (lambda (x)
    
51.                                        (not (member x (entget ent)))
    
52.                                      )
    
53.                            )
    
54.                            proplst
    
55.                          )
    
56.               )
    
57.         )
    
58.       (ssadd ent ss)
    
59.     )
    
60.   )
    
61.   ss
    
62. )
    
63. ;;; e.g. to remove all circles or all entities on layer pipe from sset1
    
64. ;;; (th-ssdel-prop-or '((0 . "circle")(8 . "pipe")))
    
65. ;;;1.點對第二位不分大小寫
    
66. ;;;2.沒有改變SSET1(如果用SSDEL,則會改變SSET),而是新建選擇集SS.
    
67. 
    
68.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;;參考[url]http://intervision.hjem.wanadoo.dk/[/url]<br /> (defun th-ssdel-prop-and (sset proplst / ent i ss)<br />   (setq i -1<br />         ss (ssadd)<br />   )<br />   (setq proplst (mapcar<br />                   (function (lambda (x)<br />                               (cons (car x) (strcase (cdr x)))<br />                             )<br />                   )<br />                   proplst<br />                 )<br />   )<br />   (repeat (sslength sset)<br />     (setq ent (ssname sset (setq i (1+ i))))<br />     (if (eval (cons 'or (mapcar<br />                           (function (lambda (x)<br />                                       (not (member x (entget ent)))<br />                                     )<br />                           )<br />                           proplst<br />                         )<br />               )<br />         )<br />       (ssadd ent ss)<br />     )<br />   )<br />   ss<br /> )<br /> ;;; e.g. to remove all circles on layer pipe from sset1<br /> ;;; (th-ssdel-prop-and sset1 '((0 . "circle")(8 . "pipe")))<br /> (defun th-ssdel-prop-or (sset proplst / ent i ss)<br />   (setq i -1<br />         ss (ssadd)<br />   )<br />   (setq proplst (mapcar<br />                   (function (lambda (x)<br />                               (cons (car x) (strcase (cdr x)))<br />                             )<br />                   )<br />                   proplst<br />                 )<br />   )<br />   (repeat (sslength sset)<br />     (setq ent (ssname sset (setq i (1+ i))))<br />     (if (eval (cons 'and (mapcar<br />                            (function (lambda (x)<br />                                        (not (member x (entget ent)))<br />                                      )<br />                            )<br />                            proplst<br />                          )<br />               )<br />         )<br />       (ssadd ent ss)<br />     )<br />   )<br />   ss<br /> )<br /> ;;; e.g. to remove all circles or all entities on layer pipe from sset1<br /> ;;; (th-ssdel-prop-or '((0 . "circle")(8 . "pipe")))<br /> ;;;1.點對第二位不分大小寫<br /> ;;;2.沒有改變SSET1(如果用SSDEL,則會改變SSET),而是新建選擇集SS.<br /> <br />   [/FONT]<br />

Free-Lancer

2. 
   
3. (setq ss (ssget "P" '((0 . "circle")(8 . "pipe"))))
   
4. (command ".select" ss1 "r" ss "")
   

<br /> (setq ss (ssget "P" '((0 . "circle")(8 . "pipe"))))<br /> (command ".select" ss1 "r" ss "")<br />

taner

http://www.xdcad.net/forum/showt ... 3243924#post3243924

2. 
   
3.   [FONT=courier new]
   
4. (defun tt-ssdel-prop-and (sset proplst / ss1 ss2)
   
5.   (setq proplst (mapcar
   
6.                   (function (lambda (x)
   
7.                               (cons (car x) (strcase (cdr x)))
   
8.                             )
   
9.                   )
   
10.                   proplst
    
11.                 )
    
12.   )
    
13.   (command "_.select" sset "")
    
14.   (setq ss1 (ssget "p")
    
15.         ss2 (ssget "P" proplst)
    
16.   )
    
17.   (txt-ssdiff ss1 ss2)
    
18. )
    
19. (defun tt-ssdel-prop-or (sset proplst / ssn  ss1)
    
20.   (setq proplst (mapcar
    
21.                   (function (lambda (x)
    
22.                               (cons (car x) (strcase (cdr x)))
    
23.                             )
    
24.                   )
    
25.                   proplst
    
26.                 )
    
27.   )
    
28.   (setq ss1 sset)
    
29.   (mapcar
    
30.     (function (lambda (x)
    
31.                 (command "_.select" sset "")
    
32.                 (setq ssn (ssget "p" (list x)))
    
33.                 (setq ss1 (txt-ssdiff ss1 ssn))
    
34.               )
    
35.     )
    
36.     proplst
    
37.   )
    
38.   ss1
    
39. )
    
40.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun tt-ssdel-prop-and (sset proplst / ss1 ss2)<br />   (setq proplst (mapcar<br />                   (function (lambda (x)<br />                               (cons (car x) (strcase (cdr x)))<br />                             )<br />                   )<br />                   proplst<br />                 )<br />   )<br />   (command "_.select" sset "")<br />   (setq ss1 (ssget "p")<br />         ss2 (ssget "P" proplst)<br />   )<br />   (txt-ssdiff ss1 ss2)<br /> )<br /> (defun tt-ssdel-prop-or (sset proplst / ssn  ss1)<br />   (setq proplst (mapcar<br />                   (function (lambda (x)<br />                               (cons (car x) (strcase (cdr x)))<br />                             )<br />                   )<br />                   proplst<br />                 )<br />   )<br />   (setq ss1 sset)<br />   (mapcar<br />     (function (lambda (x)<br />                 (command "_.select" sset "")<br />                 (setq ssn (ssget "p" (list x)))<br />                 (setq ss1 (txt-ssdiff ss1 ssn))<br />               )<br />     )<br />     proplst<br />   )<br />   ss1<br /> )<br />   [/FONT]<br />

176489156

几年了 还是这么点分