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

taner · 发表于 2007-12-26 13:57:31

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

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

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

Free-Lancer · 发表于 2008-1-1 07:16:41

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

taner · 发表于 2008-1-2 11:17:42

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

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

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

176489156 · 发表于 2009-10-8 17:25:49

几年了还是这么点分

账号		自动登录	找回密码
密码			立即注册

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

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子