如何将下面程序改了删除同心圆的大圆 留住小圆
如何将下面程序改了删除同心圆的大圆 留住小圆能力有限，实在读不懂了
望大师出手
国际惯例 原作者为YOYOHO;;;同心圆删除大圆保留最小的圆 O.K.
(defun c:cd (/ ss nss en ent cnt st1 st2 )
(setq ss1 (ssadd))
(if (setq ss (ssget '((0 . "CIRCLE"))))
(progn
(repeat (setq nss (sslength ss))
(setq en(ssname ss (setq nss (1- nss)))
ent (entget en)
cnt (cdr (assoc 10 ent))
r (vl-catch-all-apply
'(lambda ()
(foreach p st1
(if (equal cnt p 1e-6)
(exit)
)
)
)
)
)
(if (not (vl-catch-all-error-p r))
(setq st1 (cons cnt st1)
st2 (cons (cdr (assoc 10 ent)) st2))
(PROGN
(ssadd en ss1)
(vla-Delete (vlax-ename->vla-object en))
)
)
)
)
)
(alert (strcat "已删除" (rtos (- (sslength ss1) nss))"个同心圆"))
(reverse st2)
) (defun c:cdx ( / CNT DATA EN HDL HHH IDX II RRR SS)
(if (setq ii -1
ss (ssget '((0 . "CIRCLE")))
)
(repeat (sslength ss)
(setq en (ssname ss (setq ii (1+ ii)))
hdl (cdr (assoc 5 (entget en)))
cnt (cdr (assoc 10 (entget en)))
rrr (cdr (assoc 40 (entget en)))
idx (strcat (rtos (car cnt) 2 3) "#" (rtos (cadr cnt) 2 3))
)
(if (null (setq hhh (cdr (assoc idx data))))
(setq data (cons (cons idx hdl) data))
(if (> (cdr (assoc 40 (entget (handent hhh))))
rrr
)
(setq hhh(entdel (handent hhh))
data (subst (cons idx hdl) (assoc idx data) data)
)
(entdel en)
)
)
)
)
) mmmmmm 发表于 2015-1-12 16:27
(defun c:cdx ( / CNT DATA EN HDL HHH IDX II RRR SS)
(if (setq ii -1
ss (ssget '((0 . "CIRCL ...
非常好用。但我只需筛选出同心大圆，不删除只高亮识别出来，改怎么改呢？谢谢 说明为 删除同心圆的大圆 留住小圆
实际刚好相反 汗。。实测中。。。还是随机删大或删小圆的 mmmmmm 发表于 2015-1-12 16:27 static/image/common/back.gif
(defun c:cdx ( / CNT DATA EN HDL HHH IDX II RRR SS)
(if (setq ii -1
ss (ssget '((0 . "CIRCL ...
非常给力。。。可以批量。。
顶一个 mmmmmm 发表于 2015-1-12 16:27 static/image/common/back.gif
(defun c:cdx ( / CNT DATA EN HDL HHH IDX II RRR SS)
(if (setq ii -1
ss (ssget '((0 . "CIRCL ...
刚优化好。。。极好的程序
可以加个同心容差就好了。。有时会差0。02--0。05 mmmmmm 发表于 2015-1-12 16:27 static/image/common/back.gif
(defun c:cdx ( / CNT DATA EN HDL HHH IDX II RRR SS)
(if (setq ii -1
ss (ssget '((0 . "CIRCL ...
解读了半天还是不得要领
为什么要用到句柄？？
具体思是怎么样的？？
大神能给讲解一下吗？ 本帖最后由 llsheng_73 于 2015-1-12 21:28 编辑
ysq101 发表于 2015-1-12 14:59 http://bbs.mjtd.com/static/image/common/back.gif
说明为 删除同心圆的大圆 留住小圆
实际刚好相反
(defun SstoEs(ss / a en lst)
(if ss(progn(setq a -1)
(while(setq en(ssname ss(setq a(1+ a))))
(setq lst(cons en lst)))))
lst)
(defun subtotals(lst m ns / myfun a b c)
(cond((=(type ns)'LIST)(defun myfun(x)(list(mapcar'(lambda(y)(nth y x))ns))))
((=(type ns)'INT)(defun myfun(x)(list(nth ns x))))
(t(defun myfun(x)(list(vl-remove c x)))))
(foreach x lst
(setq a(if(setq c(nth m x)b(assoc c a))
(subst(append b(myfun x))b a)
(append a(list(append(list c)(myfun x))))))))
(defun c:tt()
(foreach x(mapcar'(lambda(x)(vl-sort(cdr x)'(lambda(a b)(<(car a)(car b)))))
(subtotals(mapcar'(lambda(x)(setq e(entget x))(list(cdr(assoc 40 e))(cdr(assoc 10 e))x))(sstoes(ssget'((0 . "circle")))))1'nil))
(foreach y(cdr x)
(entdel(last y))))
)
容差没加上，那个得改造分类程序subtotals
嵌套表分类统计http://bbs.mjtd.com/forum.php?mo ... 9843&fromuid=202795
llsheng_73 发表于 2015-1-12 21:19 static/image/common/back.gif
容差没加上，那个得改造分类程序subtotals
嵌套表分类统计http://bbs.mjtd.com/forum.php?mo ... 98 ...
这个也很好。。。网址为什么不是贴子？？是不是发错了？
有空再解读一下 llsheng_73 发表于 2015-1-12 21:19 static/image/common/back.gif
容差没加上，那个得改造分类程序subtotals
嵌套表分类统计http://bbs.mjtd.com/forum.php?mo ... 98 ...
哈哈。。。搜索subtotals就出来了。。。果然是网址不对
页:
[1]
2