求一段代码，框选几组同心圆，只留最小一个，其他删除

wgij007 · 发表于 2019-12-4 00:02:59

本帖最后由 wgij007 于 2019-12-4 00:10 编辑

如图,框选几组同心圆，第组只留最小一个，其他删除

taoyi0727 · 发表于 2019-12-4 00:03:00

(defun c:tt (/ center center-lst dxf lst name radius ss temp)
(if (setq ss (ssget '((0 . "CIRCLE"))))
(progn
(while (setq name (ssname ss 0))
(setq dxf (entget name))
(setq Center (cdr (assoc 10 dxf)))
(setq radius (cdr (assoc 40 dxf)))
(setq lst (append lst (list (list Center radius name))))
(ssdel name ss)
)
(foreach x lst
(if (not (member (car x) Center-lst))
(setq Center-lst (append Center-lst (list (car x))))
)
)
(foreach x Center-lst
(setq temp nil)
(foreach xx lst
(if (equal (car xx) x)
(setq temp (append temp (list (list (cadr xx) (caddr xx)))))
)
)
(setq temp (cdr (vl-sort temp '(lambda (a b)
   (< (car a) (car b))
   )
)
   )
)
(foreach x temp
(entdel (cadr x))
)
)
)
)
)

wyl219 · 发表于 2019-12-4 05:00:19

如果能保证圆心相同,那很好处理,否则需要设置容错值.

(defun c:ttt ( / fuzz ss lst_en y  lst_tmp y_10 lst_en wyl:ss2ptlistatlst wyl:ss2ptlist)
(setq fuzz 20);设置容错值
;;选择集转为dxf列表
;;说明:传入选择集,将对应的组码返回
;;参数:ss:选择集
;;参数:dxf:组码,例如10代表插入点,0代表对象类型,2代表对象名,8代表图层,-1是图元名
;;返回:列表
(defun wyl:ss2ptlist ( ss dxf / n i elist )
;(defun ss2ptlist ( ss / )
(setq n (if (= (type ss) 'Pickset) (sslength ss) 0)
elist '()
)
(repeat n
(setq elist (cons  (cdr (assoc dxf  (entget (ssname ss (setq n (1- n))))))  elist))
)
)
;|
选择集转为dxf列表
说明:传入选择集或图元列表,将对应的组码返回
参数:ss:选择集
参数:dxf:组码组成的列表,例如10代表插入点,0代表对象类型,2代表对象名,8代表图层,-1是图元名
可以仅为一个int,可用""代替-1即图元名.
返回:列表,每个子项的顺序和参数相同
(wyl:ss2ptlistatlst ss1 "") 返回(图元名图元名)
(wyl:ss2ptlistatlst ss1 -1) 返回(图元名图元名)
(wyl:ss2ptlistatlst ss1 8) 返回(图层图层)
(wyl:ss2ptlistatlst ss1 (-1 8)) 返回((图元名图层)(图元名图层))
(wyl:ss2ptlistatlst ss1 ("" 8)) 返回((图元名图层)(图元名图层))
新增支持传入图元列表
|;
(defun wyl:ss2ptlistatlst ( ss dxflst / n elist falg elistr )
(if (not (listp dxflst));如果不是列表,转换成列表,统一一下,其实这里统一了也没什么意义
(setq dxflst (list dxflst)))
(setq falg (length dxflst));设置一个标志,方便下面确定返回值
(setq dxflst(subst -1 "" dxflst ));把""替换成-1
(if (= (type ss) 'Pickset) ;如果传入的参数为选择集
(setq ss (wyl:ss2ptlist ss -1));把选择集转换成图元列表
)
;(setq n (if (= (type ss) 'Pickset) (sslength ss) 0))
(foreach x ss
(setq elist nil);每次循环要先把这里清0
(cond
((= 1 falg)
(setq elist (cdr (assoc (car dxflst)  (entget x))))
)
(t
(foreach y dxflst
(setq elist (append  elist (list (cdr (assoc y  (entget x))))  ))
)
)
)
(setq elistr (append (list elist) elistr))
)
)
;main
(setq ss (ssget '((0 . "CIRCLE"))))
(setq lst_en (wyl:ss2ptlistatlst ss (list -1 10 40)));返回值为((图元名坐标半径) (图元名坐标半径))
(while (> (length lst_en) 1);当只剩一个图元的时候,退出循环
(setq y (nth 0 lst_en )
lst_tmp (list y);临时列表
y_10 (cadr y);参照图元的坐标
lst_en (vl-remove y lst_en)
);获取首个图元,并将其从列表中删除
(setq x (nth 0 lst_en))
(foreach x lst_en;根据圆心分组处理
(if (<= (distance y_10 (cadr x)) fuzz);如果圆心距离不大于容错值
(setq lst_tmp (append lst_tmp (list x))
lst_en (vl-remove x lst_en)
);将x从图元列表中删除,并加入到临时列表中
));endforeach
(if (> (length lst_tmp) 1);如果有与第一个图元同心的圆
(progn
(setq lst_tmp (cdr (vl-sort lst_tmp '(lambda(x y) (< (caddr x) (caddr y))))));根据直径排序,最小的在最前被删除
(foreach x lst_tmp
(entdel (car x));删除其余的图元
)
)
);endif
);endwhile
)
(princ)

雪山飞狐_lzh · 发表于 2019-12-4 09:38:43

pycad
linq例程

@command()
def linqtest(doc):
import clr, System
clr.ImportExtensions(System.Linq)
ed = doc.Editor
res = ed.SelectAll(conv.BuildFilter((0, 'circle')))
if res.Status != aced.PromptStatus.OK:
return
ss = res.Value
with dbtrans(doc) as tr:
cirs = ss.Cast[aced.SelectedObject]().Select(lambda o: tr.getobject(o.ObjectId))
q = cirs.GroupBy(lambda c: c.Center).SelectMany(lambda cs: cs.OrderBy(lambda c: c.Radius).Skip(1))
print(q.Count())
for cir in q:
with upopen(cir):
cir.Erase()

复制代码

wgij007 · 发表于 2019-12-4 11:53:10

taoyi0727 发表于 2019-12-4 11:14
(defun c:tt (/ center center-lst dxf lst name radius ss temp)
(if (setq ss (ssget '((0 . "CIRCLE") ...

非常感谢!

xyp1964 · 发表于 2019-12-4 23:42:44

(defun c:tt () ; tt(框选几组同心圆，只留最小的一个)
(if (setq ss (ssget '((0 . "CIRCLE")))
lst (xyp-Ss2List ss)
)
(while lst
(setq pt (xyp-DXF 10 (car lst))
lst1 (vl-remove-if-not '(lambda (x) (equal (xyp-DXF 10 x) pt)) lst)
lst1 (vl-sort lst1 '(lambda (x y) (< (xyp-DXF 40 x) (xyp-DXF 40 y))))
lst (vl-remove-if '(lambda (x) (equal (xyp-DXF 10 x) pt)) lst)
)
(xyp-erase (cdr lst1))
)
)
(princ)
)

香远益清 · 发表于 2020-3-13 11:45:17

wyl219 发表于 2019-12-4 05:00
如果能保证圆心相同,那很好处理,否则需要设置容错值.

加入容错值是非常正确的思路，但该程序执行时把其他完全同心的圆也删除了结果不是如题目所要的框选圆，删除最大只留最小。把不该删的也删除了。

LYC688 · 发表于 2022-12-8 16:08:30

taoyi0727 发表于 2019-12-4 00:03
(defun c:tt (/ center center-lst dxf lst name radius ss temp)
(if (setq ss (ssget '((0 . "CIRCLE") ...

应该来个选择，比如删除大的，还是小的，更好

LYC688 · 发表于 2022-12-8 16:12:06

wyl219 发表于 2019-12-4 05:00
如果能保证圆心相同,那很好处理,否则需要设置容错值.

应该来个选择，比如删除大的，还是小的，更好

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

[提问] 求一段代码，框选几组同心圆，只留最小一个，其他删除

最佳答案