Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
chiewater

Đếm Block thuộc tính!?!?!

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

Các bác có thể chỉ cách cho e đếm block thuộc tính trong bản vẽ này được k ạ ?

Em đã dùng thử lisp của bác Phamthanhbinh nhưng mà k có hiệu quả!!!

 

Lisp của bác ấy có dòng lệnh

Nhap ky tu dau cua block: Nhap ky tu duoi cua block: tức là nhập cái gì của Block có biến ạ? Cụ thể là Tag Prompt hay là Value ?

Em k rõ lắm về phần này vậy mong các bác chỉ giáo !!!!

Cám ơn các bác !!!

 

Đây là Bản vẽ của e:

http://www.cadviet.com/upfiles/2/bl.dwg

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

Lisp đếm block atrribute sưu tầm. Lệnh CAV.

 

;;-----------------=={ 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:CAV nil (c:CountAttributeValues))
(defun c:CountAttributeValues ( / _Dxf _Assoc++ _SumAttributes ss i alist )
  (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** This Version of AutoCAD Does not Support Tables **"))
    ((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 "\nPick Point for Table: ")))
      (LM:AddTable space (trans pt 1 0) "Attribute Totals"
        (cons '("Value" "Total")
          (vl-sort
            (mapcar
              (function
                (lambda ( pair )
                  (list (car pair) (itoa (cadr pair)))))
              alist)
            (function (lambda ( a b ) (< (strcase (car a)) (strcase (car b))))))))))
  (princ))
;;-------------------=={ Attribute Sum }==--------------------;;
;;  Sums numerical attributes of the same tag in a selection of attributed blocks. Displays result in AutoCAD Table object.
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
(defun c:AttSum ( / _assoc+ doc space ss n lst pt )
  (vl-load-com)
  (defun _assoc+ ( key value lst )
    ((lambda ( pair )
        (if pair
          (subst (list key (+ (cadr pair) value)) pair lst)
          (cons  (list key value) lst)))
      (assoc key lst)))
  (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** This Version of AutoCAD Does not Support Tables **"))
    ((and (ssget '((0 . "INSERT") (66 . 1)))
        (progn
          (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
            (mapcar
              (function
                (lambda ( attrib )
                  (if (setq n (distof (vla-get-TextString attrib)))
                    (setq lst (_assoc+ (vla-get-TagString attrib) n lst)))))
              (vlax-invoke obj 'GetAttributes)))
          (vla-delete ss)
          (setq lst (mapcar '(lambda ( x ) (list (car x) (rtos (cadr x)))) lst)))
        (setq pt (getpoint "\nPick Point for Table: ")))
      (LM:AddTable space (trans pt 1 0) "Attribute Totals"
        (cons '("Tag" "Total") (vl-sort lst '(lambda ( a b ) (< (strcase (car a)) (strcase (car b)))))))))
  (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))))
(princ)
 
  • Vote tăng 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

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

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×