Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
minhtu2004

[Nhờ chỉnh sửa]Lisp Bcount của cad

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

minhtu2004    35

-Hiện tại mình dùng lệnh Bcount của cad để thống kê Block, mình đã tìm trên diễn đàn có rất nhiều lisp thông kê Block nhưng hok phù hợp với yêu cầu của mình. Nên nhờ mọi người chỉnh dùm lisp Bcount của cad vì mình dùng thấy rất nhanh chỉ cần đánh lện Bcount và enter 2 lần hoặc chọn vùng là nó thống kê cho mình. Bây giờ mình chỉ muốn những cái thống kê chèn vào 1 table khi mình chọn 1 điểm tạo table và bảng đó như sau:

 (defun c:Bcount ( / ss flt a n lst)

(acet-error-init
(list nil T)
);acet-error-init

;build a filter of valid block names
(setq lst (acet-table-name-list (list "block" 1 4 16))) ;exclude anonymous and xref blocks
(setq n 0)
(repeat (length lst)
(setq a (nth n lst)
a (cons 2 a)
flt (cons a flt)
);setq
(setq n (+ n 1));setq
);repeat

(setq flt (append '((0 . "INSERT")
(-4 . " ")
flt
'((-4 . "OR>"))
);append
);setq
(acet-ss-clear-prev)
(princ "\nPress Enter to select all or...")

(if (setq ss (ssget))
(setq ss (ssget "_p" flt))
(setq ss (ssget "_x" flt))
);if
(if ss
(bns_count ss)
(princ "\nNo valid objects selected.")
);if

(acet-error-restore)
);defun c:count

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun bns_count ( ss / bna lst na e1 n a mx )


;get a list of all unique block names
(setq mx 1)
(setq n 0)
(repeat (sslength ss)
(setq na (ssname ss n)
e1 (entget na)
bna (cdr (assoc 2 e1))
mx (max mx (strlen bna))
);setq
(if (not (assoc bna lst))
(setq lst (cons (cons bna 1) lst))
(setq a (cdr (assoc bna lst))
a (+ a 1)
lst (subst (cons bna a) (assoc bna lst) lst)
);setq
);if
(setq n (+ n 1));setq
);repeat

(if lst
(progn
(setq mx (+ mx 5));setq
(princ (bns_count_format "Block" "Count" mx))
(setq a "\n")
(while (< (strlen a) (+ mx 7))
;; (setq a (strcat a "-"))
(setq a (acet-str-format "%1-" a))
);while
(princ a)
);progn then print header
);if
(setq n 0)
(repeat (length lst)
(setq a (nth n lst));setq
(princ (bns_count_format (car a) (itoa (cdr a)) mx))
(setq n (+ n 1));setq
);repeat
);defun bns_count

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun bns_count_format ( a b mx / )

(while (<= (strlen a) mx)
;; (setq a (strcat a "."))
(setq a (acet-str-format "%1." a))
);while
;; (setq a (strcat "\n" a)
(setq a (acet-str-format "\n%1%2" ab)
);defun bns_count_format


(princ)

 

Bảng có dòng tiêu đề là Bảng thông kê và tiếp theo xuống dòng là 2 cột Block và Count, cuối cùng là chèn thống kê vào.như hình sau:Untitled_zpse5cefacc.jpg

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
 

em load lisp của bác xong nó báo thế này,bác chỉ e cách khắc phục được không?

Command: ; error: extra cdrs in dotted pair on input

 

Command: ; error: extra cdrs in dotted pair on input

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  

×