过淲同心

amwkto2011 · 发表于 2014-12-23 09:12:24

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;去除单独的表，保留相同的表
;函数来自晓东网友 txc6853234 再次感谢谢各位st788796 newer lijiao等
(defun getsameatom_list( oldlist / old2list n a newlist)
(setq old2list (cdr oldlist))
(foreach n oldlist
(progn
(foreach a old2list
(if (equal n a) (progn(setq newlist (cons n newlist))
(setq newlist (cons n newlist))))
)
(setq old2list(cdr old2list))
)
)
(setq newlist(reverse newlist))
)
;*********以下为过淲同心主程序
(defun c:tt(/ get len nn ns add pt pt2 to)
(setq get (ssget '((0 . "CIRCLE"))))
(setq len (sslength get))
(repeat len
(setq nn (ssname get (setq len (1- len))))
(setq ns (cons nn ns))
);re
(setq add (ssadd))
(setq pt (getsameatom_list (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) ns)))
(foreach to ns
(setq pt2 (cdr (assoc 10 (entget to))))
(if (member pt2 pt)
(ssadd to add)
)
)
(sssetfirst nil add)
(princ)
)
;求优化下，把同心里面的直线也一起选到，再增加同心最小圆，与同心最大圆，还要加个同心误差值就完美

;去除单独的表，保留相同的表 
;函数来自 晓东网友 txc6853234 再次感谢谢各位st788796 newer lijiao等 
(defun getsameatom_list( oldlist /  old2list n a newlist) 
  (setq old2list (cdr oldlist)) 
  (foreach n oldlist 
    (progn 
      (foreach a old2list 
        (if (equal n a) (progn(setq newlist (cons n newlist)) 
                        (setq newlist (cons n newlist)))) 
        ) 
      (setq old2list(cdr old2list)) 
      ) 
    )    
  (setq newlist(reverse newlist)) 
  ) 
;*********以下为过淲同心主程序 
(defun c:tt(/ get len nn ns add pt pt2 to) 
(setq get (ssget '((0 . "CIRCLE")))) 
(setq len (sslength get)) 
(repeat len 
  (setq nn (ssname get (setq len (1- len)))) 
  (setq ns (cons nn ns)) 
  );re 
  (setq add (ssadd)) 
  (setq pt (getsameatom_list (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) ns))) 
  (foreach to ns 
    (setq pt2 (cdr (assoc 10 (entget to)))) 
    (if  (member pt2 pt) 
      (ssadd to add) 
    ) 
  ) 
  (sssetfirst nil add) 
  (princ) 
) 
;求优化下，把同心里面的直线也一起选到，再增加同心最小圆，与同心最大圆，还要加个同心误差值就完美

炫翔 · 发表于 2014-12-23 09:22:23

等分圆获取点表用ssget WP PTS

st788796 · 发表于 2014-12-23 09:30:50

早就讨论过,有代码的

(defun c:tt (/ ss el)
(if
(and (setq ss (ssget '((0 . "circle"))))
(setq
el (mapcar
'cdr
(vl-remove-if
'(lambda (x) (= (length x) 2))
(cdr (xd::list:groupbyindex
(mapcar
'(lambda (x)
(list (xdrx_getpropertyvalue x "center") x)
)
(xdrx_pickset->ents ss)
)
1e-6
)
)
)
)
)
)
(sssetfirst nil (xd::entity->pickset (apply 'append el)))
)
(princ)
)

amwkto2011 · 发表于 2014-12-23 09:38:14

st788796 发表于 2014-12-23 09:30
早就讨论过,有代码的

缺函数XDRX_PICKSET->ENTS

amwkto2011 · 发表于 2014-12-23 09:40:33

炫翔发表于 2014-12-23 09:22
等分圆获取点表用ssget WP PTS

{:soso_e100:}老大出手优化下啊，源码才能让大伙学习进步啊

newer · 发表于 2014-12-23 09:57:22

amwkto2011 发表于 2014-12-23 09:38
缺函数XDRX_PICKSET->ENTS

加载XDRX_API

多看看 xd::list:groupbyindex 源代码，这个是通用的分组包装函数，有特征值的，你过滤什么都行，过滤同层，同色，同起点，同面积，。。。。

newer · 发表于 2014-12-23 09:59:50

amwkto2011 发表于 2014-12-23 09:40
老大出手优化下啊，源码才能让大伙学习进步啊

你把上面ST代码里面的 “CENTER” 换成 "AREA" 就是过滤同面积的，换成 “LENGTH"，就是过滤出同周长的，换成 ”COLOR"，就是过滤出同颜色的，换成"LINETYPE"就是过滤通过线型的。。。。

lijiao · 发表于 2014-12-23 10:07:40

(defun c:tt (/ ADD GET LEN NN NS)
(setq get (ssget ":S" '((0 . "CIRCLE"))))
(repeat (setq len (sslength get))
(setq nn (ssname get (setq len (1- len))))
(setq ns (cons (list (cdr (assoc 10 (entget nn))) nn) ns))
)
(setq add (ssadd))
(foreach to ns
(setq nn (cadr to)
to (car to)
)
(if (assoc to (vl-remove (assoc to ns) ns))
(ssadd nn add)
)
)
(sssetfirst nil add)
(princ)
)

amwkto2011 · 发表于 2014-12-23 10:11:36

lijiao 发表于 2014-12-23 10:07

可以如此精简，连前面的函数都没用了{:soso_e179:}
选同心最小圆，还有最大圆

amwkto2011 · 发表于 2014-12-23 10:14:22

newer 发表于 2014-12-23 09:57
加载XDRX_API

多看看 xd::list:groupbyindex 源代码，这个是通用的分组包装函数，有特征值的，你过滤 ...

弱弱的问一句，XD函数源代码在哪，给个连接好不

amwkto2011 · 发表于 2014-12-23 10:17:31

lijiao 发表于 2014-12-23 10:07

求优化下，把同心里面的直线也一起选到，再增加同心最小圆，与同心最大圆，还要加个同心误差值就完美

newer · 发表于 2014-12-23 10:23:50

amwkto2011 发表于 2014-12-23 10:14
弱弱的问一句，XD函数源代码在哪，给个连接好不

开源函数库论坛。http://bbs.xdcad.net/forum-260-1.html
多看看函数库论坛的源代码，对你肯定有帮助。

找哪个函数，用搜索。

QQ截图20141223102255.png

st788796 · 发表于 2014-12-23 10:54:15

本帖最后由 st788796 于 2014-12-23 10:56 编辑

amwkto2011 发表于 2014-12-23 10:17
求优化下，把同心里面的直线也一起选到，再增加同心最小圆，与同心最大圆，还要加个同心误差值就完美

过滤同心园的最大和最小园

(defun c:tt (/ ss el)
(if
(and (setq ss (ssget '((0 . "circle"))))
(setq
el
(mapcar
'cdr
(vl-remove-if
'(lambda (x) (= (length x) 2))
(cdr
(xd::list:groupbyindex
(mapcar
'(lambda (x)
(reverse
(cons
x
(xdrx_getpropertyvalue x "radius" "center")
)
)
)
(xdrx_pickset->ents ss)
)
1e-6
)
)
)
)
)
)
(progn
(setq el (mapcar '(lambda (x / l)
(if (> (length x) 2)
(progn
(setq
l (vl-sort x
'(lambda (x1 x2)
(< (car x1) (car x2))
)
)
)
(list (cadar l) (cadr (last l)))
)
(mapcar 'cadr x)
)
)
el
)
)
(sssetfirst nil (xd::entity->pickset (apply 'append el)))
)
)
(princ)
)

(defun c:tt (/ ss el) 
  (if 
    (and (setq ss (ssget '((0 . "circle")))) 
         (setq 
           el 
            (mapcar 
              'cdr 
              (vl-remove-if 
                '(lambda (x) (= (length x) 2)) 
                (cdr 
                  (xd::list:groupbyindex 
                    (mapcar 
                      '(lambda (x) 
                         (reverse 
                           (cons 
                             x 
                             (xdrx_getpropertyvalue x "radius" "center") 
                           ) 
                         ) 
                       ) 
                      (xdrx_pickset->ents ss) 
                    ) 
                    1e-6 
                  ) 
                ) 
              ) 
            ) 
         ) 
    ) 
     (progn 
       (setq el        (mapcar        '(lambda (x / l) 
                           (if (> (length x) 2) 
                             (progn 
                               (setq 
                                 l (vl-sort x 
                                            '(lambda (x1 x2) 
                                               (< (car x1) (car x2)) 
                                             ) 
                                   ) 
                               ) 
                               (list (cadar l) (cadr (last l))) 
                             ) 
                             (mapcar 'cadr x) 
                           ) 
                         ) 
                        el 
                ) 
       ) 
       (sssetfirst nil (xd::entity->pickset (apply 'append el))) 
     ) 
  ) 
  (princ) 
)

amwkto2011 · 发表于 2014-12-23 11:30:47

st788796 发表于 2014-12-23 10:54
过滤同心园的最大和最小园

不是同时选到最大，与最小
是两个功能，一个选最大的，一个选最小的，还有一个同心的
同心要设个容差
过滤同心的时候，里面的直线有没有办法选到？

也就是这样的
请选择过滤方法 (A--同心 B--同心最大 C--同心最小)
也可以说是3个功能吧，一个命令执行，共同点都是要同心

st788796 · 发表于 2014-12-23 11:41:01

amwkto2011 发表于 2014-12-23 11:30
不是同时选到最大，与最小
是两个功能，一个选最大的，一个选最小的，还有一个同心的
同心要设个容差

只是给你说明个方法
1 cad 是最小圆,cadr 是最大圆

2 直线中心和圆重合的话, 直线构造 (中点 0.0 entity) 索引后分组

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

[每日一码] 过淲同心

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

相关帖子

点评

点评

点评

点评

点评

点评