关于块属性的提取

5d95286278

10个贴才能看代码啊啊

北斗杓

终于找到提取块内容相关的了   

LV_XR

向各位高手学习。

zhanyanchun

好文章，谢谢分享

米兰达薇薇2899

Gu_xl 发表于 2012-10-27 13:15
[/post]

版主你好，如果我只想提取图纸中块名为“AAA”的块属性，如何改写代码？或者更加智能一点就是可以用鼠标点取指定块名，只导出该块名的的属性？望指点！

米兰达薇薇2899

版主你好，如果我只想提取图纸中块名为“AAA”的块属性，如何改写代码？或者更加智能一点就是可以用鼠标点取指定块名，只导出该块名的的属性？望指点！

米兰达薇薇2899

我加了一句          (if (= name "标题栏" ，想只提取“标题栏”图块的属性，结果不起作用还是都提取了

(defun c:TQbtlSX (/ d r ss n obj atts)        ;提取标题栏属性
  (while (setq d (tblnext "block" (null d)))
  ;tblnext在符号表中查找下一项(tblnext table-name [rewind]),其中table-name为字符串，指定符号表。有效的 table-name 值"LAYER"、"LTYPE"、"VIEW"、"STYLE"、"BLOCK"、"UCS"、"APPID"、"DIMSTYLE" 和 "VPORT"。该参数不区分大小写。

    (setq r (cons (cdr (assoc 2 d)) r))
        ;(assoc element alist) 从关联表alist中搜索一个元素element，如果找到则返回该关联表条目alist
        ;例子 命令: (setq al '((name box) (width 3) (size 4.7263) (depth 5)))返回        ;((NAME BOX) (WIDTH 3) (SIZE 4.7263) (DEPTH 5))
    ;命令: (assoc 'size al)返回(SIZE 4.7263)；搜索不到返回nil.
        ;cdr返回去掉了第一个元素的表;如果表为空，函数返回 nil。
        ;cons向表的头部添加一个元素，或构造一个点对,命令： (cons 'a '(b c d)) 返回(A B C D)
  )
  (and r
           (setq wjm (getfiled "请指定属性输出文件名" "" "csv" 1))
       )
  (if wjm
    (progn
      (setq f (open wjm "w"))
  (foreach name r        ;;遍历每一个块名称
  ;将表中的所有成员以指定变量的身份带入表达式求值 (foreach name list [expr...])
  ;foreach 函数遍历表，将其中每一个元素依次赋给变量name，并对每一个表达式求值。可以指定任意多个表达式。

          (if (= name "标题栏"

          (setq ss (ssget "x" (list '(0 . "insert")  '(66 . 1) (cons 2 name))))
        ;ssget根据选定对象创建选择集(ssget [sel-method] [pt1 [pt2]] [pt-list] [filter-list])
    (if ss
      (progn
      (WRITE-LINE (strcat "序号,块名称,\"" name "\"") f)
      (setq atts (append
     (vlax-invoke (setq obj (vlax-ename->vla-object (ssname ss 0))) 'GetConstantAttributes)
     (vlax-invoke obj 'GetAttributes)
     )
     )
      (princ "属性名称," f)
      (foreach att atts
        (princ (vla-get-TagString att) f) (princ "," f)
        )
      (princ "\n" f)
      (setq n -1)
      (repeat (sslength ss)
        (setq obj (vlax-ename->vla-object (ssname ss (setq n (1+ n)))))
        (setq atts (append
       (vlax-invoke obj 'GetConstantAttributes)
       (vlax-invoke obj 'GetAttributes)
       )
       )
(princ (1+ n) f) (princ "," f)
        (foreach att atts
          (princ (vla-get-TextString att) f) (princ "," f)
          )
        (princ "\n" f)
        )
      )
      )
    )
      (close f)
  )
  )
    )

           (STARTAPP "C:\\Program Files\\Microsoft Office\\Office14\\EXCEL.EXE" wjm)

  )
)

米兰达薇薇2899

已经解决！感谢万能的明经！
http://bbs.mjtd.com/thread-170025-1-1.html

wisezhu

谢谢  这个代码很好 收藏了

wisezhu

谢  这个代码很好 收藏了