[编程交流] 从块生成bom表列表

(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