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

[Yêu cầu] Lisp thống kê kích thước trong bản vẽ cad

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

Hi mọi người.Sau khi được bác Doan Van Ha cho cái lisp thống kê đoạn thẳng,mình sử dụng rất ok nhưng trong quá trình làm việc lại phát sinh 1 vấn đề mới: mình có nhiều bản vẽ (bản vẽ của khách hàng) mà trong mỗi bản vẽ có rất nhiều kích thước cần thống kê (giá trị và số lượng),mình muốn xin mọi người viết giùm mình cái lisp thống kê tất cả các kích thước trên sau đó xuất ra file excel thành 2 cột : giá trị và số lượng theo các yêu cầu sau:

- Cách xuất ra file excel tương tự như lisp thống kê đoạn thẳng.

- Các dim không biệt layer.

- Không phân biệt 2D hay 3D.

- Không phân biệt giả hay thật( miễn là dim thì được chọn).

- Các dim cùng giá trị thì được coi là như nhau.

Xin mọi người giúp mình nhé.

Cảm ơn mọi người trước nha.

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

Thật là ngại quá.Mình không rành về lisp nên chả biết làm thế nào để xuất qua excel cả,bạn sửa giúp mình với.Nhân tiện mình bạn sửa giùm lại cái lisp sao cho minh muốn chọn bao nhiêu dim thì chọn tùy ý chứ không thống kê 1 lần tất cả các dim trong bản vẽ bạn nhé

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

Hi mọi người.Sau khi được bác Doan Van Ha cho cái lisp thống kê đoạn thẳng,mình sử dụng rất ok nhưng trong quá trình làm việc lại phát sinh 1 vấn đề mới: mình có nhiều bản vẽ (bản vẽ của khách hàng) mà trong mỗi bản vẽ có rất nhiều kích thước cần thống kê (giá trị và số lượng),mình muốn xin mọi người viết giùm mình cái lisp thống kê tất cả các kích thước trên sau đó xuất ra file excel thành 2 cột : giá trị và số lượng theo các yêu cầu sau:

- Cách xuất ra file excel tương tự như lisp thống kê đoạn thẳng.

- Các dim không biệt layer.

- Không phân biệt 2D hay 3D.

- Không phân biệt giả hay thật( miễn là dim thì được chọn).

- Các dim cùng giá trị thì được coi là như nhau.

Xin mọi người giúp mình nhé.

Cảm ơn mọi người trước nha.

Tưởng Ketxu đã giúp và bạn đã làm được rồi chứ!

Hai ý màu đỏ: bạn giải thích cho mình rõ hơn tí.

1). Giả và thật là sao?

2). Cùng giá trị nghĩa là: chiều dài dim đo được là bằng nhau? giá trị text của dim (dù đã bị sửa) là bằng nhau? hay là gì gì nữa?

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

Cảm ơn bác Ha đã lưu ý tới em.Em xin giài thích luôn:

- Giả nghĩa là giá trị thật của dim(text) đã bị sửa.

- Cùng giá trị nghĩa là cùng giá trị text( dù đã bị sửa) như ý bác hỏi đó.

Chỉ vậy thôi,bác giúp em nhé.Nếu có gì e cần hỏi nữa thì lại làm phiền bác và mọi người nữa vậy.

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

Đây bạn ơi!

;Doan Van Ha - CADViet.com - Ngay 21/5/2012
;Muc dich: nhom cac doi tuong Dim cung Length, sau do xuat ra file.
(defun C:HA( / entlst lst fn pw)
(princ "\nChon cac doi tuong Dimension can xuat ra file...")
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "DIMENSION")))))))
(foreach ent entlst
 (if (= "" (cdr (assoc 1 (entget ent))))
  (setq lst (cons (rtos (cdr (assoc 42 (entget ent))) 2 4) lst))
  (setq lst (cons (cdr (assoc 1 (entget ent))) lst))))
(setq lst (LM:ListOccurrences lst))
(setq a lst)
(setq fn (getfiled "Chon file de xuat ket qua" "" "xls" 1))
(setq pw (open fn "w"))
(write-line (strcat "Chieu dai" "\t" "So luong") pw)
(foreach n lst
 (write-line (strcat (vl-prin1-to-string (car n)) "\t" (itoa (cdr n))) pw))
(close pw))
(defun LM:ListOccurrences (lst)
(if lst
 (cons
  (cons (car lst) (- (length lst) (length (vl-remove (car lst) (cdr lst)))))
  (LM:ListOccurrences (vl-remove (car lst) (cdr lst))))))

  • Vote tăng 5

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

Visual Lisp :

(defun c:tkd(/ lstval stp lst pw)
(setq stp 2) ;Dong nay quy dinh so le muon in ra
(cond ((ssget (list (cons 0 "DIMENSION")))
 (defun dimval (e / a)(if (= (setq a(vla-get-TextOverride e)) "")
  (rtos (vla-get-Measurement e) 2 stp)
  (rtos (distof a) 2 stp)))
 (vlax-for dObj (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
  (if (not (assoc (setq b (dimval dObj)) lst))
(setq lst (cons (cons b 1) lst))
(setq lst (subst (cons b (1+ (cdr (assoc b lst))))(assoc b lst) lst))
  )
 )
 (setq pw (open (getfiled "Chon file de xuat ket qua" "" "xls" 1) "w"))
  (write-line (strcat "Chieu dai" "\t" "So luong") pw)
  (mapcar '(lambda(x)(write-line (strcat (car x) (chr 9) (itoa (cdr x))) pw)) lst)  
 (close pw)
)
)
)

  • Vote tăng 7

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

- Các dim cùng giá trị thì được coi là như nhau.

 

Bác ketxu ơi. em muốn tách các giá trị dim(text) ra không gộp lại thì làm thế nào?

Mong bác giúp đỡ!

Thank!

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
(defun C:HA( / entlst gtri fn pw)
(princ "\nChon cac doi tuong Dimension can xuat ra file...")
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "DIMENSION")))))))
(setq fn (getfiled "Chon file de xuat ket qua" "" "xls" 1))
(setq pw (open fn "w"))
(write-line "Chieu dai" pw)
(foreach ent entlst
 (if (= "" (cdr (assoc 1 (entget ent))))
  (setq gtri (rtos (cdr (assoc 42 (entget ent))) 2 4))
  (setq gtri (cdr (assoc 1 (entget ent)))))
 (write-line (vl-prin1-to-string gtri) pw))
(close pw))

  • Vote tăng 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

 

Hề hề hề,

Bác DoanvanHa ơi, bác giải thich giùm sự khác nhau giữa:

(write-line (vl-prin1-to-string gtri) pw)

(write-line gtri pw)

 

Vì sao cần phải có hàm (vl-prin1-to-string .... ) ở đây vì theo mình hiểu thì bản thân hàm (cdr (assoc 1 (entget ent))) hoặc (rtos (cdr (assoc 42 (entget ent)))) đã trả về một string rồi mà mình thì rất sợ khi phải đụng tới mấy thằng vl- này bác ạ.....

  • 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

1). Vâng! Bác đúng! Tôi lấy lsp cũ sửa lại, dùng vl-prin1-to-string cho nhiều kiểu dữ liệu (str, real, int), nên ở lisp này không để ý mà sửa lại cho gọn hơn. Thanks!

2). Bác PTB ơi! Hãy can đảm lên, đừng sợ! Ngày xưa tôi cũng sợ như bác, nhưng dần đi với ma nhiều nên giờ bớt sợ ma và thậm chí còn yêu ma nữa cơ.

3). Các hàm vl-, vla-, vlax- (visuallisp) có nhiều cái hay hơn autolisp lắm bác ơi. Tặng bác 1 ví dụ trong rất nhiều ví dụ của David M. Stein:

Hàm gán color và layer của obj1 cho obj2.

4). Ngoài VD dưới đây cho thấy code autolisp rất dài, thì vấn đề tốc độ cũng đáng để mê tín visuallisp: nhiều pro lisp khẳng định rằng: visuallisp nhanh hơn autolisp nhiều lần (tất nhiên autolisp cũng có những ưu điểm riêng của nó).

;Dung Visuallisp:
(defun CopyLayerColor1 (obj1 obj2)
(vla-put-Layer obj2 (vla-get-Layer obj1))
(vla-put-Color obj2 (vla-get-Color obj1)))
;Dung Autolisp:
(defun CopyLayerColor2 (ent1 ent2 / elist1 elist2 lay1 col1)
(setq elist1 (entget ent1)
elist2 (entget ent2)
lay1 (cdr (assoc 8 elist1)))
(setq elist2 (subst (cons 8 lay1) (assoc 8 elist2) elist2))
(if (assoc 62 elist1)
(progn
(setq col1 (cdr (assoc 62 elist1)))
(if (assoc 62 elist2)
(setq elist2 (cons (cons 62 col1) elist2))
(setq elist2 (subst (cons 62 col1) (assoc 62 elist2) elist2)))))
(entmod elist2))

  • Vote tăng 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

Riêng việc chỉnh sửa entity thì dùng VL sướng hơn hẳn Autolisp vì k phải nhớ điều gì, nhớ mỗi hàm dump object là có hết ^^ Tuy nhiên VL nó cũng chỉ cung cấp cho chúng ta 1 số thuộc tính thôi, có cái mò hoài k thấy ^^

 

À, còn ví dụ của bác Hạ, ketxu sẽ viết :

 

(defun CopyLayerColor2 (e1 e2 / x)
(entmod (list
  (cons -1 e2)
  (assoc 8 (setq x (entget e1)))
  (cond ((assoc 62 x)) ((cons 62 256)))
 )
))

  • Vote tăng 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

Đây bạn ơi!

;Doan Van Ha - CADViet.com - Ngay 21/5/2012
;Muc dich: nhom cac doi tuong Dim cung Length, sau do xuat ra file.
(defun C:HA( / entlst lst fn pw)
(princ "\nChon cac doi tuong Dimension can xuat ra file...")
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "DIMENSION")))))))
(foreach ent entlst
 (if (= "" (cdr (assoc 1 (entget ent))))
  (setq lst (cons (rtos (cdr (assoc 42 (entget ent))) 2 4) lst))
  (setq lst (cons (cdr (assoc 1 (entget ent))) lst))))
(setq lst (LM:ListOccurrences lst))
(setq a lst)
(setq fn (getfiled "Chon file de xuat ket qua" "" "xls" 1))
(setq pw (open fn "w"))
(write-line (strcat "Chieu dai" "\t" "So luong") pw)
(foreach n lst
 (write-line (strcat (vl-prin1-to-string (car n)) "\t" (itoa (cdr n))) pw))
(close pw))
(defun LM:ListOccurrences (lst)
(if lst
 (cons
  (cons (car lst) (- (length lst) (length (vl-remove (car lst) (cdr lst)))))
  (LM:ListOccurrences (vl-remove (car lst) (cdr lst))))))

 

Xin chào cả nhà, mình thấy lisp của bạn Hà rất tuyệt! Mình cũng đang cần nó. Có cách nào mà không phải là chọn các Dim mà là chọn luôn đối tượng không hả bạn, như vậy mình đỡ phải Dim nữa!

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 mới học autocad thấy lisp này thực hiện được công việc mà e đang cần. Nhưng e ko biết sử dụng nó như thế nào. Bác nào có thể hướng dẫn e được không? Em cần thống kê các đoạn thẳng ra excel gồm chiều dài và số lượng. Theo các layer khác nhau thì khác nhau. Em xin cảm ơn

  • 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
Vào lúc 21/5/2012 tại 11:49, Doan Van Ha đã nói:

Đây bạn ơi!

 


;Doan Van Ha - CADViet.com - Ngay 21/5/2012
;Muc dich: nhom cac doi tuong Dim cung Length, sau do xuat ra file.
(defun C:HA( / entlst lst fn pw)
(princ "\nChon cac doi tuong Dimension can xuat ra file...")
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "DIMENSION")))))))
(foreach ent entlst
 (if (= "" (cdr (assoc 1 (entget ent))))
  (setq lst (cons (rtos (cdr (assoc 42 (entget ent))) 2 4) lst))
  (setq lst (cons (cdr (assoc 1 (entget ent))) lst))))
(setq lst (LM:ListOccurrences lst))
(setq a lst)
(setq fn (getfiled "Chon file de xuat ket qua" "" "xls" 1))
(setq pw (open fn "w"))
(write-line (strcat "Chieu dai" "\t" "So luong") pw)
(foreach n lst
 (write-line (strcat (vl-prin1-to-string (car n)) "\t" (itoa (cdr n))) pw))
(close pw))
(defun LM:ListOccurrences (lst)
(if lst
 (cons
  (cons (car lst) (- (length lst) (length (vl-remove (car lst) (cdr lst)))))
  (LM:ListOccurrences (vl-remove (car lst) (cdr lst))))))
 

 

Bạn ơi, bạn có thể thêm giúp mình 1 cột layer nữa không ạ. Mình cảm ơn ạ!

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  

×