Lisp thống kê Block Attribute

Tháng 10 15, 2025

Xin chào các bác,

Hiện tại mình có dự án được tạo bằng 1 Block Attribute, chỉ thay đổi các tag name. Em muốn nhờ các bác viết em lisp thống kê mà vẫn giữ nguyên các tag name với ạ

Em đính kèm link bản vẽ

Link lisp đang sử dụng + file cad:

https://1drv.ms/f/c/6ab0a9a29c98ff9c/EsEz0UJgHtdNoCKc0ee1ofsB3uut1gkxRcieKuvuJ04oOA?e=1veIcu

Cảm ơn các bác

Tháng 10 15, 2025

Cái này không biết lisp có làm được không, cách làm trong .NET cũng đơn giản: tạo một block ẩn danh rồi chèn block cần thống kê vào block đó. Sau đó lấy btrId của block này cho vào table. Kể cả dynamic block đã thay đổi parameter cũng hiệu lực. (Xem tại diễn đàn t5 của autodesk forum).

Tháng 10 15, 2025

31 phút trước, cuongtk2 đã nói:

Cái này không biết lisp có làm được không, cách làm trong .NET cũng đơn giản: tạo một block ẩn danh rồi chèn block cần thống kê vào block đó. Sau đó lấy btrId của block này cho vào table. Kể cả dynamic block đã thay đổi parameter cũng hiệu lực. (Xem tại diễn đàn t5 của autodesk forum).

Oke cảm ơn bác, mình không biết nên hỏi thử.

Mình làm bên M&E, nên chỉ bị vài Block của hệ thống báo cháy, nếu có lisp thì bóc khối lượng tiện hơn. Còn không có thì mình vẫn xử lý được mà lâu hơn tí.

Tháng 10 16, 2025

Cái này lisp làm được, không cần tạo block ẩn danh mà sửa trực tiếp trên block chèn vào table.

Tháng 10 16, 2025

1 giờ trước, NTHAHT đã nói:

Cái này lisp làm được, không cần tạo block ẩn danh mà sửa trực tiếp trên block chèn vào table.

Bạn nói đúng, có hàm để set attribute vào cell.

Tháng 10 17, 2025

Vào lúc 16/10/2025 tại 10:48, NTHAHT đã nói:

Cái này lisp làm được, không cần tạo block ẩn danh mà sửa trực tiếp trên block chèn vào table.

Bạn có lisp này không gửi giúp mình nha.

Mình ko biết viết lisp

Tháng 10 17, 2025

3 giờ trước, anh.nngtuan đã nói:

Bạn có lisp này không gửi giúp mình nha.

Mình ko biết viết lisp

Bạn thử cái này xem có được không nhé.

(defun c:LEQ (/ blk_id blk_len blk_name blks cur_var ent h header_lsp height i
		 ins j len0 lst_blk msp pt row ss str tblobj width width1 width2 x y atts att_value att_tag first_att_tag blkdef obj attdef_id key)

(defun TxtWidth (val h msp / txt minp maxp)
  (setq txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) h))
  (vla-getBoundingBox txt 'minp 'maxp )
  (vla-Erase txt)
  (- (car (vlax-safearray->list maxp)) (car (vlax-safearray->list minp))) )

(defun GetOrCreateTableStyle (tbl_name / name namelst objtblsty objtblstydic tablst txtsty)
  (setq objTblStyDic (vla-item (vla-get-dictionaries *adoc) "ACAD_TABLESTYLE"))
  (foreach itm (vlax-for itm objTblStyDic
    (setq tabLst (append tabLst (list itm))))
    (if (not
      (vl-catch-all-error-p
        (setq name (vl-catch-all-apply 'vla-get-Name (list itm)))))
      (setq nameLst (append nameLst (list name))) ))
  (if (not (vl-position tbl_name nameLst))
    (vla-addobject objTblStyDic tbl_name "AcDbTableStyle"))
  (setq objTblSty (vla-item objTblStyDic tbl_name)
    TxtSty (variant-value (vla-getvariable *adoc "TextStyle")))
  (mapcar '(lambda (x) (vla-settextstyle objTblSty x TxtSty))
    (list acTitleRow acHeaderRow acDataRow) )
  (vla-setvariable *adoc "CTableStyle" tbl_name) )

(defun GetObjectID (obj)
  (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
    (vlax-invoke-method
      (setq Utility
        (cond
          (Utility)
          ((vla-get-Utility *adoc))))
      'GetObjectIdString obj :vlax-false )
    (vla-get-Objectid obj)))

; Main function with enhanced attribute handling
(if (setq ss (ssget (list (cons 0 "INSERT"))))
  (progn
    (vl-load-com)
    (setq i -1 len0 8 first_att_tag nil)
    (while (setq ent (ssname ss (setq i (1+ i))))
      (setq vla-ent (vlax-ename->vla-object ent)
            blk_name (vla-get-name vla-ent))
      (if (> (setq blk_len (strlen blk_name)) len0)
        (setq str blk_name len0 blk_len))
      (setq atts (vlax-invoke vla-ent 'GetAttributes))
      (if (> (length atts) 0)
        (progn
          (setq att_value (vla-get-TextString (car atts))
                att_tag (vla-get-TagString (car atts)))
          (if (not first_att_tag) (setq first_att_tag att_tag)))
        (setq att_value "" att_tag nil))
      (setq key (list blk_name att_value))
      (if (not (assoc key lst_blk))
        (setq lst_blk (cons (cons key 1) lst_blk))
        (setq lst_blk (subst (cons key (1+ (cdr (assoc key lst_blk))))
                             (assoc key lst_blk) lst_blk))))
    (setq lst_blk (vl-sort lst_blk '(lambda (x y)
      (if (= (car (car x)) (car (car y)))
        (string< (cadr (car x)) (cadr (car y)))
        (string< (car (car x)) (car (car y)))))))
    (setq cur_var (mapcar 'getvar '("DYNMODE" "DYNPROMPT")))
    (mapcar 'setvar '("DYNMODE" "DYNPROMPT") '(1 1))
    (initget "Yes No")
    (setq ins (getkword "\nInsert Block Symbol [Yes/No ] <yes> : "))
    (or ins (setq ins "Yes"))
    (mapcar 'setvar '("DYNMODE" "DYNPROMPT") cur_var)
    (or *h* (setq *h* (* (getvar "dimtxt") (getvar "dimscale"))))
    (initget 6)
    (setq h (getreal (strcat "\nEnter text height <" (rtos *h*) "> :")))
    (if h (setq *h* h) (setq h *h*))
    (setq *adoc (vla-get-ActiveDocument (vlax-get-acad-object))
          msp (vla-get-modelspace *adoc)
          blks (vla-get-blocks *adoc))
    (setq width1 (* 2 (TxtWidth "No." h msp))
          width (* 2 (TxtWidth "QUANTITY" h msp))
          height (* 2 h))
    (if str
      (setq width2 (* 1.5 (TxtWidth (strcase str) h msp)))
      (setq width2 width))
    (if (> h 3)
      (setq width (* (fix (/ width 10)) 10)
            width1 (* (fix (/ width1 10)) 10)
            width2 (* (fix (/ width2 10)) 10)
            height (* (fix (/ height 5)) 5)))
    (GetOrCreateTableStyle "CadViet")
    (setq pt (getpoint "\nSelect table placement :")
          TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 5 height width))
    (vla-put-regeneratetablesuppressed TblObj :vlax-true)
    (vla-SetColumnWidth TblObj 0 width1)
    (vla-SetColumnWidth TblObj 1 width2)
    (vla-put-vertcellmargin TblObj (* 0.75 h))
    (vla-put-horzcellmargin TblObj (* 0.75 h))
    (mapcar '(lambda (x) (vla-setTextHeight TblObj x h))
      (list acTitleRow acHeaderRow acDataRow))
    (mapcar '(lambda (x) (vla-setAlignment TblObj x 2))
      (list acTitleRow acHeaderRow acDataRow))
    (vl-catch-all-error-p (vl-catch-all-apply (function (lambda () (vla-MergeCells TblObj 0 0 0 3)))))
    (vla-setText TblObj 0 0 "LIST OF EQUIPMENT")
    (setq j -1 header_lsp (list "No." "DESCRIPTION" "UNITS" "QUANTITY" "SYMBOL"))
    (repeat (length header_lsp)
      (vla-setText TblObj 1 (setq j (1+ j)) (nth j header_lsp)))
    (setq row 2 i 1)
    (foreach item lst_blk
      (setq key (car item)
            blk_name (car key)
            att_value (cadr key)
            qty (cdr item)
            j -1)
      (mapcar '(lambda (x) (vla-setText TblObj row (setq j (1+ j)) x))
        (list (itoa i) blk_name "pcs" (itoa qty)))
      (if (= ins "Yes")
        (progn
          (vla-SetBlockTableRecordId TblObj row 4 (GetObjectID (vla-item blks blk_name)) :vlax-true)
          (if (and att_value (/= att_value "") first_att_tag)
            (progn
              (setq blkdef (vla-item blks blk_name)
                    attdef_id nil)
              (vlax-for obj blkdef
                (if (and (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
                         (= (strcase (vla-get-TagString obj)) (strcase first_att_tag)))
                  (setq attdef_id (GetObjectID obj))))
              (if attdef_id
                (vla-SetBlockAttributeValue TblObj row 4 attdef_id att_value))))))
      (vla-SetCellAlignment TblObj row 1 7)
      (vla-SetCellAlignment TblObj row 3 9)
      (setq row (1+ row) i (1+ i)))
    (vla-put-regeneratetablesuppressed TblObj :vlax-false)
    (vlax-release-object TblObj)))
  (princ))

Tháng 10 17, 2025

Mình chưa thử, nhưng sự nhiệt tình của bạn đã được mình đánh giá cao. Đã like.

Tháng 10 18, 2025

Vào lúc 15/10/2025 tại 14:20, anh.nngtuan đã nói:

Xin chào các bác,

Hiện tại mình có dự án được tạo bằng 1 Block Attribute, chỉ thay đổi các tag name. Em muốn nhờ các bác viết em lisp thống kê mà vẫn giữ nguyên các tag name với ạ

Em đính kèm link bản vẽ

Link lisp đang sử dụng + file cad:

https://1drv.ms/f/c/6ab0a9a29c98ff9c/EsEz0UJgHtdNoCKc0ee1ofsB3uut1gkxRcieKuvuJ04oOA?e=1veIcu

Cảm ơn các bác

Chèn att vào 1 cột riêng được không bạn: https://drive.google.com/file/d/1MkrAP-FEXAqjIYreV1rZqYDzkmM8_dwq/view?usp=sharing

Tháng 10 20, 2025

Vào lúc 17/10/2025 tại 13:59, Tap.Ve.Cad đã nói:

Bạn thử cái này xem có được không nhé.


(defun c:LEQ (/ blk_id blk_len blk_name blks cur_var ent h header_lsp height i
		 ins j len0 lst_blk msp pt row ss str tblobj width width1 width2 x y atts att_value att_tag first_att_tag blkdef obj attdef_id key)

(defun TxtWidth (val h msp / txt minp maxp)
  (setq txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) h))
  (vla-getBoundingBox txt 'minp 'maxp )
  (vla-Erase txt)
  (- (car (vlax-safearray->list maxp)) (car (vlax-safearray->list minp))) )

(defun GetOrCreateTableStyle (tbl_name / name namelst objtblsty objtblstydic tablst txtsty)
  (setq objTblStyDic (vla-item (vla-get-dictionaries *adoc) "ACAD_TABLESTYLE"))
  (foreach itm (vlax-for itm objTblStyDic
    (setq tabLst (append tabLst (list itm))))
    (if (not
      (vl-catch-all-error-p
        (setq name (vl-catch-all-apply 'vla-get-Name (list itm)))))
      (setq nameLst (append nameLst (list name))) ))
  (if (not (vl-position tbl_name nameLst))
    (vla-addobject objTblStyDic tbl_name "AcDbTableStyle"))
  (setq objTblSty (vla-item objTblStyDic tbl_name)
    TxtSty (variant-value (vla-getvariable *adoc "TextStyle")))
  (mapcar '(lambda (x) (vla-settextstyle objTblSty x TxtSty))
    (list acTitleRow acHeaderRow acDataRow) )
  (vla-setvariable *adoc "CTableStyle" tbl_name) )

(defun GetObjectID (obj)
  (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
    (vlax-invoke-method
      (setq Utility
        (cond
          (Utility)
          ((vla-get-Utility *adoc))))
      'GetObjectIdString obj :vlax-false )
    (vla-get-Objectid obj)))

; Main function with enhanced attribute handling
(if (setq ss (ssget (list (cons 0 "INSERT"))))
  (progn
    (vl-load-com)
    (setq i -1 len0 8 first_att_tag nil)
    (while (setq ent (ssname ss (setq i (1+ i))))
      (setq vla-ent (vlax-ename->vla-object ent)
            blk_name (vla-get-name vla-ent))
      (if (> (setq blk_len (strlen blk_name)) len0)
        (setq str blk_name len0 blk_len))
      (setq atts (vlax-invoke vla-ent 'GetAttributes))
      (if (> (length atts) 0)
        (progn
          (setq att_value (vla-get-TextString (car atts))
                att_tag (vla-get-TagString (car atts)))
          (if (not first_att_tag) (setq first_att_tag att_tag)))
        (setq att_value "" att_tag nil))
      (setq key (list blk_name att_value))
      (if (not (assoc key lst_blk))
        (setq lst_blk (cons (cons key 1) lst_blk))
        (setq lst_blk (subst (cons key (1+ (cdr (assoc key lst_blk))))
                             (assoc key lst_blk) lst_blk))))
    (setq lst_blk (vl-sort lst_blk '(lambda (x y)
      (if (= (car (car x)) (car (car y)))
        (string< (cadr (car x)) (cadr (car y)))
        (string< (car (car x)) (car (car y)))))))
    (setq cur_var (mapcar 'getvar '("DYNMODE" "DYNPROMPT")))
    (mapcar 'setvar '("DYNMODE" "DYNPROMPT") '(1 1))
    (initget "Yes No")
    (setq ins (getkword "\nInsert Block Symbol [Yes/No ] <yes> : "))
    (or ins (setq ins "Yes"))
    (mapcar 'setvar '("DYNMODE" "DYNPROMPT") cur_var)
    (or *h* (setq *h* (* (getvar "dimtxt") (getvar "dimscale"))))
    (initget 6)
    (setq h (getreal (strcat "\nEnter text height <" (rtos *h*) "> :")))
    (if h (setq *h* h) (setq h *h*))
    (setq *adoc (vla-get-ActiveDocument (vlax-get-acad-object))
          msp (vla-get-modelspace *adoc)
          blks (vla-get-blocks *adoc))
    (setq width1 (* 2 (TxtWidth "No." h msp))
          width (* 2 (TxtWidth "QUANTITY" h msp))
          height (* 2 h))
    (if str
      (setq width2 (* 1.5 (TxtWidth (strcase str) h msp)))
      (setq width2 width))
    (if (> h 3)
      (setq width (* (fix (/ width 10)) 10)
            width1 (* (fix (/ width1 10)) 10)
            width2 (* (fix (/ width2 10)) 10)
            height (* (fix (/ height 5)) 5)))
    (GetOrCreateTableStyle "CadViet")
    (setq pt (getpoint "\nSelect table placement :")
          TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 5 height width))
    (vla-put-regeneratetablesuppressed TblObj :vlax-true)
    (vla-SetColumnWidth TblObj 0 width1)
    (vla-SetColumnWidth TblObj 1 width2)
    (vla-put-vertcellmargin TblObj (* 0.75 h))
    (vla-put-horzcellmargin TblObj (* 0.75 h))
    (mapcar '(lambda (x) (vla-setTextHeight TblObj x h))
      (list acTitleRow acHeaderRow acDataRow))
    (mapcar '(lambda (x) (vla-setAlignment TblObj x 2))
      (list acTitleRow acHeaderRow acDataRow))
    (vl-catch-all-error-p (vl-catch-all-apply (function (lambda () (vla-MergeCells TblObj 0 0 0 3)))))
    (vla-setText TblObj 0 0 "LIST OF EQUIPMENT")
    (setq j -1 header_lsp (list "No." "DESCRIPTION" "UNITS" "QUANTITY" "SYMBOL"))
    (repeat (length header_lsp)
      (vla-setText TblObj 1 (setq j (1+ j)) (nth j header_lsp)))
    (setq row 2 i 1)
    (foreach item lst_blk
      (setq key (car item)
            blk_name (car key)
            att_value (cadr key)
            qty (cdr item)
            j -1)
      (mapcar '(lambda (x) (vla-setText TblObj row (setq j (1+ j)) x))
        (list (itoa i) blk_name "pcs" (itoa qty)))
      (if (= ins "Yes")
        (progn
          (vla-SetBlockTableRecordId TblObj row 4 (GetObjectID (vla-item blks blk_name)) :vlax-true)
          (if (and att_value (/= att_value "") first_att_tag)
            (progn
              (setq blkdef (vla-item blks blk_name)
                    attdef_id nil)
              (vlax-for obj blkdef
                (if (and (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
                         (= (strcase (vla-get-TagString obj)) (strcase first_att_tag)))
                  (setq attdef_id (GetObjectID obj))))
              (if attdef_id
                (vla-SetBlockAttributeValue TblObj row 4 attdef_id att_value))))))
      (vla-SetCellAlignment TblObj row 1 7)
      (vla-SetCellAlignment TblObj row 3 9)
      (setq row (1+ row) i (1+ i)))
    (vla-put-regeneratetablesuppressed TblObj :vlax-false)
    (vlax-release-object TblObj)))
  (princ))

Mình thử nó báo lỗi bạn:

"Select objects: Specify opposite corner: 172 found
Select objects: ; error: no function definition: STRING<"

Tháng 10 20, 2025

Vào lúc 18/10/2025 tại 18:37, tantbd44 đã nói:

Chèn att vào 1 cột riêng được không bạn: https://drive.google.com/file/d/1MkrAP-FEXAqjIYreV1rZqYDzkmM8_dwq/view?usp=sharing

Được bác ơi, chủ yếu mình cần đọc được chữ ATT.

Bác cho mình xin lisp này nha

Tháng 10 20, 2025

13 giờ trước, anh.nngtuan đã nói:

Được bác ơi, chủ yếu mình cần đọc được chữ ATT.

Bác cho mình xin lisp này nha

Bác cuongtk2 có share tool thống kê block đó bạn, tool đó quá đỉnh luôn, bạn tham khảo ở đây nhé:

Tháng 10 22, 2025

Vào lúc 20/10/2025 tại 21:41, tantbd44 đã nói:

Bác cuongtk2 có share tool thống kê block đó bạn, tool đó quá đỉnh luôn, bạn tham khảo ở đây nhé:

Đúng lisp mình cần rồi, test ngoài mong đợi.

Cảm ơn Bác tantbd44 rất nhiều.

Đăng nhập

Lisp thống kê Block Attribute

Các bài được khuyến nghị

anh.nngtuan 2

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

cuongtk2 473

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

anh.nngtuan 2

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

NTHAHT 124

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

cuongtk2 473

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

anh.nngtuan 2

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tap.Ve.Cad 23

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

cuongtk2 473

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

tantbd44 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

anh.nngtuan 2

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

anh.nngtuan 2

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

tantbd44 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

anh.nngtuan 2

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Tạo tài khoản

Đăng nhập

Diễn đàn

Download

Đào tạo CADViet

Browse