一种获取图中及外部引用中指定块名的方法

wharan

为了提取图中图标信息，借用了论坛中大侠的某些代码：自动选取图中及外部引用中的所有图标块，返回该块的图元名列表。

2. ;; [功能] 返回外部引用中名为Bname的图块实体列表
   
3. (defun HH:Xrefblk (Bname      /         bock-name
   
4.        ss        t-get-bock-all-name
   
5.        t-get-lst-unique
   
6.       )
   
7.   ;;说明:删除表里的重复元素
   
8.   ;;参数:l:表 [list]
   
9.   ;;返回:表 [list]
   
10.   ;;用法T-get-lst-Unique '(1 2 5 8 2 3 2 5 2 6))-->'(1 2 5 8 3 6)
    
11.   (defun T-get-lst-Unique (lst / s-car new)
    
12.     (while lst
    
13.       (setq s-car (car lst))
    
14.       (if (vl-position s-car new)
    
15.   nil
    
16.   (setq new (cons s-car new))
    
17.       )
    
18.       (setq lst (cdr lst))
    
19.     )
    
20.     (setq new (reverse new))
    
21.   )
    
22. 
    
23.   
    
24.   ;;返回:图元名表 [list]
    
25.   (defun T-get-bock-all-name (bock-name / dxf last-name name)
    
26.     (setq name-lst nil)
    
27.     (setq
    
28.       last-name
    
29.        (tblobjname "block" (cdr (assoc 2 (entget bock-name))))
    
30.     )
    
31.     (while (setq last-name (entnext last-name))
    
32.       (setq dxf (entget last-name))
    
33.       (setq name (cdr (assoc -1 dxf)))
    
34.       (if (and (= (cdr (assoc 0 dxf)) "INSERT")
    
35.          (wcmatch (cdr (assoc 2 dxf)) Bname)
    
36.     )
    
37. 
    
38.   (setq name-lst (cons name name-lst))
    
39.       )
    
40.     )
    
41.     (setq name-lst (T-get-lst-Unique name-lst))
    
42.     name-lst
    
43.   )
    
44.   (princ "自动选择目标")
    
45.   (if
    
46.     (setq ss (ssget "A"
    
47.         (list (cons 0 "insert")
    
48. 
    
49.         )
    
50.        )
    
51.     )
    
52. 
    
53.      (progn
    
54.        (while (setq bock-name (ssname ss 0))
    
55.    (setq
    
56.      name-lst (append name-lst (T-get-bock-all-name bock-name))
    
57.    )
    
58.    (setq ss (ssdel bock-name ss))
    
59.        )
    
60.      )
    
61.   )
    
62. )

;; [功能] 返回外部引用中名为Bname的图块实体列表<br /> (defun HH:Xrefblk (Bname      /         bock-name<br />        ss        t-get-bock-all-name<br />        t-get-lst-unique<br />       )<br />   ;;说明:删除表里的重复元素<br />   ;;参数:l:表 [list]<br />   ;;返回:表 [list]<br />   ;;用法T-get-lst-Unique '(1 2 5 8 2 3 2 5 2 6))-->'(1 2 5 8 3 6)<br />   (defun T-get-lst-Unique (lst / s-car new)<br />     (while lst<br />       (setq s-car (car lst))<br />       (if (vl-position s-car new)<br />   nil<br />   (setq new (cons s-car new))<br />       )<br />       (setq lst (cdr lst))<br />     )<br />     (setq new (reverse new))<br />   )<br /> <br />   <br />   ;;返回:图元名表 [list]<br />   (defun T-get-bock-all-name (bock-name / dxf last-name name)<br />     (setq name-lst nil)<br />     (setq<br />       last-name<br />        (tblobjname "block" (cdr (assoc 2 (entget bock-name))))<br />     )<br />     (while (setq last-name (entnext last-name))<br />       (setq dxf (entget last-name))<br />       (setq name (cdr (assoc -1 dxf)))<br />       (if (and (= (cdr (assoc 0 dxf)) "INSERT")<br />          (wcmatch (cdr (assoc 2 dxf)) Bname)<br />     )<br /> <br />   (setq name-lst (cons name name-lst))<br />       )<br />     )<br />     (setq name-lst (T-get-lst-Unique name-lst))<br />     name-lst<br />   )<br />   (princ "自动选择目标")<br />   (if<br />     (setq ss (ssget "A"<br />         (list (cons 0 "insert")<br /> <br />         )<br />        )<br />     )<br /> <br />      (progn<br />        (while (setq bock-name (ssname ss 0))<br />    (setq<br />      name-lst (append name-lst (T-get-bock-all-name bock-name))<br />    )<br />    (setq ss (ssdel bock-name ss))<br />        )<br />      )<br />   )<br /> )

xj6019

感谢大佬分享  收藏备用啦