社区 › 编程申请 › [求助]按块的名称求块的数量

sailer 发表于 2004-7-6 15:15:00

[求助]按块的名称求块的数量

请编写一个程序，点击某个块就可以求出这种块类型的数量？


谢谢！

meflying 发表于 2004-7-6 15:33:00

(defun c:CalBlk( / ent ents blkname)<BR>       (setq ent (car (entsel)))<BR>       (if ent<BR>                       (progn<BR>                                       (setq ents (entget ent))<BR>                                       (if (= (cdr (assoc 0 ents)) "INSERT")<BR>        (progn<BR>               (setq blkname (cdr (assoc 2 ents)))<BR>               (princ (strcat "\n块名:" blkname "," "数量:"))<BR>               (princ (sslength (ssget "x" (list '(0 . "INSERT") (cons 2 blkname)))))<BR>        )<BR>                                       )<BR>                       )<BR>       )<BR>       (princ)<BR>)<BR>(prompt "Enter CALBLK to launch the program!")

zxj_76 发表于 2004-7-27 16:51:00

<A href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=23719" target="_blank" ></A>

zxj_76 发表于 2004-7-27 16:51:00

用其中的“取图块统计个数”功能！

xyp1964 发表于 2004-7-27 23:32:00

某书中的现成程序：


可以统计块（含块中块）的数量并制表。


<FONT color=#ee1111>★★★★★★★★★★★★★★★★★★★</FONT>


;;;ktj.lsp





(defun c:ktj()<BR>               (setvar "cmdecho" 0)<BR>               (setq os (getvar "osmode")) <BR>               (setvar "osmode" 0)<BR>               (setq pt1 (getpoint "\n左上角: "))<BR>               (setq ww (getdist pt1 "\n宽度 &lt;50&gt;: "))<BR>               (if (null ww) (setq ww 40.0))<BR>               (setq hh (getdist pt1 "\n每格高度 &lt;8&gt;: "))<BR>               (if (null hh) (setq hh 8.0))<BR>               (setq pt2 (polar pt1 0 ww))<BR>               (setq pt3 (polar pt2 (* pi 1.5) hh))<BR>               (setq pt4 (polar pt1 (* pi 1.5) hh))<BR>               (command "pline" pt1 pt2 pt3 pt4 "c")<BR>               (setq pt5 (polar pt1 0 (/ ww 2)))<BR>               (setq pt6 (polar pt5 (* pi 1.5) hh))<BR>               (command "line" pt5 pt6 "")<BR>               (command "text" "m" (inters pt1 pt6 pt4 pt5) (/ hh 2) 0 "图块名称")<BR>               (command "text" "m" (inters pt5 pt3 pt2 pt6) (/ hh 2) 0 "数量")<BR>               (setq blk (tblnext "block" t))<BR>               (while blk<BR>                                       (setq blkn (assoc 2 blk))<BR>                                       (setq blk_key (substr (cdr blkn) 1 1))<BR>                                       (if (/= blk_key "*")<BR>                                                               (progn<BR>                                                                                       (setq ss (ssget "X" (list blkn)))<BR>                                                                                       (if (null ss)<BR>                                                                                                               (setq ssn 0)<BR>                                                                                                               (setq ssn (sslength ss))                                                                                                       <BR>                                                                                       )<BR>                                                                                       (setq blknn (cdr blkn))<BR>                                                                                       (setq pt1 pt4 pt5 pt6 pt2 pt3)<BR>                                                                                       (setq pt4 (polar pt1 (* pi 1.5) hh))<BR>                                                                                       (setq pt6 (polar pt5 (* pi 1.5) hh))<BR>                                                                                       (setq pt3 (polar pt2 (* pi 1.5) hh))<BR>                                                                                       (command "pline" pt2 pt3 pt4 pt1 "")<BR>                                                                                       (command "line" pt5 pt6 "")<BR>                                                                                       (command "text" "m" (inters pt1 pt6 pt4 pt5) (/ hh 2) 0 blknn)<BR>                                                                                       (command "text" "m" (inters pt5 pt3 pt2 pt6) (/ hh 2) 0 (itoa ssn))<BR>                                                               )<BR>                                       )<BR>                                       (setq blk (tblnext "block"))<BR>               )<BR>               (setvar "osmode" os)<BR>               (prin1)<BR>)


<FONT color=#ee1111>★★★★★★★★★★★★★★★★★★★</FONT>

fengche1915@ 发表于 2018-9-6 15:36:10

BUXINGHAISHI BUXING

再见熊猫衣服 发表于 2018-9-8 15:22:09

xyp1964 发表于 2004-7-27 23:32
某书中的现成程序：




根本不用这么麻烦，小菜选择易，很容易的，能够马上全选所有同名块，一下就能看到有多少个相同的块了。

再见熊猫衣服 发表于 2018-9-8 15:22:26

楼主，小菜选择易，了解一下。

linque06 发表于 2018-11-11 10:34:39

这个我用VBA自编了一个小程序。不过似乎楼上大神编得更好。

查看完整版本: [求助]按块的名称求块的数量