如何按半径分类圆?
本帖最后由 kanxiaokan 于 2019-8-6 18:49 编辑((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 于 2019-8-6 20:57 编辑
第二次修改越改越复杂：
(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::groupstol) S--选择集，tol--容差值
有大佬优化吗？
你应该先排序,然后再分组,应该会好一些, edata 发表于 2019-8-9 21:33
你应该先排序,然后再分组,应该会好一些,
先排序，后分类，和先分类，后排序，有什么区别吗？ eq 就支持容差 (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可能用不到这里吧? wyl219 发表于 2019-10-10 18:41
(defun c:ttt(/ ss lst_ss lst_r fuzz ci)
(setq ss (ssget '((0 . "CIRCLE") )));构造选择集
非常感谢，学习了！！
页:
[1]