发一个统计块数量的源码

邹锋

2. (defun c:bk(/ npl mpl ss n na i)
   
3.   (setq ss (ssget '((0 . "INSERT"))))
   
4.   (setq n 0)
   
5.   (repeat (sslength ss)
   
6.     (setq npl (cons (cdr (assoc '2 (entget (ssname ss n)))) npl))
   
7.     (setq n (1+ n))
   
8.     )
   
9.   (while npl
   
10.     (setq i 0)
    
11.     (setq na (car npl))
    
12.     (mapcar  '(lambda (y) (if (= na y)
    
13.                             (progn
    
14.                               (setq i (1+ i))
    
15.                               )
    
16.                             )
    
17.                 )
    
18.              npl
    
19.              )
    
20.     (setq npl (vl-remove na npl))
    
21.     (setq mpl (cons (list na (rtos i 2 0)) mpl))
    
22.     )
    
23.   (princ mpl)
    
24.   (princ)
    
25. )
    

(defun c:bk(/ npl mpl ss n na i)<br />   (setq ss (ssget '((0 . "INSERT"))))<br />   (setq n 0)<br />   (repeat (sslength ss)<br />     (setq npl (cons (cdr (assoc '2 (entget (ssname ss n)))) npl))<br />     (setq n (1+ n))<br />     )<br />   (while npl<br />     (setq i 0)<br />     (setq na (car npl))<br />     (mapcar  '(lambda (y) (if (= na y)<br />                             (progn<br />                               (setq i (1+ i))<br />                               )<br />                             )<br />                 )<br />              npl<br />              )<br />     (setq npl (vl-remove na npl))<br />     (setq mpl (cons (list na (rtos i 2 0)) mpl))<br />     )<br />   (princ mpl)<br />   (princ)<br /> )<br />

返回块名字与个数

taoyi0727

看看我这个怎么样 我也是才学的

2. 
   
3. ;选块名
   
4. (defun c:xkm ()
   
5.         (setq xh 0)
   
6.         (while xh
   
7.                 (setq km (entsel "\n请选择要过滤的块"))
   
8.                 (if (= km nil)
   
9.                         (princ "\n请重新选择")
   
10.                         (if (= (cdr (assoc 0 (entget (car km)))) "INSERT")
    
11.                                 (progn
    
12.                                         (setq km (assoc 2 (entget (car km))))
    
13.                                         (setq xh nil)
    
14.                                 )
    
15.                         )
    
16.                 )
    
17.         )
    
18.         (setq ss (ssget (list km (cons 0 "INSERT"))))
    
19.         (sssetfirst nil ss)
    
20.         (princ (strcat "\n已选择" (rtos (sslength ss) 2 4) "个对象"))
    
21.         (princ)
    
22. )
    

<br /> ;选块名<br /> (defun c:xkm ()<br />         (setq xh 0)<br />         (while xh<br />                 (setq km (entsel "\n请选择要过滤的块"))<br />                 (if (= km nil)<br />                         (princ "\n请重新选择")<br />                         (if (= (cdr (assoc 0 (entget (car km)))) "INSERT")<br />                                 (progn<br />                                         (setq km (assoc 2 (entget (car km))))<br />                                         (setq xh nil)<br />                                 )<br />                         )<br />                 )<br />         )<br />         (setq ss (ssget (list km (cons 0 "INSERT"))))<br />         (sssetfirst nil ss)<br />         (princ (strcat "\n已选择" (rtos (sslength ss) 2 4) "个对象"))<br />         (princ)<br /> )<br />

chj20055647

试一下，整是自己想要的功能

395969

这个好用谢谢分享

maiko

顶顶源码

彳余

顶顶源码

war32

顶源码

yoyoho

感谢 邹锋 分享程序!

叮咚

为什么要写这么复杂？练习复杂的函数？

1. (defun c:bk(/ en mpl ss n nn m xx)
   
2. (setq ss (ssget '((0 . "INSERT"))))
   
3. (or ss (setq ss (ssadd)))
   
4. (setq n 0 nn (sslength ss) mpl '())
   
5. (while (< n nn)
   
6.         (setq en (ssname ss n) data (entget en))
   
7.   (setq n (1+ n))
   
8.         (setq name (cdr (assoc 2 data)))
   
9.         (setq xx (assoc name mpl))
   
10.         (if xx
    
11.         (setq m (cdr xx) m (1+ m) mpl (subst (cons name m) xx mpl))
    
12.         (setq mpl (cons (cons name 1) mpl))
    
13.         )
    
14.   )
    
15. (if mpl (princ mpl)(princ "/nNothing!"))
    
16. (princ)
    
17. )

(defun c:bk(/ en mpl ss n nn m xx)<br /> (setq ss (ssget '((0 . "INSERT"))))<br /> (or ss (setq ss (ssadd)))<br /> (setq n 0 nn (sslength ss) mpl '())<br /> (while (< n nn)<br />         (setq en (ssname ss n) data (entget en))<br />   (setq n (1+ n))<br />         (setq name (cdr (assoc 2 data)))<br />         (setq xx (assoc name mpl))<br />         (if xx<br />         (setq m (cdr xx) m (1+ m) mpl (subst (cons name m) xx mpl))<br />         (setq mpl (cons (cons name 1) mpl))<br />         )<br />   )<br /> (if mpl (princ mpl)(princ "/nNothing!"))<br /> (princ)<br /> )

伪书虫86

叮咚 发表于 2014-10-11 11:02
为什么要写这么复杂？练习复杂的函数？

请教下，第三行干嘛用的？

vectra

只是为了后续语句在空选时不报错

434939575

我是来学习的，谢谢分享

zhongys

请教邹大大
若将这一句(setq mpl (cons (list na (rtos i 2 0)) mpl))改成过滤重名块怎么改。
我改了一下
    (setq mpl (cons (strcat na) mpl))
    )
    (setq mpl (cons "2 ." mpl))
得出结果不对，如下
(2 . screw_m10_h screw_m10_l epin_ejp_9 epin_ejp_7 epin_ejp_6 epin_ejp_4)
希望得出结果如下
(2 .“ screw_m10_h，screw_m10_l，epin_ejp_9，epin_ejp_7，epin_ejp_6，epin_ejp_4”)
用于把选择的重名块去除