sssetfirst 筛选提取同心圆的大圆和小圆

shopping200

；；后半部分太复杂，看不太明白,这段程序是删除同心圆大圆，想用sssetfirst函数改成筛选出同心圆大圆和小圆。或者用command "chprop"  “LA” “1”     将同心圆放入某层。 (defun c:cdx ( / CNT DATA EN HDL HHH IDX II RRR SS)   (if (setq ii -1             ss (ssget '((0 . "CIRCLE，ARC")))       )     (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 2) "#" (rtos (cadr cnt) 2 2));;;X#Y       )       (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

(defun c:tt ()；这是llsheng_73的程序，可以提取同心圆，就是没有对圆心rtos偏差，怎么改呢，刚学习几天还不会改
  (setq ss (ssget '((0 . "circle"))))
  (if ss
    (progn
      (setq m (sslength ss)
            n 0
      )
      (while (< n m)
        (setq e        (ssname ss n)
              n        (1+ n)
              l        n
              p        (assoc 10 (entget e)) ;;用rtos设置容差
              P        (vl-princ-to-string (list (nth 1 p) (nth 2 p)))
              a         nil
        )
        (while (< l m)
          (setq        f  (ssname ss l)
                l  (1+ l)
                p1 (assoc 10 (entget f)) ;;用rtos设置容差
                P1 (vl-princ-to-string (list (nth 1 p1) (nth 2 p1)))
          )
          (if (= p p1)
            (progn
              (ssdel f ss)
              ;(entdel f)
              (command "layer" "m" 1 "" "change" f "" "p" "la" 1 "")
              (setq l (1- l)
                    m (1- m)
                    a t
              )
            )
          )
        )
        (if a
          (progn
            (ssdel e ss)
           ；(entdel e)
            (command "layer" "m" 1 "" "change" e "" "p" "la" 1 "")
            (setq n (1- n)
                  m (1- m)
            )
          )
        )
      )
    )
  )
)

shopping200

；已解决。
(defun c:tt ()
  (setq ss (ssget '((0 . "circle,arc"))))
  (if ss
    (progn
      (setq m (sslength ss)
            n 0
      )
      (while (< n m)
        (setq e        (ssname ss n)
              n        (1+ n)
              l        n
              p        (assoc 10 (entget e))               
              P        (vl-princ-to-string (list (nth 1 p) (nth 2 p)))
              a         nil
        )
        (while (< l m)
          (setq        f  (ssname ss l)
                l  (1+ l)
                p1 (assoc 10 (entget f))
                P1 (vl-princ-to-string (list (nth 1 p1) (nth 2 p1)))
          )
          (if (equal P P1 2) ;(< (distance P P1) 2)
            (progn
              (ssdel f ss)
              ;(entdel f)
              (command "layer" "m" 1 "" "change" f "" "p" "la" 1 "")
              (setq l (1- l)
                    m (1- m)
                    a t
              )
            )
          )
        )
        (if a
          (progn
            (ssdel e ss)
           ;(entdel e)
            (command "layer" "m" 1 "" "change" e "" "p" "la" 1 "")
            (setq n (1- n)
                  m (1- m)
            )
          )
        )
      )
    )
  )
)

香远益清

shopping200 发表于 2018-1-27 23:38
；已解决。
(defun c:tt ()
  (setq ss (ssget '((0 . "circle,arc"))))

测试好像发现问题：对于圆心测量坐标值Y增加不起作用，Y值减小起作用，同样同心圆的一个圆将其X值减小则不起作用，X值增大可以实现程序的功能。应该改为对圆心点的距离容差吧？怎么改呢？

Aa13667522125

哪位大神帮忙看看哪里不对啊 我要批量把外圆改成蓝色 内圆改成红色
(defun c:tt1 ()
  (setq ss (ssget '((0 . "circle"))))
  (if ss
    (progn
      (setq m (sslength ss)
            n 0
      )
      (while (< n m)
        (setq e        (ssname ss n)
              n        (1+ n)
              l        n
              p        (assoc 10 (entget e))
              r        (cdr (assoc 40 (entget e)))
              P        (vl-princ-to-string (list (nth 1 p) (nth 2 p)))
              a         nil
        )
        (while (< l m)
          (setq        f  (ssname ss l)
                l  (1+ l)
                p1 (assoc 10 (entget f))            
                rr  (cdr (assoc 40 (entget f)))
                P1 (vl-princ-to-string (list (nth 1 p1) (nth 2 p1)))
          )
          (if (equal P P1 20)
            (progn
              (ssdel f ss)
              (if (> r rr )
                (progn
              (command "change" f "" "p" "c" 40 "")))
              (if (< r rr )
                (progn
              (command "change" f "" "p" "c" 5 "")))
              (setq l (1- l)
                    m (1- m)
                    a t
              )
            )
          )
        )
        (if a
          (progn
            (ssdel e ss)            
              (if (> r rr )
                (progn
              (command "change" e "" "p" "c" 5 "")))
              (if (< r rr )
                (progn
              (command "change" e "" "p" "c" 40 "")))
            (setq n (1- n)
                  m (1- m)
            )
          )
        )
      )
    )
  )
)