（完成）[编程申请]：求一个LSP,计算块数量

lclac

好用
下次出升级版本时最好能把被统计的图块的图形也放到表中

mylion

楼上各位提供了好几种，哪个好用呢？请大虾们测试一下，也好让我等菜鸟有所适从

citykunan

AutoCAD的EXPRESS工具中就有这个功能，Bcount.

andyhua5240

总的感觉第一个附件好使些，不过还是要说谢谢！

usercoolboy

PLAYBOY的那个想法不是挺好吗,只要再加上一到两句判断语句就行了

wxf200_0

xiexie 一直都下载不了“晓东工具箱”和李国杰的“ASDE"，

coldhope

高手云集啊，大家都是怎么学的呢。前几天，我也求斑竹和这里的朋友们写了个命令，很好用的，希望网站越办越好，过些天我准备捐钱，大家也要相应阿！！

lsjjm

请参考这个:
(defun c:test ()
  (vl-load-com)
  (setq p0 (getpoint "\nInput Insert Point: "))
  (vl-cmdf "text" p0 0.08 0 "Block               Quantity")
  (setq p0 (polar p0 (* 1.5 pi) 0.12))
  (vl-cmdf "text" p0  0.08 0 "*******************************")
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (vlax-for blk (vla-get-blocks doc)
    (if (= (vla-get-islayout blk) :vlax-false)
      (progn
        (setq p0 (polar p0 (* 1.5 pi) 0.12))
        (vl-cmdf "text" p0 0.08 0 (vla-get-name blk))
        (vl-cmdf "text" "j" "r" "@2,0" 0.08 0 (itoa (vla-get-count blk)))
      )
    )
  )
)

f5612140

圖塊也列出,字寬0.5有較好的效果

2. 
   
3. (defun c:BKNUM()
   
4. 
   
5.      (setvar "cmdecho" 0)
   
6.      (setvar "blipmode" 0)
   
7. 
   
8.      (command "erase" (ssget "X" '((8 . "BKLIST"))) "")
   
9.      (command "layer" "m" "BKTEMP" "c" 2 "BKTEMP" "")
   
10.      (command "layer" "m" "BKLIST" "c" 7 "BKLIST" "")
    
11. 
    
12.      (setq txth 50)
    
13. 
    
14.      (setq pt (getpoint "\nEnter text insert point: "))
    
15.      (command "text" pt txth 0 "Block name      dwg           Number" )
    
16.      (setq pt (mapcar '+ pt '(+0.0 -50.0 0)))
    
17.      (command "text" pt txth 0 "-----------------------------")
    
18.      (setq pt (mapcar '+ pt '(+0.0 -80.0 0)))
    
19. 
    
20.   (setq blk (assoc 2 (tblnext "block" 0)))
    
21.   (while (/= blk nil)
    
22.      (setq ss (ssget "X" (list (cons 0 "INSERT") blk)))
    
23.      (if (/= ss nil)
    
24.        (progn
    
25.          (command "chprop" ss "" "la" "BKTEMP" "")
    
26.          (setq nn (rtos (sslength ss) 2 0))
    
27.          (setq blkn (cdr blk))
    
28.          (setq txtn (strlen blkn))
    
29.          (setq ss 20)
    
30.          (repeat (- ss txtn)
    
31.             (setq blkn (strcat blkn " "))
    
32.          )
    
33. ;         (princ blkn fl)
    
34.          (command "text" "ML" pt txth 0 blkn)
    
35.          (setq pt (mapcar '+ pt '(+400.0 +0.0 0)))
    
36.          (command "insert" blkn pt "" "" "")
    
37.          (setq pt (mapcar '+ pt '(+400.0 +0.0 0)))
    
38. ;         (princ nn fl)
    
39.          (command "text" "ML" pt txth 0 nn)
    
40.          (setq pt (mapcar '+ pt '(-800.0 -100.0 0)))
    
41.          (setq blk (assoc 2 (tblnext "block")))
    
42.       )
    
43.       (setq blk (assoc 2 (tblnext "block")))
    
44.     )
    
45.   )
    
46.   (prin1)
    
47.   (command "layer" "S" "0" "")
    
48. )
    
49. (prin1)
    

<br /> (defun c:BKNUM()<br /> <br />      (setvar "cmdecho" 0)<br />      (setvar "blipmode" 0)<br /> <br />      (command "erase" (ssget "X" '((8 . "BKLIST"))) "")<br />      (command "layer" "m" "BKTEMP" "c" 2 "BKTEMP" "")<br />      (command "layer" "m" "BKLIST" "c" 7 "BKLIST" "")<br /> <br />      (setq txth 50)<br /> <br />      (setq pt (getpoint "\nEnter text insert point: "))<br />      (command "text" pt txth 0 "Block name      dwg           Number" )<br />      (setq pt (mapcar '+ pt '(+0.0 -50.0 0)))<br />      (command "text" pt txth 0 "-----------------------------")<br />      (setq pt (mapcar '+ pt '(+0.0 -80.0 0)))<br /> <br />   (setq blk (assoc 2 (tblnext "block" 0)))<br />   (while (/= blk nil)<br />      (setq ss (ssget "X" (list (cons 0 "INSERT") blk)))<br />      (if (/= ss nil)<br />        (progn<br />          (command "chprop" ss "" "la" "BKTEMP" "")<br />          (setq nn (rtos (sslength ss) 2 0))<br />          (setq blkn (cdr blk))<br />          (setq txtn (strlen blkn))<br />          (setq ss 20)<br />          (repeat (- ss txtn)<br />             (setq blkn (strcat blkn " "))<br />          )<br /> ;         (princ blkn fl)<br />          (command "text" "ML" pt txth 0 blkn)<br />          (setq pt (mapcar '+ pt '(+400.0 +0.0 0)))<br />          (command "insert" blkn pt "" "" "")<br />          (setq pt (mapcar '+ pt '(+400.0 +0.0 0)))<br /> ;         (princ nn fl)<br />          (command "text" "ML" pt txth 0 nn)<br />          (setq pt (mapcar '+ pt '(-800.0 -100.0 0)))<br />          (setq blk (assoc 2 (tblnext "block")))<br />       )<br />       (setq blk (assoc 2 (tblnext "block")))<br />     )<br />   )<br />   (prin1)<br />   (command "layer" "S" "0" "")<br /> )<br /> (prin1)<br />

lclac

f5612140  的仁兄谢谢你编的程序，
刚使用，应该说是可以用，
当我画图使用的比例是1：100，
用0。5的字高就有问题了

刚才回去把50改为500，400改为4000
基本可以用了，新问题
最好附加一个选择表，在显示以前把不需要的图块去掉。

cwjdy

我也是的

zemehua

为什么统计的图块数量最后一组比实际的多一个呢？

longinmymind

大虾们,学lisp难不难啊?

boboc98

r14支持，不错

coldhope

解压后考至CADのSUPPORT目录下，加载LSP
需要修改LSP内的block_list.txt文件的目录，具体见图片