求孔距离小于多少删除

abc498091367 · 发表于 2013-12-2 15:02:08

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

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

×

请看此图，图内我标了2处，有距离是2.2，有距离是1.78。只求把小于2.2的距离的圆形孔都删除（圆形孔有时3个连在一起或者4个都要删除），工作有时一张图删半天，搞得眼睛花。谢谢

st788796 · 发表于 2013-12-2 15:26:02

离的近的是都删掉还是随便留一个?

st788796 · 发表于 2013-12-2 15:35:16

(defun c:tt (/ ss dis lst)
(if (and (setq ss (ssget '((0 . "Circle"))))
(setq dis (getdist "\n输入最小距离: "))
)
(progn
(setq lst (mapcar '(lambda (x)
(list (xdrx_getpropertyvalue x "center") x)
)
(xdrx_pickset->ents ss)
)
lst (vl-remove-if
'(lambda (x)
(= (length x) 2)
)
(XD::List:GroupByIndex lst dis)
)
lst (mapcar 'cdr lst)
)
(mapcar '(lambda (x)
(mapcar 'xdrx_entity_delete (cdr x));_随便保留一个
)
lst
)
)
)
(princ)
)

Free-Lancer · 发表于 2013-12-2 15:51:46

Lisp

(defun c:tt (/ ss dis lst)
(if (and (setq ss (ssget '((0 . "Circle"))))
(setq dis (getdist "\n输入最小距离: "))
)
(progn
(setq lst (mapcar '(lambda (x)
(list (cdr (assoc 10 (entget x) x)) x)
)
(ss->ents ss)
)
lst (vl-remove-if
'(lambda (x)
(= (length x) 2)
)
(XD::List:GroupByIndex lst dis)
)
lst (mapcar 'cdr lst)
)
(mapcar '(lambda (x)
(mapcar 'entdel (cdr x)) ;_随便保留一个
)
lst
)
)
)
(princ)
)
(defun ss->ents (ss / sl i el)
(setq sl (sslength ss)
i sl
)
(repeat sl
(setq el (cons (ssname ss (setq i (1- i))) el))
)
el
)
;;;---------------------------------------------------------------;
;;;功能: 对表按索引值分组 ;
;;;输入: lst ---- 表，索引值只能为 STR REAL INT LIST类型 ;
;;; fuzz -- 误差值，误差值仅对 REAL INT LIST 三种格式有效， ;
;;; 对STR 索引无效 ;
;;;输出: 表 ;
;;;---------------------------------------------------------------;
;;;Author: eachy ;
;;; From www.xdcad.net ;
(defun XD::List:GroupByIndex (lst fuzz / ll ilst l index tf)
(or
(and
(listp (caar lst))
(setq ll (list (car lst))
lst (cdr lst)
)
(while lst
(if (setq l
(apply 'append
(mapcar
'cdr
(vl-remove-if-not
'(lambda (x) (equal (car x) (caar ll) fuzz))
lst
)
)
)
)
(setq ll (cons (append (car ll) l) (cdr ll))
lst (vl-remove-if
'(lambda (x) (equal (car x) (caar ll) fuzz))
lst
)
)
)
(setq ll (cons (car lst) ll)
lst (cdr lst)
)
)
)
(and (setq index (caar lst))
(or (and (= (type index) 'INT)
(setq tf t
lst (mapcar
'(lambda (x) (cons (float (car x)) (cdr x)))
lst
)
)
)
(= (type index) 'REAL)
(= (type index) 'STR)
)
(setq
lst (vl-sort lst '(lambda (l1 l2) (< (car l1) (car l2))))
)
(mapcar '(lambda (x y / l)
(if (equal (caar ll) x fuzz)
(setq ll (cons (cons x
(if (listp y)
(append y (cdar ll))
(cons y (cdar ll))
)
)
(cdr ll)
)
)
(setq ll (cons (cons x y) ll))
)
)
(mapcar 'car lst)
(mapcar 'cdr lst)
)
(if tf
(setq ll (mapcar '(lambda (x) (cons (fix x) (cdr x))) ll))
)
)
)
(vl-remove nil ll)
)

(defun c:tt (/ ss dis lst) 
  (if (and (setq ss (ssget '((0 . "Circle")))) 
           (setq dis (getdist "\n输入最小距离: ")) 
      ) 
    (progn 
      (setq lst        (mapcar        '(lambda (x) 
                           (list (cdr (assoc 10 (entget x) x)) x) 
                         ) 
                        (ss->ents ss) 
                ) 
            lst        (vl-remove-if 
                  '(lambda (x) 
                     (= (length x) 2) 
                   ) 
                  (XD::List:GroupByIndex lst dis) 
                ) 
            lst        (mapcar 'cdr lst) 
      ) 
      (mapcar '(lambda (x) 
                 (mapcar 'entdel (cdr x)) ;_随便保留一个 
               ) 
              lst 
      ) 
    ) 
  ) 
  (princ) 
) 
(defun ss->ents        (ss / sl i el) 
  (setq        sl (sslength ss) 
        i  sl 
  ) 
  (repeat sl 
    (setq el (cons (ssname ss (setq i (1- i))) el)) 
  ) 
  el 
) 
;;;---------------------------------------------------------------; 
;;;功能: 对表按索引值分组                                         ; 
;;;输入: lst ---- 表， 索引值只能为 STR REAL INT LIST类型         ; 
;;;      fuzz -- 误差值，误差值仅对 REAL INT LIST 三种格式有效，  ; 
;;;              对STR 索引无效                                   ; 
;;;输出: 表                                                       ; 
;;;---------------------------------------------------------------; 
;;;Author: eachy                                                  ; 
;;; From <a href=\"http://www.xdcad.net\" target=\"_blank\">www.xdcad.net</a>                                            ; 
(defun XD::List:GroupByIndex (lst fuzz / ll ilst l index tf) 
  (or 
    (and 
      (listp (caar lst)) 
      (setq ll        (list (car lst)) 
            lst        (cdr lst) 
      ) 
      (while lst 
        (if (setq l 
                   (apply 'append 
                          (mapcar 
                            'cdr 
                            (vl-remove-if-not 
                              '(lambda (x) (equal (car x) (caar ll) fuzz)) 
                              lst 
                            ) 
                          ) 
                   ) 
            ) 
          (setq        ll  (cons (append (car ll) l) (cdr ll)) 
                lst (vl-remove-if 
                      '(lambda (x) (equal (car x) (caar ll) fuzz)) 
                      lst 
                    ) 
          ) 
        ) 
        (setq ll  (cons (car lst) ll) 
              lst (cdr lst) 
        ) 
      ) 
    ) 
    (and (setq index (caar lst)) 
         (or (and (= (type index) 'INT) 
                  (setq        tf  t 
                        lst (mapcar 
                              '(lambda (x) (cons (float (car x)) (cdr x))) 
                              lst 
                            ) 
                  ) 
             ) 
             (= (type index) 'REAL) 
             (= (type index) 'STR) 
         ) 
         (setq 
           lst (vl-sort lst '(lambda (l1 l2) (< (car l1) (car l2)))) 
         ) 
         (mapcar '(lambda (x y / l) 
                    (if        (equal (caar ll) x fuzz) 
                      (setq ll (cons (cons x 
                                           (if (listp y) 
                                             (append y (cdar ll)) 
                                             (cons y (cdar ll)) 
                                           ) 
                                     ) 
                                     (cdr ll) 
                               ) 
                      ) 
                      (setq ll (cons (cons x y) ll)) 
                    ) 
                  ) 
                 (mapcar 'car lst) 
                 (mapcar 'cdr lst) 
         ) 
         (if tf 
           (setq ll (mapcar '(lambda (x) (cons (fix x) (cdr x))) ll)) 
         ) 
    ) 
  ) 
  (vl-remove nil ll) 
)

newer · 发表于 2013-12-2 16:57:15

本帖最后由 newer 于 2013-12-2 16:58 编辑

命令行输入 e 回车
提示选择对象的时候输入： (ssget "x" '((0 . "CIRCLE")(-4 . "<")(40 . 2.2)))

懂一点LISP，就可以让你几秒钟完成几天的工作量。

口味虾 · 发表于 2013-12-2 18:37:13

本帖最后由口味虾于 2013-12-2 18:39 编辑

CAD用户中会编程的有1%就不错了，尽管lsp很简单，但还是那么多人是电脑小白，其实基本的功能cad都是有的，就看你会不会用了，你要的功能用快速选择功能就ok，如上图所示。

rjtiantian · 发表于 2013-12-3 08:40:21

楼主说的是孔距离小于2.2，而不是孔直径小于2.2，晕

/db_自贡黄明儒_ · 发表于 2013-12-3 09:37:33

本帖最后由 /db_自贡黄明儒_ 于 2013-12-3 09:39 编辑

;;删除小于指定间距的圆

;;删除小于指定间距的圆
(defun C:w2 (/ DIS LST SS X Y)
(defun Is-Ename (arg) (equal (type arg) 'ename))
(defun pdpx (en1 en2)
(distance (cdr (assoc 10 (entget en1))) (cdr (assoc 10 (entget en2))))
)
;;120.1 [功能] 选择集->图元列表
(defun MJ:SS->LIST (SS)
(vl-remove-if-not 'Is-Ename (mapcar 'cadr (ssnamex SS)))
)
(if (and (setq ss (ssget '((0 . "Circle"))))
(setq dis (getdist "\n输入最小距离: "))
)
(progn
(setq lst (MJ:SS->LIST ss))
(foreach x lst
(foreach y lst
(if (and (entget x) (entget y))
(if (equal x y)
nil
(if (< (pdpx x y) dis)
(progn (entdel x) (entdel Y))))))))))

abc498091367 · 发表于 2013-12-3 09:42:13

st788796 发表于 2013-12-2 15:35

选择对象:
输入最小距离: 2.2
; 错误: no function definition: XDRX_PICKSET->ENTS
命令:

只小小于2.2距离全部都删除，小于直径2.2的全部删除 QQ图片20131203094205.jpg

当然有时有2个，有时3个，4个，5个都会有小于2.2的，这些都是全部要删除，谢谢

abc498091367 · 发表于 2013-12-3 09:46:38

/db_自贡黄明儒_ 发表于 2013-12-3 09:37
;;删除小于指定间距的圆

运行W2，选择，再输入2.2回车，CAD就卡死了，麻烦修改下，谢谢111

abc498091367 · 发表于 2013-12-3 09:51:49

Free-Lancer 发表于 2013-12-2 15:51
Lisp

命令: tt
选择对象: 指定对角点: 找到 1232 个
选择对象:
输入最小距离: 2.2 ; 错误: 参数太多
命令:

参数太多，删除不了，小于直径距离2.2的全部删除，不保留1

st788796 · 发表于 2013-12-3 10:02:33

本帖最后由 st788796 于 2013-12-3 10:08 编辑

abc498091367 发表于 2013-12-3 09:51
命令: tt
选择对象: 指定对角点: 找到 1232 个
选择对象:

(list (cdr (assoc 10 (entget x) x)) x)
这句好像不对，应该为
(list (cdr (assoc 10 (entget x))) x)

全部删除后面改一句
(mapcar '(lambda (x) (mapcar 'entdel x)) lst)
去掉 cdr

abc498091367 · 发表于 2013-12-3 10:30:31

st788796 发表于 2013-12-3 10:02
(list (cdr (assoc 10 (entget x) x)) x)
这句好像不对，应该为
(list (cdr (assoc 10 (entget x)) ...

多谢，可以用了，真心谢谢

st788796 · 发表于 2013-12-3 11:30:32

abc498091367 发表于 2013-12-3 10:30
多谢，可以用了，真心谢谢

楼主，这个程序运行效果和效率如何

abc498091367 · 发表于 2013-12-3 11:32:39

st788796 发表于 2013-12-3 11:30
楼主，这个程序运行效果和效率如何

很好，我试了一个上千个圆形的，就是平时我工作的，能把小于的全删除，真心谢谢ST788796。

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

[公告] 求孔距离小于多少删除

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

点评

评分

点评

评分

评分

评分

点评

点评

点评

点评

点评

点评