通过R选择圆的例程
我们收到了另一个承包商的一些图纸,他们在发送给我们之前分解了整个图纸(谢谢)。有一堆带有内部同心圆的圆使得测试图对于这些符号来说太暗。
单个图形中有数百个分解符号。起草人希望删除内圈。
我给大家展示了QSELECT,但这对他们来说似乎太难了(对他们来说太多了)。我在谷歌上快速搜索了一下,没有找到任何现有的例程。
有没有人有一个例程可以选择用户特定半径或直径的所有圆?
谢谢
~格雷格
这应该选择直径值为100的圆。
(sssetfirst nil (ssget "_X" (list '(0 . "CIRCLE") (cons 40 100.))))
过滤掉图层名,以防有其他不想删除的圆。
(defun C:delcir (/ l e ss r)
(if
(and
(setq e (car (entsel))
l (cdr (assoc 8 (entget e)))
r(cdr (assoc 40(entget e)))
)
(setq ss (ssget "_X" (list (cons 0"CIRCLE") (cons 8 l) (cons 40 r))))
)
(command "_.erase" ss "")
)
) 谢谢你们的回复。
jdiala-这将非常适合他们的需要。
非常感谢
~格雷格 你的欢迎
请注意,如果用户未能选择对象,则会出错 我希望选定的任何一个圆都不会位于锁定层上。 还有一个选择:
(defun c:cdel ( / e i s )
(if
(and
(setq e (car (entsel "\nSelect the outermost circle: ")))
(= "CIRCLE" (cdr (assoc 0 (setq e (entget e)))))
)
(if
(setq s
(ssget "_X"
(list
'(00 . "CIRCLE")
'(-4 . "<")
(assoc 040 e)
(assoc 008 e)
(assoc 410 e)
)
)
)
(repeat (setq i (sslength s))
(entdel (ssname s (setq i (1- i))))
)
(princ "\nNo smaller circles found.")
)
)
(princ)
)
好主意jdiala
以下是另一种可能的写入方法,以避免重复选择集检索:
(defun c:DelCir (/ s ss e i)
(if (and (progn (princ "\n Select outside Circle to delete smaller")
(setq s (ssget "_+.:S:E" '((0 . "CIRCLE"))))
)
(setq ss (ssget "_X" (list '(0 . "CIRCLE") '(-4 . "<") (assoc 40 (setq e (entget (ssname s 0)))) (assoc 410 e))))
)
(repeat (setq i (sslength ss))
(vl-catch-all-apply 'entdel (list (ssname ss (setq i (1- i)))))
)
)
(princ)
)
(vl-load-com)
李代码不错。
顺便说一句,那是1e-8?
;;; jdiala 09-15-13 ;;;
(defun C:delcir (/ e l ss sss i x s1 s2)
(defun LM:Unique ( l ) ;;;Lee Mac;;;
(if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
)
(if
(and
(setq e(car (entsel))
l(cdr (assoc 8 (entget e)))
ss (ssget "_X" (list (cons 0 "CIRCLE") (cons 8 l)))
)
(= "CIRCLE" (cdr (assoc 0 (entget e))))
)
(foreach x
(LM:Unique
(repeat
(setq i (sslength ss))
(setq x (cons (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))) x))
)
)
(setq sss (ssget "_X" (list (cons 0 "CIRCLE") (cons 8 l) (cons 10 x))))
(while (> (sslength sss) 1)
(if
(<
(cdr (assoc 40 (entget (setq s1 (ssname sss 0)))))
(cdr (assoc 40 (entget (setq s2 (ssname sss 1)))))
)
(progn (ssdel s1 sss)(entdel s1))
(progn (ssdel s2 sss)(entdel s2))
)
)
)
(princ)
)
)
页:
[1]
2