属性块之属性输出 XLS 文件

csharp · 发表于 2016-5-8 08:07:06

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 csharp 于 2016-5-8 08:08 编辑

包括块的 Handle ，输出表格形式可以再外部批量修改，供后续更新

(defun c:tt (/ getatts ss lst)
(defun getatts (ss / lst alst)
(setq lst (mapcar '(lambda (x)
(cons (xdrx_getpropertyvalue x "handle")
(mapcar '(lambda (a) (xdrx_getpropertyvalue a "tag" "textstring"))
(xdrx_insert_getattribs x)
)
)
)
(xdrx_pickset->ents ss)
)
alst (acad_strlsort
(xd::list:removedup
(mapcar 'strcase
(apply 'append
(mapcar '(lambda (x) (mapcar 'car x)) (mapcar 'cdr lst))
)
)
)
)
)
(cons (cons "" alst)
(mapcar '(lambda (x)
(cons (car x)
(mapcar '(lambda (a / l)
(if (setq l (assoc a (cdr x)))
(cadr l)
""
)
)
alst
)
)
)
lst
)
)
)
(if (setq ss (ssget '((0 . "Insert") (66 . 1))))
(progn
(setq lst (getatts ss))
(xd::excel:createtofile
(strcat (getvar "dwgprefix")
(vl-filename-base (getvar "dwgname"))
".xls"
)
lst
)
)
)
(princ)
)

(defun c:tt (/ getatts ss lst) 
  (defun getatts (ss / lst alst) 
    (setq lst  (mapcar '(lambda        (x) 
                          (cons        (xdrx_getpropertyvalue x "handle") 
                                (mapcar        '(lambda (a) (xdrx_getpropertyvalue a "tag" "textstring")) 
                                        (xdrx_insert_getattribs x) 
                                ) 
                          ) 
                        ) 
                       (xdrx_pickset->ents ss) 
               ) 
          alst (acad_strlsort 
                 (xd::list:removedup 
                   (mapcar 'strcase 
                           (apply 'append 
                                  (mapcar '(lambda (x) (mapcar 'car x)) (mapcar 'cdr lst)) 
                           ) 
                   ) 
                 ) 
               ) 
    ) 
    (cons (cons "" alst) 
          (mapcar '(lambda (x) 
                     (cons (car x) 
                           (mapcar '(lambda (a / l) 
                                      (if (setq l (assoc a (cdr x))) 
                                        (cadr l) 
                                        "" 
                                      ) 
                                    ) 
                                   alst 
                           ) 
                     ) 
                   ) 
                  lst 
          ) 
    ) 
  ) 
  (if (setq ss (ssget '((0 . "Insert") (66 . 1)))) 
    (progn 
      (setq lst (getatts ss)) 
      (xd::excel:createtofile 
        (strcat        (getvar "dwgprefix") 
                (vl-filename-base (getvar "dwgname")) 
                ".xls" 
        ) 
        lst 
      ) 
    ) 
  ) 
  (princ) 
)

账号		自动登录	找回密码
密码			立即注册

[原创] 属性块之属性输出 XLS 文件

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。