[求助]图块统计的小程序
请龙龙仔斑竹编个小程序，统计图块的，思路是：先框选要统计图块的范围，确定后自动统计出数量，要将图块的名称，图层，数量输出到EXCEL，再次执行命令，再次需要统计的图块的名称，图层，数量输出到之前打开的EXCEL的另一个工作表中，（对于被冻结和被锁定的图层里的图块不进行统计），能帮帮我吗？ 这个程序对我来说确实有用,希望高手来解答,拜托了 本帖最后由 作者 于 2007-12-15 10:08:48 编辑 <br /><br /> (defun blktoale( / selfilter po1 po2 objsel objsellist numblist a n m tmp workbooks actworkbook<br/> worksheet relrow relcol)<br/> (setq selfilter(list (cons 0 "insert")))<br/> (prompt "\n选择要输出的对象<Exit退出>：")<br/> (initget 1 "Exit")<br/> (setq po1(getpoint))<br/> (if (= "Exit" po1) (vl-exit-with-error 1))<br/> (while (/= "Exit" po1)<br/> (setq po2(getcorner po1))<br/> (setq objsel(ssget "c" po1 po2 selfilter));框选块-----------------------<br/> (if (null objsel) (vl-exit-with-error 1));空选择也退出,否则会出错-------<br/> (setq n -1)<br/> (while (< (setq n(1+ n))(sslength objsel))<br/> (setq objsellist(cons (list (cdr(assoc '2 (entget(ssname objsel n))))<br/> (cdr(assoc '8 (entget(ssname objsel n)))))<br/> objsellist))<br/> )<br/> ;得到块的名称和其层的列表objsellist---------------------------------------<br/> ;要得到数量还要进行列表objsellist的改造,如果名称和层相同则数量加1---------<br/> (setq numblist nil m 0 );这里也要重新设置为nil,否则会重复计算----------<br/> (foreach no objsellist<br/> (progn<br/> (if (= (vl-position no objsellist) m);说明前面没有名称和层相同的表---<br/> (progn<br/> (setq objsel objsellist)<br/> (setq objsel(vl-remove-if-not '(lambda(x)(equal x no)) objsel))<br/> (setq numblist (cons (append no (list (length objsel))) numblist))<br/> )<br/> ;不存在相同的块--------------------------------------------------<br/> )<br/> (setq m (1+ m))<br/> )<br/> )<br/> ;得到名称,层,数量的列表newobjsellist,下面就是输出到excel的问题了--------<br/> (DSX-Load-TypeLib-Excel);导入excel库,-----------------------------------<br/> (setq excel(vlax-get-or-create-object "Excel.Application"))<br/> (vla-put-visible excel :vlax-true)<br/> (setq workbooks(vlax-get-property excel 'Workbooks))<br/> (setq actworkbook(vlax-invoke-method workbooks 'add))<br/> (setq worksheet(vlax-get-property excel 'activesheet))<br/> (vla-put-name worksheet "图块统计")<br/> ;上面新建文档,下面开始输入----------------------------------------------<br/> (setq relrow 1)<br/> (foreach x numblist<br/> (setq relcol 1)<br/> (foreach y x (msxl-put-value2 (vlax-variant-value<br/> (msxl-get-item (msxl-get-cells worksheet)<br/> (vlax-make-variant relrow)<br/> (vlax-make-variant relcol)))<br/> y<br/> )<br/> (setq relcol(1+ relcol))<br/> ) <br/> (setq relrow(1+ relrow))<br/> ) <br/> (vlax-release-object excel)<br/> (prompt "\n选择要输出的对象<Exit退出>：")<br/> (initget 1 "Exit")<br/> (setq po1(getpoint))<br/> )<br/>)<br/><br/>;以下采用自<br/>;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=57758&replyID=46333&skin=1<br/>;改动了一下为注册表读取库,2003版本如果自定义安装的话还是注册表比较实用------<br/>(defun DSX-Load-TypeLib-Excel ( / tlbfile tlbver out)<br/>(cond<br/>( (null msxl-xl24HourClock)<br/>(if (findfile(setq tlbfile (strcat (vl-registry-read<br/> "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\Excel.EXE"<br/> "Path") "excel.exe")))<br/>(progn<br/>(setq tlbver (substr (vl-filename-base tlbfile) 6))<br/>(cond<br/>( (= tlbver "9")<br/>(princ "\n初始化 Microsoft Excel 2000...") )<br/>( (= tlbver "8")<br/>(princ "\n初始化 Microsoft Excel 97...") )<br/>( (= (vl-filename-base tlbfile) "Excel.exe")<br/>(princ "\n初始化 Microsoft Excel XP...")<br/>)<br/>)<br/>(vlax-import-type-library<br/>:tlb-filename tlbfile<br/>:methods-prefix "msxl-"<br/>:properties-prefix "msxl-"<br/>:constants-prefix "msxl-"<br/>)<br/>(if msxl-xl24HourClock (setq out T))<br/>)<br/>)<br/>)<br/>( T (setq out T) )<br/>)<br/>out<br/>) 谢谢您,是lisp吗,能请您做个附件吗 blktoale 未知命令“BLKTOALE <p>一切ok,终于搞定,谢谢<strong><font face="Verdana" color="#61b713">xxsheng</font></strong></p> 发现一个错误,本希望相同名称的块如果在不同的层中数量也能分开统计,但目前的程序将在不同的层中相同名称的块的数量进行了合并,期待各位高手帮忙解决 这个用什么命令啊 (defun blktoale( / selfilter po1 po2 objsel objsellist numblist a n m tmp workbooks actworkbookworksheet relrow relcol)
改成(defun c:blktoale( / selfilter po1 po2 objsel objsellist numblist a n m tmp workbooks actworkbook
worksheet relrow relcol)
就可以用命令blktoale加载了。（另存为lsp文件） 好东西，不错，学习学习
页:
[1]