Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
1 reply to this topic

#1 minhtu2004

minhtu2004

    biết lệnh chamfer

  • Members
  • PipPipPipPip
  • 219 Bài viết
Điểm đánh giá: 34 (tàm tạm)

Đã gửi 03 May 2013 - 01:29 PM

-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


  • 0

-Nhận thực hiện bản vẽ 3D bằng revit.
-Liên hệ: 01664793290.


#2 mrlonely1201

mrlonely1201

    biết zoom

  • Members
  • Pip
  • 12 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 06 May 2013 - 09:16 AM

 
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

  • 0