如何按半径分类圆?

kanxiaokan

((0.5 <图元名: 7ef94388>) (0.5 <图元名: 7ef94390>) (0.5 <图元名: 7ef94398>) (0.75 <图元名: 7ef94430>) (0.75 <图元名: 7ef94438>) (0.75 <图元名: 7ef94440>))
_$
按半径分类后：

((0.5 <图元名: 7ef94398> <图元名: 7ef94390> <图元名: 7ef94388>) (0.75 <图元名: 7ef94440> <图元名: 7ef94438> <图元名: 7ef94430>))
_$


这个是我自己写的：
;**** s 为圆的选择集****(Radius::Min->Max::group s)
(defun Radius::Min->Max::group (s / i lst lst_1 lst_2 e r rr)
  (setq i 0 lst nil lst_1 nil lst_2 nil)
  (repeat (sslength s)
        (setq e (ssname s i)
              r (cdr (assoc 40 (entget e))))
        (if (setq lst (assoc r lst_1))
          (progn
          (setq rr (car lst) lst_2 (cdr lst))
          (setq lst_1 (subst (cons rr (cons e lst_2)) lst lst_1)))
          (setq lst_1 (cons (list r e) lst_1))
          )
        (setq i (1+ i))
        )
    (vl-sort lst_1 '(lambda (x y)
                  (< (car x) (car y))))
  )

当有半径0.5和0.52的的圆孔的时候如何改有容差，把0.5和0.52视为一组
最好能用Mapcar  和Lambda 改写，我学习一下，有大佬写一个函数吗？

kanxiaokan

第二次修改越改越复杂：
(defun Radius::Min->Max::group (S tol / plst rlst rrlst lst n e r)
(setq plst nil rlst nil rrlst nil lst nil)
  (repeat (setq n(sslength s))
    (setq e (ssname s (setq n (1- n))))
    (setq r (cdr (assoc 40 (entget e))))
    (setq lst (cons (list r e) lst))
    )
(while lst
      (setq r (caar lst))
      (setq plst (vl-remove-if-not '(lambda(x)(equal (car x) r tol)) lst))
      (foreach x plst
        (setq r (car x))
        (setq rlst (cons (cadr x) rlst))
        )
   (setq rlst (cons r rlst))
   (setq rrlst (cons rlst rrlst))
   (setq rlst nil)
   (setq lst (vl-remove-if '(lambda (x) (equal (car x) r tol)) lst))
   )
  (vl-sort rrlst '(lambda (x y)
                  (< (car x) (car y))))
  )

(Radius::Min->Max::group  s  tol)    S--选择集，tol--容差值

有大佬优化吗？

edata

你应该先排序,然后再分组,应该会好一些,

kanxiaokan

edata 发表于 2019-8-9 21:33
你应该先排序,然后再分组,应该会好一些,

先排序，后分类，和先分类，后排序，有什么区别吗？

言戲無軍

eq 就支持容差

wyl219

(defun c:ttt(/ ss lst_ss lst_r fuzz ci)
        (setq ss (ssget '((0 . "CIRCLE") )));构造选择集
       
        (setq lst_ss (wyl:ss2ptlist ss -1));选择集转换成图元列表
       
        (setq lst_r (list
                                                                '(0.5)
                                                                '(0.75)
                                                                '(1)
                                                        )
                lst_no nil
        );做一个变量保存完成值
        (setq fuzz 0.125);设置容差
       
        (foreach en lst_ss
                (setq ci (wyl:dxfcdr 40 en))
                (cond
                        ((equal (car (nth 0 lst_r)) ci fuzz)
                                (setq lst_r (append (list (append (car lst_r) (list en))) (cdr lst_r)))
                               
                        )
                        ((equal (car (nth 1 lst_r)) cifuzz)
                                (setq lst_r (append (car lst_r) (list (append (cadr lst_r) (list en))) (caddr lst_r)))
                               
                        )
                        ((equal (car (nth 2 lst_r)) ci fuzz)
                                (setq lst_r (append (car lst_r) (cadr lst_r) (list (append (caddr lst_r) (list en)) )))
                               
                               
                        )
                        (t (setq lst_no (append (list en ) lst_no)))
                )
               
        )
        (princ (strcat "\n分类好的圆列表如下:\n"
                                         (vl-princ-to-string lst_r )
                                         "\n未分类的圆列表如下:\n"
                                         (vl-princ-to-string lst_no )
                                 ))
)




;;选择集转为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))
        )
)

;|
dxfcar,直接返回car后的值,例如图层名等
参数：
i：编号，int
en：对象图元名或对象信息表，ename或list
返回值：对应子表包含组码值，如果错误返回对应内容,如果传入的en为nil那么返回(nil nil)
|;
(defun wyl:dxfcdr(i en / r)
        (cdr (wyl:dxf i en))
)

;|
dxf,根据组码编号及对象返回组码内容
参数：
i：编号，int
en：对象图元名或对象信息表，ename或list
返回值：对应子表包含组码值，如果错误返回对应内容,如果传入的en为nil那么返回(nil nil)
|;
(defun wyl:dxf(i en / r)
        (if en
                (progn
                        (setq r nil)
                        (if (/= "INT" (vl-prin1-to-string (type i)))
                                (setq r "确定组码为int")
                        )
                        (if (and (/= "ENAME" (vl-prin1-to-string(type en)))
                                                (/= "LIST" (vl-prin1-to-string(type en))))
                                (setq r "确定en为表或者ename")
                        )
                        (if (and
                                                (not r)
                                                (= "LIST" (vl-prin1-to-string(type en)))
                                        )
                                (if (/= nil (assoc i en))
                                        (setq r (assoc i en))
                                        (setq r "无对应组码")
                                )
                                (setq r (wyl:dxf i (entget en)))
                        )
                        r
                )
               
                '(nil nil)
        )
       
)

这个有点啰嗦,cond函数可以简化成while循环,apply跟mapcar可能用不到这里吧?

kanxiaokan

wyl219 发表于 2019-10-10 18:41
(defun c:ttt(/ ss lst_ss lst_r fuzz ci)
        (setq ss (ssget '((0 . "CIRCLE") )));构造选择集
       

非常感谢，学习了！！