Tharwat 发表于 2022-7-6 07:05:44

 
好的，试试这个，让我知道。
 

(defun c:Test (/ ss i sn bn e l)
;; Tharwat 08.08.2013    ;;;
(if (setq ss (ssget "_X" '((0 . "INSERT"))))
   (repeat (setq i (sslength ss))
   (setq sn (ssname ss (setq i (1- i))))
   (setq bn (cdr (assoc 2 (entget sn))))
   (setq sn (tblobjname "BLOCK" bn))
   (while (setq sn (entnext sn))
       (if (eq "ATTDEF" (cdr (assoc 0 (setq e (entget sn)))))
         (setq l
                (cons
                  (list (strcat (cdr (assoc 2 e)) " = " (cdr (assoc 1 e)))
                  )
                  l
                )
                )
          )
   )
   (if l
       (progn
         (print (strcat "Block name =" bn))
         (foreach x l
         (print x)
         )
       )
   )
   (setq l nil)
   )
   )
(princ)
)

rodrigo_sjc_sp 发表于 2022-7-6 07:07:20

塔尔瓦特，
这正是我所需要的，我只会修改代码
在数据库中记录此信息。
谢谢大师。
罗德里戈

Tharwat 发表于 2022-7-6 07:13:59

 
太好了，不客气，罗德里戈。

Lee Mac 发表于 2022-7-6 07:19:02

我建议如下：
(defun c:list-atts ( / i o s )
   (if (setq s (ssget "_X" '((0 . "INSERT"))))
       (repeat (setq i (sslength s))
         (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
         (princ (strcat "\n\nBlock: \"" (vla-get-name o) "\": "))
         (foreach a (append (vlax-invoke o 'getattributes) (vlax-invoke o 'getconstantattributes))
               (princ (strcat "\n" (vla-get-tagstring a) " = " (vla-get-textstring a)))
         )
       )
   )
   (princ)
)
(vl-load-com) (princ)
页: 1 [2]
查看完整版本: 帮助列出块属性