批量获取块中的文字

muwind

;终于会发网页代码了.....
;这一个副产物：批量获取块中的文字，
;本来的目的是获取仅含文字的块如果文字是，
;有特定特征的文字 对块（主要是匿名块）进行删除或者别的操作，
;但是好像比我想的复杂那么点点

1. (defun c:getbt(/ blks ss m n e nam bnnew namlst)
   
2.   (setq BLKs (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))));取得图形的Blocks集合
   
3.   (if (setq ss (ssget  '((0 . "INSERT"))))
   
4.       (progn
   
5.        (setq namlst '())
   
6.        (repeat (setq n (sslength ss))
   
7.          (if  (setq e (ssname ss (setq n (1- n))))
   
8.           (progn
   
9.            (setq nam (vla-get-name (vlax-ename->vla-object e)));获取块名字
   
10.            (if (= (member nam namlst) nil)
    
11.                (setq namlst(cons nam namlst))
    
12.            )
    
13.           )
    
14.         )
    
15.       )
    
16.         (foreach n namlst   
    
17.           (progn
    
18.            (setq strlst '())
    
19.             (vlax-for m (vla-item blks n)
    
20.                (if (= (vla-get-objectname m) "AcDbText")
    
21.                    (setq strlst (cons (vla-get-TextString m) strlst))
    
22.                )
    
23.              )
    
24.            (if strlst
    
25.             (progn
    
26.               (princ (strcat "\n My name is " n ";All texts in my body are:"))
    
27.               (princ strlst)
    
28.             )
    
29.            )
    
30.           )
    
31.          )
    
32.        )
    
33.   )
    
34.   (princ)
    
35. )

(defun c:getbt(/ blks ss m n e nam bnnew namlst)<br />   (setq BLKs (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))));取得图形的Blocks集合<br />   (if (setq ss (ssget  '((0 . "INSERT"))))<br />       (progn<br />        (setq namlst '())<br />        (repeat (setq n (sslength ss))<br />          (if  (setq e (ssname ss (setq n (1- n))))<br />           (progn <br />            (setq nam (vla-get-name (vlax-ename->vla-object e)));获取块名字<br />            (if (= (member nam namlst) nil)<br />                (setq namlst(cons nam namlst))<br />            )<br />           )<br />         )<br />       )<br />         (foreach n namlst    <br />           (progn<br />            (setq strlst '())<br />             (vlax-for m (vla-item blks n)<br />                (if (= (vla-get-objectname m) "AcDbText")<br />                    (setq strlst (cons (vla-get-TextString m) strlst))<br />                )<br />              )<br />            (if strlst<br />             (progn<br />               (princ (strcat "\n My name is " n ";All texts in my body are:"))<br />               (princ strlst)<br />             )<br />            )<br />           )<br />          )<br />        )<br />   )<br />   (princ)<br /> )

gaics

块中块不行呀

czb203

好像识别不出来哦，老大演示一下

Nico

怎么取得块中块  块中所有图元的列表

逍遥无声