属性块怎么统计的呢？

墨雨尘峰

只有普通块统计的，属性快统计不知道有没有，找了一圈也没找到

vitalgg

如果无法播放，请点击此处在新窗口打开

tranque

源泉设计，imini建筑工具箱都内置了你说的这个功能

清水白粥

系统自带et工具，  attout

ㄘ丶转裑ㄧ灬

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;********************统计属性文字
;;;;;;;;;******(单个属性块有多个属性的请用CAD的数据提取：dataextraction)
;;;;;;;;;;;************************(TAB表格到EXCEL命令：TABLEEXPORT)
;;
;;
;;-----------------=={ Count Attribute Values }==-------------;;
;;                                                            ;;
;;  Counts the number of occurrences of attribute values in a ;;
;;  selection of attributed blocks. Displays result in an     ;;
;;  AutoCAD Table object.                                     ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:HT_704 nil (c:CountAttributeValues))

(defun c:CountAttributeValues ( / _Dxf _Assoc++ _SumAttributes ss i alist )
;;;;新建表格样式
(defun AddTextStyle (TxtStyleName Font doc / *Textstyles* NewStyle)
(and (setq *Textstyles*(vla-get-TextStyles doc))
(not(collection-item-p *Textstyles* TxtStyleName))
(setq NewStyle(vla-add *Textstyles* TxtStyleName))
(vla-setFont NewStyle Font :vlax-false :vlax-false 0 0)
)
NewStyle
)
(defun collection-item-p (collection Item)
(cond
((vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list Collection Item) ) ) nil )
(t(vla-item Collection Item))
)
)

(setq *acad* (vlax-get-acad-object) *adoc* (vla-get-activedocument *acad*) *Layouts* (vla-get-Layouts *adoc*) *blocks* (vla-get-Blocks *adoc*) )
(cond
((collection-item-p (vla-get-dictionaries *adoc*) "Table-Q" ) nil)
(T
(AddTextStyle "Q_Arial" "ARIAL" *adoc*)
(setq *tableStyle* (vla-item (vla-get-dictionaries *adoc*) "acad_tablestyle" )
          *tabla* (vla-addObject *tableStyle* "Table-Q" "AcDbTableStyle" )
)
(vla-SetTextHeight *tabla* acTitleRow 5.0);;;设置标题区字高
(vla-SetTextHeight *tabla* acHeaderRow 5.0);;;设置表头区字高
(vla-SetTextHeight *tabla* acDataRow 5.0);;;设置数据区字高
(vla-SetTextStyle *tabla* acHeaderRow "Q_Arial")
(vla-SetTextStyle *tabla* acTitleRow "Q_Arial")
(vla-SetTextStyle *tabla* acDataRow "Q_Arial")
(vla-put-Vertcellmargin *tabla* 2) ;;文字与边框距离，垂直
(vla-put-Horzcellmargin *tabla* 2) ;;文字与边框距离，水平
)
)
;;;;;;;;;;
(command "CTABLESTYLE" "Table-Q")




  (defun _Dxf ( key alist ) (cdr (assoc key alist)))

  (defun _Assoc++ ( key alist )
    (
      (lambda ( pair )
        (if pair
          (subst (list key (1+ (cadr pair))) pair alist)
          (cons  (list key 1) alist)
        )
      )
      (assoc key alist)
    )
  )

  (defun _SumAttributes ( entity alist )
    (while
      (not
        (eq "SEQEND"
          (_dxf 0
            (entget
              (setq entity
                (entnext entity)
              )
            )
          )
        )
      )
      (setq alist (_Assoc++ (_Dxf 1 (reverse (entget entity))) alist))
    )
  )

  (cond
    (
      (not
        (vlax-method-applicable-p
          (setq space
            (vlax-get-property
              (setq doc
                (vla-get-ActiveDocument (vlax-get-acad-object))
              )
              (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)
            )
          )
          'AddTable
        )
      )

      (princ "\n** 这个版本的AutoCAD不支持此功能 **")
    )
    (
      (and (setq ss (ssget '((0 . "INSERT") (66 . 1))))
        (repeat (setq i (sslength ss))
          (setq alist (_SumAttributes (ssname ss (setq i (1- i))) alist))
        )
        (setq pt (getpoint "\n指定表格左上角所在点: "))
      )
     
      (LM:AddTable space (trans pt 1 0) "板块统计"
        (cons '("编号" "数量")
          (vl-sort
            (mapcar
              (function
                (lambda ( pair )
                  (list (car pair) (itoa (cadr pair)))
                )
              )
              alist
            )
            (function (lambda ( a b ) (< (strcase (car a)) (strcase (car b)))))
          )
        )
      )
    )
  )
(setq xzlast(entlast))
(setvar "cmdecho" 0)
(command ".scale" xzlast "" pt 200);;;把表格放大200倍
(princ "\nTab表格转为Excel命令:TabLeexport")
  (princ)
)

;;---------------------=={ Add Table }==----------------------;;
;;                                                            ;;
;;  Creates a VLA Table Object at the specified point,        ;;
;;  populated with title and data                             ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  space - VLA Block Object                                  ;;
;;  pt    - Insertion Point for Table                         ;;
;;  title - Table title                                       ;;
;;  data  - List of data to populate the table                ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Table Object                                ;;
;;------------------------------------------------------------;;

(defun LM:AddTable ( space pt title data / _itemp ) (vl-load-com)

  (defun _itemp ( collection item )
    (if
      (not
        (vl-catch-all-error-p
          (setq item
            (vl-catch-all-apply 'vla-item (list collection item))
          )
        )
      )
      item
    )
  )

  (
    (lambda ( table ) (vla-put-StyleName table (getvar 'CTABLESTYLE)) (vla-SetText table 0 0 title)
      (
        (lambda ( row )
          (mapcar
            (function
              (lambda ( rowitem ) (setq row (1+ row))
                (
                  (lambda ( column )
                    (mapcar
                      (function
                        (lambda ( item )
                          (vla-SetText table row
                            (setq column (1+ column)) item
                          )
                        )
                      )
                      rowitem
                    )
                  )
                  -1
                )
              )
            )
            data
          )
        )
        0
      )
      table
    )
    (
      (lambda ( textheight )
        (vla-AddTable space (vlax-3D-point pt) (1+ (length data)) (length (car data)) (* 1.8 textheight)
          (* textheight
            (apply 'max
              (cons (/ (strlen title) (length (car data)))
                (mapcar 'strlen (apply 'append data))
              )
            )
          )
        )
      )
      (vla-getTextHeight
        (_itemp
          (_itemp
            (vla-get-Dictionaries
              (vla-get-ActiveDocument (vlax-get-acad-object))
            )
            "ACAD_TABLESTYLE"
          )
          (getvar 'CTABLESTYLE)
        )
        acDataRow
      )
    )
  )
)

664571221

vitalgg 发表于 2024-5-7 18:14

牛逼厉害啊

magicheno

感谢大佬分享