块属性提取到excel [已解决]

77077

求大师们帮个忙，做一个块属性提取到excel的lsp。
要求：1.只提取“地块_控制信息”这个图层上的属性块。2.结果输出到excel
图中蓝色字体为表头，绿色字体为内容，以前一直用“attext”命令来提取，发现不能直接提取到excel，而且效率极慢。


最后多谢大师们了，提供lsp源码，我初学者，不会编写lsp，只略会些修改。

经过搜索,终于找到合适的源码了.感谢Gu_xl大大~块属性输出到csv!

2. (defun c:tt (/ d r ss n obj atts)
   
3.   (while (setq d (tblnext "block" (null d)))
   
4.     (setq r (cons (cdr (assoc 2 d)) r))
   
5.   )
   
6.   (and r
   
7.        (setq filename (getfiled "属性输出文件名" "" "csv" 1))
   
8.        )
   
9.   (if filename
   
10.     (progn
    
11.       (setq f (open filename "w"))
    
12.   (foreach name r
    
13.     (setq ss (ssget '((0 . "INSERT"))));选择对象,修改这里.
    
14.     (if ss
    
15.       (progn
    
16. (setq atts (append
    
17.      (vlax-invoke (setq obj (vlax-ename->vla-object (ssname ss 0))) 'GetConstantAttributes)
    
18.      (vlax-invoke obj 'GetAttributes)
    
19.      )
    
20.      )
    
21.       (princ "序号," f)
    
22.       (foreach att atts
    
23.         (princ (vla-get-TagString att) f)
    
24.         (princ "," f)
    
25.         );求出属性列表,写表头
    
26.       (princ "\n" f)
    
27.       (setq n -1)
    
28.       (repeat (sslength ss)
    
29.         (setq obj (vlax-ename->vla-object (ssname ss (setq n (1+ n)))))
    
30.         (setq atts (append
    
31.        (vlax-invoke obj 'GetConstantAttributes)
    
32.        (vlax-invoke obj 'GetAttributes)
    
33.        )
    
34.        )
    
35. (princ (1+ n) f) (princ "," f)
    
36.         (foreach att atts
    
37.           (princ (vla-get-TextString att) f) (princ "," f)
    
38.           )
    
39.         (princ "\n" f);写出属性值
    
40.         )
    
41.       )
    
42.       )
    
43.     )
    
44.       (close f)
    
45.   )
    
46.     )
    
47.   )

(defun c:tt (/ d r ss n obj atts)<br />   (while (setq d (tblnext "block" (null d)))<br />     (setq r (cons (cdr (assoc 2 d)) r))<br />   )<br />   (and r<br />        (setq filename (getfiled "属性输出文件名" "" "csv" 1))<br />        )<br />   (if filename<br />     (progn<br />       (setq f (open filename "w"))<br />   (foreach name r<br />     (setq ss (ssget '((0 . "INSERT"))));选择对象,修改这里.<br />     (if ss<br />       (progn<br /> (setq atts (append<br />      (vlax-invoke (setq obj (vlax-ename->vla-object (ssname ss 0))) 'GetConstantAttributes)<br />      (vlax-invoke obj 'GetAttributes)<br />      )<br />      )<br />       (princ "序号," f)<br />       (foreach att atts<br />         (princ (vla-get-TagString att) f)<br />         (princ "," f)<br />         );求出属性列表,写表头<br />       (princ "\n" f)<br />       (setq n -1)<br />       (repeat (sslength ss)<br />         (setq obj (vlax-ename->vla-object (ssname ss (setq n (1+ n)))))<br />         (setq atts (append<br />        (vlax-invoke obj 'GetConstantAttributes)<br />        (vlax-invoke obj 'GetAttributes)<br />        )<br />        )<br /> (princ (1+ n) f) (princ "," f)<br />         (foreach att atts<br />           (princ (vla-get-TextString att) f) (princ "," f)<br />           )<br />         (princ "\n" f);写出属性值<br />         )<br />       )<br />       )<br />     )<br />       (close f)<br />   )<br />     )<br />   )

664571221

s678z 发表于 2014-1-2 08:17
不需要程序，见http://bbs.mjtd.com/thread-96635-1-1.html，把附件文件按你的块属性名字修改就可使用，见h ...

大神你的帖子权限太高了都不能看

lidaxiu

非常好的程序，但能否合并同类项，最后汇总出数量?

lwb514

用EXCLE打开是乱码要怎么做

77077

这是在cad特性上看到的块属性

77077

这是cad文件

xyp1964

2. 
   
3. ;; 需要e派工具箱(XCAD)的支持：http://yunpan.cn/QXQKsW9gAPmpF
   
4. (defun c:tt ()
   
5.   (if (setq ss (ssget '((0 . "INSERT") (8 . "地块_控制信息") (66 . 1))))
   
6.     (progn (setq i -1
   
7.                  lst '()
   
8.            )
   
9.            (while (setq s1 (ssname ss (setq i (1+ i))))
   
10.              (setq a (mapcar 'cdr (xyp-Get-Attibutes s1))
    
11.                    b '(0 4 1 5 3 2 6 7)
    
12.                    lst (cons (mapcar '(lambda (x) (nth x a)) b) lst)
    
13.              )
    
14.            )
    
15.            (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))
    
16.                  lst (cons '("地块编号"        "用地代码" "总面积" "容积率" "建筑密度"        "绿地率" "建筑限高" "公共设施") lst))
    
17.            (xyp-lst2xls lst)
    
18.     )
    
19.   )
    
20.   (princ)
    
21. )

<br /> ;; 需要e派工具箱(XCAD)的支持：http://yunpan.cn/QXQKsW9gAPmpF<br /> (defun c:tt ()<br />   (if (setq ss (ssget '((0 . "INSERT") (8 . "地块_控制信息") (66 . 1))))<br />     (progn (setq i -1<br />                  lst '()<br />            )<br />            (while (setq s1 (ssname ss (setq i (1+ i))))<br />              (setq a (mapcar 'cdr (xyp-Get-Attibutes s1))<br />                    b '(0 4 1 5 3 2 6 7)<br />                    lst (cons (mapcar '(lambda (x) (nth x a)) b) lst)<br />              )<br />            )<br />            (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))<br />                  lst (cons '("地块编号"        "用地代码" "总面积" "容积率" "建筑密度"        "绿地率" "建筑限高" "公共设施") lst))<br />            (xyp-lst2xls lst)<br />     )<br />   )<br />   (princ)<br /> )

菜卷鱼

xyp1964 发表于 2014-1-1 19:08

选择对象:  ; 错误: no function definition: XYP-GET-ATTIBUTES

s678z

不需要程序，见http://bbs.mjtd.com/thread-96635-1-1.html，把附件文件按你的块属性名字修改就可使用，见http://bbs.mjtd.com/thread-95141-1-1.html。

xyp1964

菜卷鱼 发表于 2014-1-2 08:15
选择对象:  ; 错误: no function definition: XYP-GET-ATTIBUTES

2. 
   
3. (defun xyp-get-Attibutes (ename / obj lst x)
   
4.   (setq        obj (vlax-ename->vla-object ename)
   
5.         lst '()
   
6.   )
   
7.   (if (and (= (vla-Get-ObjectName obj) "AcDbBlockReference")
   
8.            (= (vla-Get-HasAttributes obj) :vlax-true)
   
9.       )
   
10.     (mapcar '(lambda (x)
    
11.                (setq lst (cons (cons (vla-Get-TagString x) (vla-Get-TextString x))
    
12.                                lst
    
13.                          )
    
14.                )
    
15.              )
    
16.             (vlax-safearray->list
    
17.               (vlax-variant-value (vla-GetAttributes obj))
    
18.             )
    
19.     )
    
20.   )
    
21.   (reverse lst)
    
22. )

<br /> (defun xyp-get-Attibutes (ename / obj lst x)<br />   (setq        obj (vlax-ename->vla-object ename)<br />         lst '()<br />   )<br />   (if (and (= (vla-Get-ObjectName obj) "AcDbBlockReference")<br />            (= (vla-Get-HasAttributes obj) :vlax-true)<br />       )<br />     (mapcar '(lambda (x)<br />                (setq lst (cons (cons (vla-Get-TagString x) (vla-Get-TextString x))<br />                                lst<br />                          )<br />                )<br />              )<br />             (vlax-safearray->list<br />               (vlax-variant-value (vla-GetAttributes obj))<br />             )<br />     )<br />   )<br />   (reverse lst)<br /> )

菜卷鱼

s678z 发表于 2014-1-2 08:17
不需要程序，见http://bbs.mjtd.com/thread-96635-1-1.html，把附件文件按你的块属性名字修改就可使用，见h ...

代码是要来学习

菜卷鱼

xyp1964 发表于 2014-1-2 09:00

可能没办法体验了，我们公司的EXCEL软件是libreoffice4.0，工具箱好像不认识它

77077

院长的确牛逼，多谢院长。
下次再给院长出个更难的，嘿嘿。

如果这些块都和对应的pl闭合线编成新属性块了呢，属性块中含有上面这几个属性块，不炸散的情况下能提取不？