从块生成bom表列表
编辑：看了这个
起初我不想去excel，但看了之后。。。。这让我改变了主意。
我正在做一个自动化bom表的项目。
我在网上搜索了一下，发现：
用于制作属性表的c#程序：
http://through-the-interface.typepad.com/through_the_interface/2007/06/creating_a_tabl.html
不知道如何运行
用于创建属性表的lisp。
http://forums.cadalyst.com/showthread.php?t=6430
效果很好，但遗漏了一些非常重要的东西。请参见此图：
我用了eattext
这一功能强大的autocad功能与其他功能强大的autocad功能一样，只适用于90%的用户，但缺少以下功能：
没有气球数字添加，可以做到相当容易的手。
当块位于模型空间中时，不能在图纸空间中使用。这总是。。。
解决方法是使用chspace，但规模是错误的。AAAAA RGH
总之，对我来说最好的方法是更新lisp。
或者有人已经这样做了，想要分享或帮助？
我认为合并相同的块名将是最困难的，所以如果有人知道如何做到这一点？
从第二个链接到lisp表的属性：
(Defun c:attable (/ at>att at>item at>set atable cnt cw ena nc nr pt rh)
(vl-load-com)
;; GET_ATTS BY BILL KRAMER
(defun get_ATTS (EN / EL ATTS)
(setq EL (entget EN))
(setq ENA (cdr (assoc 2 EL))) ; wiz
(if (and (= (cdr (assoc 0 EL)) "INSERT")
(= (cdr (assoc 66 EL)) 1)
) ;_ end and
(progn
(setq EN (entnext EN)
EL (entget EN)
) ;_ end setq
(while (= (cdr (assoc 0 EL)) "ATTRIB")
(setq ATTS (cons (list
(vla-get-ObjectID
(vlax-ename->vla-object EN)
) ; wiz
(cdr
(assoc 2 EL)
) ;_ end_cdr
(cdr (assoc 1 EL))
) ;_ end_list
ATTS
) ;_ end_cons
EN (entnext EN)
EL (entget EN)
) ;_ end setq
) ;_ end while
(list ena (reverse ATTS)) ; wiz
) ;_ end progn
) ;_ end if
) ;_ end_defun
(if (setq at>set (ssget '((0 . "INSERT"))))
(progn
(setq at>att
(mapcar 'get_atts
(vl-remove-if
'listp
(mapcar 'cadr (ssnamex at>set))
) ;_ end_vl-remove-if
) ;_ end_mapcar
) ;_ end_setq
(setq PT (getpoint "\nTable insertion point: ")
RH (* 2.0 (getvar "TEXTSIZE"))
CW (* 20.0 (getvar "TEXTSIZE"))
NR (+ 2 (length at>att))
NC (1+ (length (cadar at>att)))
) ;_ end_setq
(setq
aTable (vla-addtable
(vla-get-modelspace
(vla-get-activedocument
(vlax-get-acad-object)
) ;_ end_vla-get-activedocument
) ;_ end_vla-get-modelspace
(vlax-3d-point PT)
NR
NC
RH
CW
) ;_ end_vla-addtable
) ;_ end_setq
(vla-setcellvalue aTable 0 0 "B.O.M.")
(vla-setcellvalue aTable 1 0 "Block Name")
(vla-setcellvalue aTable 1 1 "Attributes")
(vla-MergeCells aTable 1 1 1 (length (cadar at>att)))
(setq CNT 2) ;_ end_setq
(foreach Item at>att
(vla-setcellvalue aTable CNT 0 (car Item))
(setq at>item 1)
(while (<= at>item (length (cadar at>att)))
(vl-catch-all-apply
'(lambda ()
(vla-settext
aTable
CNT
at>item
(strcat
"%<\\AcObjProp Object(%<\\_ObjId "
(itoa (car (nth (1- at>item) (cadr Item))))
">%).TextString>%"
) ;_ end_strcat
) ;_ end_vla-setcellvalue
) ;_ end_lambda
) ;_ end_vl-catch-all-apply
(setq at>item (1+ at>item))
) ;_ end_while
(setq CNT (1+ CNT))
;;ready next row
) ;_ end_foreach
) ;_ end_progn
) ;_ end_if
(princ)
) ;_ end_Defun
编辑用于计算块的mac代码，并合并相同的块：
http://www.cadtutor.net/forum/showthread.php?51370-块列表&突出显示=列表+块
现在让Franken一起构建2 Hjx，我有同样的要求！有谁能帮帮我们吗！
页:
[1]