图块重叠检查

77077

我也来个重叠检查，欢迎提意见~~~~

2. ;货物分两组（样品 . 库存）
   
3. (defun lst->2lst(lst / lst1 lst2)
   
4.   (setq lst1 '() lst2 '())
   
5. (foreach a lst
   
6.     (if (member a lst2)
   
7.       (setq lst1 (cons a lst1))
   
8.       (setq lst2 (cons a lst2))
   
9.     )
   
10.   )
    
11. (cons (reverse lst2) (reverse lst1))
    
12. )

;货物分两组（样品 . 库存）<br /> (defun lst->2lst(lst / lst1 lst2)<br />   (setq lst1 '() lst2 '())<br /> (foreach a lst<br />     (if (member a lst2)<br />       (setq lst1 (cons a lst1))<br />       (setq lst2 (cons a lst2))<br />     )<br />   )<br /> (cons (reverse lst2) (reverse lst1))<br /> )

2. ;检查重叠块
   
3. (defun c:chk_blocks (/ ss entlst ptlst 2ptlst x pt)
   
4.   (setq ss (ssget '((0 . "insert")));若要检查其他图元类型，修改这里
   
5.        i  0
   
6.        )
   
7.   (if (and ss (> (sslength ss) 2))
   
8.    (progn
   
9.     (setq entlst (zml-ss->enlist ss)
   
10.           ptlst (mapcar '(lambda(x) (assoc 10(entget x))) entlst)
    
11.           2ptlst (lst->2lst ptlst)
    
12.           )
    
13.      (if (setq 2ptlst (cdr 2ptlst))
    
14.        (progn
    
15.          (setq pt (getpoint (strcat "\n  找到" (itoa (length 2ptlst)) "个重叠块，选择引出标注点：")))
    
16.          (foreach x 2ptlst
    
17.            (entmake (list '(0 . "line") '(8 . "0-辅助层tem") (cons 62 1) x (cons 11 pt)))
    
18.            )
    
19.            (princ "\n 标注完成，为避免出错，请老大落实后再枪决！")
    
20.          )
    
21.          (alert "报告老大，没有找到重叠块！")
    
22.      )
    
23.     )
    
24.     (alert "老大，这么简单的问题自己解决！")
    
25.    )
    
26.    (princ)
    
27. )

;检查重叠块<br /> (defun c:chk_blocks (/ ss entlst ptlst 2ptlst x pt)<br />   (setq ss (ssget '((0 . "insert")));若要检查其他图元类型，修改这里<br />        i  0<br />        )<br />   (if (and ss (> (sslength ss) 2))<br />    (progn<br />     (setq entlst (zml-ss->enlist ss)<br />           ptlst (mapcar '(lambda(x) (assoc 10(entget x))) entlst)<br />           2ptlst (lst->2lst ptlst)<br />           )<br />      (if (setq 2ptlst (cdr 2ptlst))<br />        (progn<br />          (setq pt (getpoint (strcat "\n  找到" (itoa (length 2ptlst)) "个重叠块，选择引出标注点：")))<br />          (foreach x 2ptlst<br />            (entmake (list '(0 . "line") '(8 . "0-辅助层tem") (cons 62 1) x (cons 11 pt)))<br />            )<br />            (princ "\n 标注完成，为避免出错，请老大落实后再枪决！")<br />          )<br />          (alert "报告老大，没有找到重叠块！")<br />      )<br />     )<br />     (alert "老大，这么简单的问题自己解决！")<br />    )<br />    (princ)<br /> )

SunSpring

少函数,zml-ss->enlist

lucas_3333

SunSpring 发表于 2015-5-5 14:18
少函数,zml-ss->enlist

1. ;;;功能：选择集转换为图元名表                                       *
   
2. ;;;参数：SS -----选择集                                             *
   
3. ;;;返回：图元名表                                                   *
   
4. (defun ZML-SS->ENLIST (SS / I EN LST_EN)
   
5.   (setq  LST_EN '()
   
6.   I 0
   
7.   )
   
8.   (repeat (sslength SS)
   
9.     (setq EN   (ssname SS I)
   
10.     LST_EN (cons EN LST_EN)
    
11.     I   (1+ I)
    
12.     )
    
13.   )
    
14.   ;;返回
    
15.   (reverse LST_EN)
    
16. )

;;;功能：选择集转换为图元名表                                       *<br /> ;;;参数：SS -----选择集                                             *<br /> ;;;返回：图元名表                                                   *<br /> (defun ZML-SS->ENLIST (SS / I EN LST_EN)<br />   (setq  LST_EN '()<br />   I 0<br />   )<br />   (repeat (sslength SS)<br />     (setq EN   (ssname SS I)<br />     LST_EN (cons EN LST_EN)<br />     I   (1+ I)<br />     )<br />   )<br />   ;;返回<br />   (reverse LST_EN)<br /> )

ivde

有些块即使box重叠，外观不一定重叠

dbqtju

收藏了。

a4587332

楼主诙谐的提示风格很个性化