求删除相邻块之间插入点距离小于300的右边的块参照

清风明月10

求删除相邻块之间插入点距离小于300的右边的块参照
图上有一行块参照（只有一行），有些块是重叠了半个块的，即它们的插入点之间的距离小于300（块的长度是500）
我的要求就是先将选定的块从左到右排序，再将相邻块之间插

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:求删除相邻块之间插入点距离小于300的右边的块参照.rar 
下载次数:2  文件大小:45.12 KB 
下载权限: 不限 以上  [免费赚D豆]

入点距离小于300的右侧那个块删除。最后得到的块参照，相邻块插入点的距离大于300。



只针对名为"A3横打印框"的块参照

st788796

1. (defun c:tt (/ ss el e1 e2)
   
2.   (if (setq ss (ssget '((0 . "insert"))))
   
3.     (progn
   
4.       (setq el (mapcar '(lambda        (x)
   
5.                           (list        (xdrx_getpropertyvalue x "Position")
   
6.                                 x
   
7.                           )
   
8.                         )
   
9.                        (xdrx_pickset->ents ss)
   
10.                )
    
11.             el (vl-sort        el
    
12.                         '(lambda (e1 e2)
    
13.                            (< (caar e1) (caar e2))
    
14.                          )
    
15.                )
    
16.       )
    
17.       (while el
    
18.         (setq e1 (car el)
    
19.               e2 (cadr el)
    
20.         )
    
21.         (if (< (abs (- (caar e2) (caar e1))) 300)
    
22.           (progn
    
23.             (entdel (cadr e2))
    
24.             (setq el (cdr el))
    
25.           )
    
26.           (setq el (cdr el))
    
27.         )
    
28.       )
    
29.     )
    
30.   )
    
31.   (princ)
    
32. )

(defun c:tt (/ ss el e1 e2)<br />   (if (setq ss (ssget '((0 . "insert"))))<br />     (progn<br />       (setq el (mapcar '(lambda        (x)<br />                           (list        (xdrx_getpropertyvalue x "Position")<br />                                 x<br />                           )<br />                         )<br />                        (xdrx_pickset->ents ss)<br />                )<br />             el (vl-sort        el<br />                         '(lambda (e1 e2)<br />                            (< (caar e1) (caar e2))<br />                          )<br />                )<br />       )<br />       (while el<br />         (setq e1 (car el)<br />               e2 (cadr el)<br />         )<br />         (if (< (abs (- (caar e2) (caar e1))) 300)<br />           (progn<br />             (entdel (cadr e2))<br />             (setq el (cdr el))<br />           )<br />           (setq el (cdr el))<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

st788796

用xd:: list: tablesort 排行列，用xd:: list: groupbyindex分组

清风明月10

st788796 发表于 2014-2-4 07:18

我在你的基础上改了一点点，代码如下：
(defun c:tt (/ ss el e1 e2)
  (if (setq ss (ssget '((0 . "insert"))))
    (progn
      (setq el (mapcar '(lambda        (x)
                          (list        (xdrx_getpropertyvalue x "Position")
                                x
                          )
                        )
                       (xdrx_pickset->ents ss)
               )
            el (vl-sort        el
                        '(lambda (e1 e2)
                           (< (caar e1) (caar e2))
                         )
               )
      )
      (while el
        (setq e1 (car el)
              e2 (cadr el)
        )
        (if (< (abs (- (caar e2) (caar e1))) 300)
          (progn
            (entdel (cadr e2))
            (setq el (cDdr el))
          )
          (setq el (cdr el))
        )
      )
    )
  )
  (princ)
)

但还有一个问题，就是如果有两个或两个以上的块和第1个块在距离300以内，上面的代码就是错的，请指点

清风明月10

(defun c:tt (/ ss EL e1 e2)
;;;来源：4楼 【新提醒】晓东CAD家园-论坛-技术问答【悬赏求助】-求删除相邻块之间插入点距离小于300的右边的块参照 - Powered by Discuz!
;;;http://www.xdcad.net/forum/forum ... 1&extra=#pid3505549
;;;就是如果有两个或两个以上的块和第1个块在距离300以内，也可以正确运行
  (if (setq ss (ssget '((0 . "insert"))))
    (progn
      (setq EL (mapcar '(lambda        (x)
                          (list        (xdrx_getpropertyvalue x "Position")
                                x
                          )
                        )
                       (xdrx_pickset->ents ss)
               )
            EL (vl-sort        EL
                        '(lambda (e1 e2)
                           (< (caar e1) (caar e2))
                         )
               )
      )
      (while EL
        (setq e1 (car EL)
              e2 (cadr EL)
        )
        (if (< (abs (- (caar e2) (caar e1))) 300)
          (progn
            (entdel (cadr e2))
            (setq EL(vl-remove e2 EL))
                        ; (setq EL (cDdr EL))
          )
          (setq EL (cdr EL))
        )
      )
    )
  )
  (princ))

st788796

里面应该也用while