过淲同心

lshj1993 · 发表于 2014-12-23 11:48:30

支持一下、顶帖顶帖

amwkto2011 · 发表于 2014-12-23 11:55:38

st788796 发表于 2014-12-23 11:41
只是给你说明个方法
1 cad 是最小圆,cadr 是最大圆

一下理解不了，你这方法
我还需再努力学下
不用XD的函数，用什么方法，取到最小，还有最大
直线暂是不管了。。

st788796 · 发表于 2014-12-23 12:36:45

本帖最后由 st788796 于 2014-12-23 13:11 编辑

amwkto2011 发表于 2014-12-23 11:55
一下理解不了，你这方法
我还需再努力学下
不用XD的函数，用什么方法，取到最小，还有最大

xd::list:groupbyindex是通用函数，有源码，构造lijiao已经给了遍历 entget assoc ，分组，最后排序

(defun c:tt (/ ss lst)
(if (setq ss (ssget '((0 . "circle,line"))))
(progn
(setq lst
(mapcar
'(lambda (x)
(setq typ (xdrx_getpropertyvalue x))
(if (= typ "AcDbLine")
(reverse
(cons
x
(xdrx_getpropertyvalue x "startpoint" "midpoint")
)
) ;_直线 (中点 0.0 直线)
(reverse
(cons x
(xdrx_getpropertyvalue x "radius" "center")
)
) ;_圆 (圆心半径圆)
)
)
(xdrx_pickset->ents ss)
)
lst (cdr (xd::list:groupbyindex lst 1e-6)) ;_区分同心
lst (vl-remove-if
'(lambda (x)
(or
(= (length x) 2) ;_单个圆
(= (length (vl-remove-if
'(lambda (a)
(zerop (cadr a))
) ;_去掉直线只有一个圆
x
)
)
1
)
)
)
lst
) ;_单个的剔除
lst (mapcar 'cdr lst);_(((r1 e1) (r2 e2) ...) (...) (...))
lst (mapcar
'(lambda (x)
(vl-sort x '(lambda (x1 x2) (< (car x1) (car x2))))
)
lst
)
;;同一组内再将直线和圆区分出来
)
)
)
(princ)
)

(defun c:tt (/ ss lst) 
  (if (setq ss (ssget '((0 . "circle,line")))) 
    (progn 
      (setq lst 
                (mapcar 
                  '(lambda (x) 
                     (setq typ (xdrx_getpropertyvalue x)) 
                     (if (= typ "AcDbLine") 
                       (reverse 
                         (cons 
                           x 
                           (xdrx_getpropertyvalue x "startpoint" "midpoint") 
                         ) 
                       ) ;_直线 (中点 0.0 直线) 
                       (reverse 
                         (cons x 
                               (xdrx_getpropertyvalue x "radius" "center") 
                         ) 
                       ) ;_圆 (圆心 半径 圆) 
                     ) 
                   ) 
                  (xdrx_pickset->ents ss) 
                ) 
            lst        (cdr (xd::list:groupbyindex lst 1e-6)) ;_区分同心 
            lst        (vl-remove-if 
                  '(lambda (x) 
                     (or 
                       (= (length x) 2) ;_单个圆 
                       (= (length (vl-remove-if 
                                    '(lambda (a) 
                                       (zerop (cadr a)) 
                                     ) ;_去掉直线只有一个圆 
                                    x 
                                  ) 
                          ) 
                          1 
                       ) 
                     ) 
                   ) 
                  lst 
                ) ;_单个的剔除 
            lst        (mapcar 'cdr lst);_(((r1 e1)  (r2 e2) ...) (...) (...)) 
            lst        (mapcar 
                  '(lambda (x) 
                     (vl-sort x '(lambda (x1 x2) (< (car x1) (car x2)))) 
                   ) 
                  lst 
                ) 
           ;;同一组内再将直线和圆区分出来 
      ) 
    ) 
  ) 
  (princ) 
)

lijiao · 发表于 2014-12-23 15:06:10

(defun cs-remove-same (lst / ITEM OUT X)
(setq out '())
(while lst
(setq item (car lst))
(setq out (cons item out))
(setq lst (vl-remove nil
(mapcar '(lambda (x)
(if (not (equal item x 0.0001))
x
)
)
lst
)
)
)
)
(reverse out)
)
(defun cs-fenzu (lst / CS_KEY ITEM OUT SUB_LIST)
(setq out '()
keylist (cs-remove-same (mapcar 'car lst))
)
(foreach item keylist
(setq sub_list (vl-remove nil
(mapcar '(lambda (x)
(if (equal (car x) item 0.001)
(cdr x)
)
)
lst
)
)
)
(setq out (cons (cons item sub_list) out))
)
(reverse out)
)
(defun get-c (ss key / DATA ELST ENTS LEN X Y Z)
(repeat (setq len (sslength ss))
(setq ents (cons (ssname ss (setq len (1- len))) ents))
)
(setq data (mapcar '(lambda(x)
(setq elst (entget x))
(mapcar '(lambda(y)
(cdr (assoc y elst)))
'(10 40 -1))
)
ents)
)
(setq data (cs-fenzu data))
(setq data (mapcar 'cdr data))
(setq data (mapcar '(lambda (z)
(if (> (length z) 1)
(mapcar 'cadr (vl-sort z
'(lambda (x y)
(< (car x) (car y))
)
))
(cdr (car z))
)
)
data
)
)
(cond
((= key 'max) (mapcar 'last data))
((= key 'min) (mapcar 'car data))
((= key 'cen) (vl-remove nil (mapcar '(lambda(x)
(if (> (length x) 1)
x)
)
data)))
)
)

(defun cs-remove-same (lst / ITEM OUT X) 
  (setq out '()) 
  (while lst 
    (setq item (car lst)) 
    (setq out (cons item out)) 
    (setq lst (vl-remove nil 
                         (mapcar '(lambda (x) 
                                    (if        (not (equal item x 0.0001)) 
                                      x 
                                    ) 
                                  ) 
                                 lst 
                         ) 
              ) 
    ) 
  ) 
  (reverse out) 
) 
(defun cs-fenzu        (lst / CS_KEY ITEM OUT SUB_LIST) 
  (setq        out        '() 
        keylist        (cs-remove-same (mapcar 'car lst)) 
  ) 
  (foreach item        keylist 
    (setq sub_list (vl-remove nil 
                              (mapcar '(lambda (x) 
                                         (if (equal (car x) item 0.001) 
                                           (cdr x) 
                                         ) 
                                       ) 
                                      lst 
                              ) 
                   ) 
    ) 
    (setq out (cons (cons item sub_list) out)) 
  ) 
  (reverse out) 
) 
 
(defun get-c (ss key / DATA ELST ENTS LEN X Y Z) 
  (repeat (setq len (sslength ss)) 
    (setq ents (cons (ssname ss (setq len (1- len))) ents)) 
    ) 
  (setq data (mapcar '(lambda(x) 
                        (setq elst (entget x)) 
                        (mapcar '(lambda(y) 
                                   (cdr (assoc y elst))) 
                                '(10 40 -1)) 
                        ) 
                     ents) 
        ) 
  (setq data (cs-fenzu data)) 
  (setq data (mapcar 'cdr data)) 
  (setq        data (mapcar '(lambda (z) 
                        (if (> (length z) 1) 
                          (mapcar 'cadr (vl-sort z 
                                   '(lambda (x y) 
                                      (< (car x) (car y)) 
                                    ) 
                          )) 
                          (cdr (car z)) 
                        ) 
                      ) 
                     data 
             ) 
  ) 
  (cond 
    ((= key 'max) (mapcar 'last data)) 
    ((= key 'min) (mapcar 'car data)) 
    ((= key 'cen) (vl-remove nil (mapcar '(lambda(x) 
                                            (if (> (length x) 1) 
                                              x) 
                                            ) 
                                         data))) 
    ) 
  )

给你几个函数

_$ (setq ss (ssget))
<Selection set: 34b>
_$ (get-c ss 'max)
(<图元名: 7ff6b941aa50> <图元名: 7ff6b941a470> <图元名: 7ff6b941a490>)
_$ (get-c ss 'min)
(<图元名: 7ff6b941a450> <图元名: 7ff6b941a4b0> <图元名: 7ff6b941a490>)
_$ (get-c ss 'cen)
((<图元名: 7ff6b941a450> <图元名: 7ff6b941a430> <图元名: 7ff6b941aa30> <图元名: 7ff6b941aa50>) (<图元名: 7ff6b941a4b0> <图元名: 7ff6b941a470>))
_$
余下的事情自己搞定

amwkto2011 · 发表于 2014-12-23 16:54:27

lijiao 发表于 2014-12-23 15:06
给你几个函数

_$ (setq ss (ssget))

谢谢哦，好多函数我还不会，要查帮助去。

amwkto2011 · 发表于 2014-12-23 16:55:46

st788796 发表于 2014-12-23 12:36
xd::list:groupbyindex是通用函数，有源码，构造lijiao已经给了遍历 entget assoc ，分组，最后排序

遍历 entget assoc
这个（遍历）是什么意思啊，能详细点不，只听高手经常这样说，遍历

xvjiex · 发表于 2021-8-2 00:02:31

感谢楼主分享过淲同心

账号		自动登录	找回密码
密码			立即注册

[每日一码] 过淲同心

点评

点评