[编程交流] 块提取

(defun c:sample  (/ a e txtlst atbtlst)
     (if (setq txtlst nil
               a      (ssget "_:S:E" '((0 . "INSERT"))))
           (progn
                 (setq e (vlax-ename->vla-object (ssname a 0)))
                 (vlax-for
                        itm
                        (vla-item
                              (vla-get-blocks
                                    (vla-get-ActiveDocument
                                          (vlax-get-acad-object)))
                              (vla-get-effectivename e))
                       (if (wcmatch
                                 (vla-get-ObjectName itm)
                                 "AcDb*Text")
                             (setq txtlst
                                        (cons (vla-get-TextString
                                                    itm)
                                              txtlst))))
                 (setq atbtlst
                            (mapcar
                                  (function
                                        (lambda (j)
                                              (vla-get-textstring
                                                    j)))
                                  (vlax-invoke
                                        e
                                        'GetAttributes)))
                 )
           )
     (foreach
            itm  (list '("TEXT" txtlst) '("ATTRIB" atbtlst))
           (if (eval (cadr itm))
                 (progn (print (car itm))
                        (foreach
                               str  (eval (cadr itm))
                              (princ (strcat "\n\t\t" str)))
                        )
                 )
           )
     (princ)
     )