求教一个问题

前生 · 发表于 2017-6-8 13:32:53

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

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

×

如图所示意。
图纸中有很多同心圆，大大小小的。
比如：框选A里面的后，自动选择图纸中，2个同心的，且直径和A区的相同的图元。
(setq ss1 (ssget "X"
 '((-4 . "<OR")
 (-4 . "<AND")
 (0 . "CIRCLE")
 (40 . r1)
 (-4 . "AND>")
 (-4 . "<AND")
 (0 . "CIRCLE")
 (40 . r2)
 (-4 . "AND>")
 (-4 . "OR>")
 ))
 )

这样子做的话，选择的是R1,R2半径的圆、就是说，一个单独的圆半径符合的话，也选择上了。
我是做机械的，别人给的图，大大小小的同心圆，一堆一堆的，看着晕。

/db_自贡黄明儒_ · 发表于 2017-6-8 13:44:57

是不是这个意思？？？

(if (ssget '((0 . "CIRCLE")
(-4 . "<OR")
(40 . r1)
(40 . r2)
(-4 . "OR>")
)
)
(setq ss (ssget "X"
'((0 . "CIRCLE")
(-4 . "<OR")
(40 . r1)
(40 . r2)
(-4 . "OR>")
)
)
)
)

st788796 · 发表于 2017-6-8 13:45:01

同心肯定要进一步处理，选择相同半径倒是可以

(defun c:tt (/ ss sl i e el lst filter)
(if (setq ss (ssget '((0 . "circle"))))
(progn
(setq sl (sslength ss)
i 0
)
(while (setq e (ssname ss i))
(setq el (entget e)
lst (cons (assoc 40 el) lst)
i (1+ i)
)
)
(if lst
(progn
(setq filter '((-4 . "<or") (0 . "circle")))
(foreach x lst
(setq filter (cons x filter))
)
(setq filter (cons '(-4 . "or>") filter))
(if (setq s (ssget "x" (reverse filter)))
(sssetfirst nil s)
)
)
)
)
)
(princ)
)

前生 · 发表于 2017-6-8 13:47:44

/db_自贡黄明儒_ 发表于 2017-6-8 13:44

是选择同心的。
单个的不要。

前生 · 发表于 2017-6-8 13:53:55

st788796 发表于 2017-6-8 13:45

嗯。没有好的方法的话，看起来要全部重新判断了。
如果是这样的话，
1:先选同心圆.
2:求一个半径 R!即可。
3：同心圆半径列表( R1  R2 R...............)。
4：选择R1半径的圆集合---sss。
5：repeat sss ,
   看和它同心的圆有没有，没有pass,
   有的话，且半径列表均有的话，---->放到sssnew新的选择集中

麻烦

前生 · 发表于 2017-6-8 13:56:42

st788796 发表于 2017-6-8 13:45

你的程序简洁明了。好

st788796 · 发表于 2017-6-8 14:06:01

前生发表于 2017-6-8 13:56

选完了用 xd::list:groupbyindex 代码就简单了，也可以像下面这样

(defun c:tt (/ ss sl i e el lst filter pts p1 l elst s1 s)
(if (setq ss (ssget '((0 . "circle"))))
(progn
(setq i 0
slen (sslength ss)
)
(while (setq e (ssname ss i))
(setq el (entget e)
lst (cons (assoc 40 el) lst)
i (1+ i)
)
)
(if lst
(progn
(setq filter '((-4 . "<or") (0 . "circle")))
(foreach x lst
(setq filter (cons x filter))
)
(setq filter (cons '(-4 . "or>") filter))
(if (setq s (ssget "x" (reverse filter)))
(progn
(setq i 0)
(while (setq e (ssname s i))
(setq pts (cons (list (cdr (assoc 10 (entget e))) e) pts)
i (1+ i)
)
)
(setq pts (vl-sort pts
(function (lambda (x1 x2)
(if (= (caar x1) (caar x2))
(< (cadar x1) (cadar x2))
(< (caar x1) (caar x2))
)
)
)
)
)
(while pts
(setq p1 (caar pts)
l (vl-remove-if-not
(function (lambda (x) (equal (car x) p1 1e-6)))
(cdr pts)
)
)
(if (= (1+ (length l)) slen)
(progn
(setq elst (cons (cadar pts) (append (mapcar 'cadr l) elst)))
(mapcar '(lambda (x) (setq pts (vl-remove x pts))) l)
)
)
(setq pts (cdr pts))
)
(if elst
(progn
(setq s1 (ssadd))
(foreach x elst (ssadd x s1))
(sssetfirst nil s1)
)
)
)
)
)
)
)
)
(princ)
)

(defun c:tt (/ ss sl i e el lst filter pts p1 l elst s1 s) 
  (if (setq ss (ssget '((0 . "circle")))) 
    (progn 
      (setq i     0 
        slen (sslength ss) 
      ) 
      (while (setq e (ssname ss i)) 
    (setq el  (entget e) 
          lst (cons (assoc 40 el) lst) 
          i      (1+ i) 
    ) 
      ) 
      (if lst 
    (progn 
      (setq filter '((-4 . "<or") (0 . "circle"))) 
      (foreach x lst 
        (setq filter (cons x filter)) 
      ) 
      (setq filter (cons '(-4 . "or>") filter)) 
      (if (setq s (ssget "x" (reverse filter))) 
        (progn 
          (setq i 0) 
          (while (setq e (ssname s i)) 
        (setq pts (cons (list (cdr (assoc 10 (entget e))) e) pts) 
              i      (1+ i) 
        ) 
          ) 
          (setq pts    (vl-sort pts 
                 (function (lambda (x1 x2) 
                         (if (= (caar x1) (caar x2)) 
                           (< (cadar x1) (cadar x2)) 
                           (< (caar x1) (caar x2)) 
                         ) 
                       ) 
                 ) 
            ) 
          ) 
          (while pts 
        (setq p1 (caar pts) 
              l     (vl-remove-if-not 
               (function (lambda (x) (equal (car x) p1 1e-6))) 
               (cdr pts) 
             ) 
        ) 
        (if (= (1+ (length l)) slen) 
          (progn 
            (setq elst (cons (cadar pts) (append (mapcar 'cadr l) elst))) 
            (mapcar '(lambda (x) (setq pts (vl-remove x pts))) l) 
          ) 
        ) 
        (setq pts (cdr pts)) 
          ) 
          (if elst 
        (progn 
          (setq s1 (ssadd)) 
          (foreach x elst (ssadd x s1)) 
          (sssetfirst nil s1) 
        ) 
          ) 
        ) 
      ) 
    ) 
      ) 
    ) 
  ) 
  (princ) 
)

st788796 · 发表于 2017-6-8 14:13:57

本帖最后由 st788796 于 2017-6-8 14:24 编辑

使用 xd::list:groupbyindex 后面代码就简化如下

(defun c:tt (/ ss sl i e el lst filter pts p1 l elst s1 s)
(if (setq ss (ssget '((0 . "circle"))))
(progn
(setq i 0
slen (sslength ss)
)
(while (setq e (ssname ss i))
(setq el (entget e)
lst (cons (assoc 40 el) lst)
i (1+ i)
)
)
(if lst
(progn
(setq filter '((-4 . "<or") (0 . "circle")))
(foreach x lst
(setq filter (cons x filter))
)
(setq filter (cons '(-4 . "or>") filter))
(if (setq s (ssget "x" (reverse filter)))
(progn
(setq i 0)
(while (setq e (ssname s i))
(setq el (entget e)
elst (cons (list (cdr (assoc 10 el)) e) elst)
i (1+ i)
)
)
(setq elst (xd::list:groupbyindex elst 1e-6)
s1 (ssadd)
)
(foreach x elst
(if (= (length (cdr x)) slen)
(mapcar '(lambda (x) (ssadd x s1)) (cdr x))
)
)
(sssetfirst nil s1)
)
)
)
)
)
)
(princ)
)

(defun c:tt (/ ss sl i e el lst filter pts p1 l elst s1 s) 
  (if (setq ss (ssget '((0 . "circle")))) 
    (progn 
      (setq i         0 
            slen (sslength ss) 
      ) 
      (while (setq e (ssname ss i)) 
        (setq el  (entget e) 
              lst (cons (assoc 40 el) lst) 
              i          (1+ i) 
        ) 
      ) 
      (if lst 
        (progn 
          (setq filter '((-4 . "<or") (0 . "circle"))) 
          (foreach x lst 
            (setq filter (cons x filter)) 
          ) 
          (setq filter (cons '(-4 . "or>") filter)) 
          (if (setq s (ssget "x" (reverse filter))) 
            (progn 
              (setq i 0) 
              (while (setq e (ssname s i)) 
                (setq el   (entget e) 
                      elst (cons (list (cdr (assoc 10 el)) e) elst) 
                      i           (1+ i) 
                ) 
              ) 
              (setq elst (xd::list:groupbyindex elst 1e-6) 
                    s1         (ssadd) 
              ) 
              (foreach x elst 
                (if (= (length (cdr x)) slen) 
                  (mapcar '(lambda (x) (ssadd x s1)) (cdr x)) 
                ) 
              ) 
              (sssetfirst nil s1) 
            ) 
          ) 
        ) 
      )      
    ) 
  ) 
  (princ) 
)

不同写法

(defun c:tt (/ ss slen lst filter s elst s1)
(if (setq ss (ssget '((0 . "circle"))))
(progn
(setq slen (sslength ss)
lst (mapcar '(lambda (x) (assoc 40 (entget x)))
(xdrx_pickset->ents ss)
)
)
(if lst
(progn
(setq filter '((-4 . "<or") (0 . "circle")))
(foreach x lst
(setq filter (cons x filter))
)
(setq filter (cons '(-4 . "or>") filter))
(if (setq s (ssget "x" (reverse filter)))
(progn
(setq elst (mapcar '(lambda (x) (list (xdrx_getpropertyvalue x "center") x))
(xdrx_pickset->ents s)
)
elst (xd::list:groupbyindex elst 1e-6)
elst (apply 'append
(vl-remove-if-not
'(lambda (x) (= (length x) slen))
(mapcar 'cdr elst)
)
)
s1 (ssadd)
)
(foreach x elst (ssadd x s1))
(sssetfirst nil s1)
)
)
)
)
)
)
(princ)
)

(defun c:tt (/ ss slen lst filter s elst s1) 
  (if (setq ss (ssget '((0 . "circle")))) 
    (progn 
      (setq slen (sslength ss) 
            lst         (mapcar '(lambda (x) (assoc 40 (entget x))) 
                         (xdrx_pickset->ents ss) 
                 ) 
      ) 
      (if lst 
        (progn 
          (setq filter '((-4 . "<or") (0 . "circle"))) 
          (foreach x lst 
            (setq filter (cons x filter)) 
          ) 
          (setq filter (cons '(-4 . "or>") filter)) 
          (if (setq s (ssget "x" (reverse filter))) 
            (progn 
              (setq elst (mapcar '(lambda (x) (list (xdrx_getpropertyvalue x "center") x)) 
                                 (xdrx_pickset->ents s) 
                         ) 
                    elst (xd::list:groupbyindex elst 1e-6) 
                    elst (apply        'append 
                                (vl-remove-if-not 
                                  '(lambda (x) (= (length x) slen)) 
                                  (mapcar 'cdr elst) 
                                ) 
                         ) 
                    s1         (ssadd) 
              ) 
              (foreach x elst (ssadd x s1)) 
              (sssetfirst nil s1) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

前生 · 发表于 2017-6-8 15:15:38

st788796 发表于 2017-6-8 14:13

我还是自己用lsp写一个吧。谢谢!

newer · 发表于 2017-6-8 15:41:58

前生发表于 2017-6-8 15:15

有现成的，还要自己写？

xd::list:groupbyindex 搜索开源函数库论坛，纯LISP的。

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

[求助] 求教一个问题

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

浏览过的版块