如何将下面程序改了删除同心圆的大圆 留住小圆

ysq101

如何将下面程序改了删除同心圆的大圆   留住小圆
能力有限，实在读不懂了
望大师出手
国际惯例    原作者为YOYOHO

2. ;;;同心圆删除大圆保留最小的圆 O.K.
   
3. (defun c:cd (/ ss nss en ent cnt st1 st2 )
   
4. (setq ss1 (ssadd))
   
5.   (if (setq ss (ssget '((0 . "CIRCLE"))))
   
6.     (progn
   
7.       (repeat (setq nss (sslength ss))
   
8.         (setq en  (ssname ss (setq nss (1- nss)))
   
9.               ent (entget en)
   
10.               cnt (cdr (assoc 10 ent))
    
11.               r      (vl-catch-all-apply
    
12.                     '(lambda ()
    
13.                        (foreach    p st1
    
14.                          (if (equal cnt p 1e-6)
    
15.                            (exit)
    
16.                          )
    
17.                        )
    
18.                      )
    
19.                   )
    
20.         )
    
21.         (if    (not (vl-catch-all-error-p r))
    
22.                 (setq    st1 (cons cnt st1)
    
23.                 st2 (cons (cdr (assoc 10 ent)) st2))
    
24.                (PROGN
    
25.                  (ssadd en ss1)
    
26.                  (vla-Delete (vlax-ename->vla-object en))
    
27.                )
    
28.         )
    
29. 
    
30.       )
    
31.       
    
32.     )
    
33. 
    
34.   )
    
35. (alert (strcat "已删除" (rtos (- (sslength ss1) nss))"个同心圆"))
    
36. (reverse st2)
    
37. )

;;;同心圆删除大圆保留最小的圆 O.K.<br /> (defun c:cd (/ ss nss en ent cnt st1 st2 )<br /> (setq ss1 (ssadd))<br />   (if (setq ss (ssget '((0 . "CIRCLE"))))<br />     (progn<br />       (repeat (setq nss (sslength ss))<br />         (setq en  (ssname ss (setq nss (1- nss)))<br />               ent (entget en)<br />               cnt (cdr (assoc 10 ent))<br />               r      (vl-catch-all-apply<br />                     '(lambda ()<br />                        (foreach    p st1<br />                          (if (equal cnt p 1e-6)<br />                            (exit)<br />                          )<br />                        )<br />                      )<br />                   )<br />         )<br />         (if    (not (vl-catch-all-error-p r))<br />                 (setq    st1 (cons cnt st1)<br />                 st2 (cons (cdr (assoc 10 ent)) st2))<br />                (PROGN<br />                  (ssadd en ss1)<br />                  (vla-Delete (vlax-ename->vla-object en))<br />                )<br />         )<br /> <br />       )<br />       <br />     )<br /> <br />   )<br /> (alert (strcat "已删除" (rtos (- (sslength ss1) nss))"个同心圆"))<br /> (reverse st2)<br /> )

mmmmmm

(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)
        )
      )
    )
  )
)

shopping200

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 ...

非常好用。但我只需筛选出同心大圆，不删除只高亮识别出来，改怎么改呢？谢谢

ysq101

说明为   删除同心圆的大圆   留住小圆
实际刚好相反

ysq101

汗。。实测中。。。还是随机删大或删小圆的  

ysq101

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 ...

非常给力。。。可以批量。。
顶一个

ysq101

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 ...

刚优化好。。。极好的程序   
可以加个同心容差就好了。。有时会差0。02--0。05

ysq101

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 ...

解读了半天还是不得要领
为什么要用到句柄？？
具体思是怎么样的？？
大神能给讲解一下吗？

llsheng_73

ysq101 发表于 2015-1-12 14:59
说明为   删除同心圆的大圆   留住小圆
实际刚好相反

1. (defun SstoEs(ss / a en lst)
   
2.   (if ss(progn(setq a -1)
   
3.          (while(setq en(ssname ss(setq a(1+ a))))
   
4.            (setq lst(cons en lst)))))
   
5.   lst)
   
6. (defun subtotals(lst m ns / myfun a b c)
   
7.   (cond((=(type ns)'LIST)(defun myfun(x)(list(mapcar'(lambda(y)(nth y x))ns))))
   
8.        ((=(type ns)'INT)(defun myfun(x)(list(nth ns x))))
   
9.        (t(defun myfun(x)(list(vl-remove c x)))))
   
10.   (foreach x lst
    
11.     (setq a(if(setq c(nth m x)b(assoc c a))
    
12.        (subst(append b(myfun x))b a)
    
13.        (append a(list(append(list c)(myfun x))))))))
    
14. (defun c:tt()
    
15.   (foreach x(mapcar'(lambda(x)(vl-sort(cdr x)'(lambda(a b)(<(car a)(car b)))))
    
16.                    (subtotals(mapcar'(lambda(x)(setq e(entget x))(list(cdr(assoc 40 e))(cdr(assoc 10 e))x))(sstoes(ssget'((0 . "circle")))))1'nil))
    
17.     (foreach y(cdr x)
    
18.       (entdel(last y))))
    
19.   )

(defun SstoEs(ss / a en lst)<br />   (if ss(progn(setq a -1)<br />          (while(setq en(ssname ss(setq a(1+ a))))<br />            (setq lst(cons en lst)))))<br />   lst)<br /> (defun subtotals(lst m ns / myfun a b c) <br />   (cond((=(type ns)'LIST)(defun myfun(x)(list(mapcar'(lambda(y)(nth y x))ns))))<br />        ((=(type ns)'INT)(defun myfun(x)(list(nth ns x))))<br />        (t(defun myfun(x)(list(vl-remove c x)))))<br />   (foreach x lst<br />     (setq a(if(setq c(nth m x)b(assoc c a))<br />        (subst(append b(myfun x))b a)<br />        (append a(list(append(list c)(myfun x))))))))<br /> (defun c:tt()<br />   (foreach x(mapcar'(lambda(x)(vl-sort(cdr x)'(lambda(a b)(<(car a)(car b)))))<br />                    (subtotals(mapcar'(lambda(x)(setq e(entget x))(list(cdr(assoc 40 e))(cdr(assoc 10 e))x))(sstoes(ssget'((0 . "circle")))))1'nil))<br />     (foreach y(cdr x)<br />       (entdel(last y))))<br />   )

容差没加上，那个得改造分类程序subtotals
嵌套表分类统计http://bbs.mjtd.com/forum.php?mo ... 9843&fromuid=202795

ysq101

llsheng_73 发表于 2015-1-12 21:19
容差没加上，那个得改造分类程序subtotals
嵌套表分类统计http://bbs.mjtd.com/forum.php?mo ... 98 ...

这个也很好。。。网址为什么不是贴子？？是不是发错了？
有空再解读一下

ysq101

llsheng_73 发表于 2015-1-12 21:19
容差没加上，那个得改造分类程序subtotals
嵌套表分类统计http://bbs.mjtd.com/forum.php?mo ... 98 ...

哈哈。。。搜索subtotals就出来了。。。果然是网址不对