[Yêu cầu] Lisp lọc các số sau chữ L, rồi tính tổng.

[bach1212 4]

File đính kèm: http://www.cadviet.c...ua_khu_11_1.rar

Bản vẽ của e có các text ghi chú có nội dung: D600,L30 hay D800,L60

Đây là thông số đường kính và chiều dài của cống. Để thống kê chiều dài của 1 loại cống nào đó (D600 chẳng hạn) e phải cộng lần lượt các số như số 30 sau chữ L, nên rất mất thời gian. Hic hic...

Mong các bác viết giúp e lisp: tính tổng các số sau chữ L mỗi khi pick chọn vào từng text như trên, kết quả thể hiện trên dòng command hoặc trên màn hình

Lisp đưa ra lựa chọn:

1.Chọn các text cần tính: Người dùng sẽ pick chọn vào lần lượt các text như trên. (Text được thể hiện là đã chọn rồi, và chỉ tính 1 lần, để không bị nhầm lẫn nếu lỡ pick lại text đó lần nữa)

2.Kết quả cho trên thanh command hoặc màn hình.

3.Kết thúc lệnh

VD: có 3 text: D600,L30 D600,L40 D600,L50

Dùng lisp: kết quả được: 120

Mong tin các bác ah! Thanks nhìu ah!

[phamthanhbinh 3.146]

File đính kèm: http://www.cadviet.c...ua_khu_11_1.rar Bản vẽ của e có các text ghi chú có nội dung: D600,L30 hay D800,L60 Đây là thông số đường kính và chiều dài của cống. Để thống kê chiều dài của 1 loại cống nào đó (D600 chẳng hạn) e phải cộng lần lượt các số như số 30 sau chữ L, nên rất mất thời gian. Hic hic... Mong các bác viết giúp e lisp: tính tổng các số sau chữ L mỗi khi pick chọn vào từng text như trên, kết quả thể hiện trên dòng command hoặc trên màn hình Lisp đưa ra lựa chọn: 1.Chọn các text cần tính: Người dùng sẽ pick chọn vào lần lượt các text như trên. (Text được thể hiện là đã chọn rồi, và chỉ tính 1 lần, để không bị nhầm lẫn nếu lỡ pick lại text đó lần nữa) 2.Kết quả cho trên thanh command hoặc màn hình. 3.Kết thúc lệnh VD: có 3 text: D600,L30 D600,L40 D600,L50 Dùng lisp: kết quả được: 120 Mong tin các bác ah! Thanks nhìu ah!

Hề hề hề,

Bạn dùng thử cái này coi đã ưng ý chưa nhé.

Cái này được viết theo yêu cầu của người khác nên cách dùng có khác với cách bạn trình bày.

1/- Gõ lệnh tko

2/- Quét chọn toàn bộ vùng chứa các text mà bạn muốn tính.

3/- Nhập giá trị đường kính mà bạn muốn tính

4/- Lisp trả ra kết quả tổng chiều dài các đoạn ống có đường kính đã chọn và nằm trong vùng chọn của bạn.

5/- Nếu muốn lisp có thể thay thế giá trị này vào một text đã có trên bản vẽ của bạn.

 

Hãy dùng thử và nếu có ý kiến gì thì post lên mình sẽ sửa lại.

 

(defun c:tko ( / sst L DK n els )
(command "undo" "be")
(setq sst (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "chu_thich") (cons 1 "*L#*")))))
(setq L 0)
(setq DK (getstring "\n Nhap loai ong can tinh tong chieu dai: ")
         n (strlen DK))
(foreach en sst
(setq els (entget en))
(cond 
     ((= (substr (cdr (assoc 1 els)) 1 n)  DK)
       (setq L (+ L  (atof (substr (cdr (assoc 1 els)) (+ n 3))))) )  

     (T nil)
)
)
(alert (strcat "\n Tong chieu dai ong duong kinh " DK " la: "  (rtos L 2 2) "m"))   
(if (= (strcase (getstring "\n Ban muon chon text ghi ket qua <y or n>: ")) "Y")
    (progn
    (setq els (entget (car (entsel "\n Chon text can thay the "))))      
    (entmod (subst (cons 1 (rtos L 2 2)) (assoc 1 els) els))
    )
)  
(command "undo" "e")
(princ)
)

 

Chúc bạn vui...

[bach1212 4]

Oai, còn hơn cả mong đợi.......tuyệt cú mèo bác ah.

[Doan Van Ha 3.200]

Oai, còn hơn cả mong đợi.......tuyệt cú mèo bác ah.

Thử thêm cái này cho vui luôn:

(defun C:HA( / dk1 dk2 entlst kq str len)
(vl-load-com)
(setq dk1 (strcat "D" (itoa (getint "\nNhap duong kinh muon thong ke: "))))
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "TEXT") (1 . "D*#*`,L#*")))))))
(setq kq 0)
(foreach ent entlst
 (setq str (cdr (assoc 1 (entget ent))))
 (setq dk2 (trai_str str ",") len (phai_str (phai_str str ",") "L"))
 (if (equal dk1 dk2)
  (setq kq (+ kq (atof len)))))
(princ (strcat "Tong chieu dai ung voi " dk1 " la: " (rtos kq 2 2)))
(princ))
(defun TRAI_STR(str str1) (if (acet-str-find str1 str) (substr str 1 (- (acet-str-find str1 str) 1))))
(defun PHAI_STR(str str1) (if (TRAI_STR str str1) (substr str (+ 1 (strlen str1) (strlen (TRAI_STR str str1))))))

[bach1212 4]

hehe, lại 1 cao thủ ra tay tương trợ. thanks ah

[Tue_NV 3.912]

Thử thêm cái này cho vui luôn:

(defun C:HA( / dk1 dk2 entlst kq str len)
(setq dk1 (strcat "D" (itoa (getint "\nNhap duong kinh muon thong ke: "))))
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "TEXT") (1 . "D*#*,L#*")))))))
(setq kq 0)
(foreach ent entlst
 (setq str (cdr (assoc 1 (entget ent))))
 (setq dk2 (trai_str str ",") len (phai_str (phai_str str ",") "L"))
 (if (equal dk1 dk2)
  (setq kq (+ kq (atof len)))))
(princ (strcat "Tong chieu dai ung voi " dk1 " la: " (rtos kq 2 2)))
(princ))
;----- LÊy phÇn bªn Tr¸i str1 cña str (tr¶ vÒ chuçi bªn tr¸i hoÆc nil).
(defun TRAI_STR(str str1) (if (acet-str-find str1 str) (substr str 1 (- (acet-str-find str1 str) 1))))
;----- LÊy phÇn bªn Ph¶i str1 cña str (tr¶ vÒ chuçi bªn ph¶i hoÆc nil).
(defun PHAI_STR(str str1) (if (TRAI_STR str str1) (substr str (+ 1 (strlen str1) (strlen (TRAI_STR str str1))))))
(defun c:chon() (cadr (sssetfirst nil (ssget '((8 . "0"))))))

Dấu , là kí tự đặc biệt.

Trong trường hợp bạn viết (ssget '((0 . "TEXT") (1 . "D*#*,L#*"))) thì :

String : D400,L40 và string D400 cả string L40 đều được chọn

Nếu bạn viết như thế này (ssget '((0 . "TEXT") (1 . "D*#*',L#*"))) thì chỉ có string D400,L40 được chọn mà thôi.

Thêm kí tự ' trước kí tự ,

 

Nếu không khắc phục chổ này thì User chọn "lộn" thì code lisp lỗi ngay.

[Doan Van Ha 3.200]

Dấu , là kí tự đặc biệt.

Trong trường hợp bạn viết (ssget '((0 . "TEXT") (1 . "D*#*,L#*"))) thì :

String : D400,L40 và string D400 cả string L40 đều được chọn

Nếu bạn viết như thế này (ssget '((0 . "TEXT") (1 . "D*#*',L#*"))) thì chỉ có string D400,L40 được chọn mà thôi.

Thêm kí tự ' trước kí tự ,

Nếu không khắc phục chổ này thì User chọn "lộn" thì code lisp lỗi ngay.

Đúng là chọn nhầm. Nhưng nếu thử đặt dấu ' vào trước dấu , thì nó chỉ chọn mỗi thằng L40 à? Chưa hiểu có đặt nhầm không?

[Tue_NV 3.912]

Đúng là chọn nhầm. Nhưng nếu thử đặt dấu ' vào trước dấu , thì nó chỉ chọn mỗi thằng L40 à? Chưa hiểu có đặt nhầm không?

Bạn gõ phím lộn rồi, phím ` bên trái phím số 1, bên trên phím TAB ấy

Nó khác với phím ' nhé bạn

Bạn đọc thêm cái này trong hàm WCMATCH nhé!

 

Hình như mình gõ lộn phím trong bài viết trên. :D

[Doan Van Ha 3.200]

Bạn gõ phím lộn rồi, phím ` bên trái phím số 1, bên trên phím TAB ấy

Nó khác với phím ' nhé bạn

Bạn đọc thêm cái này trong hàm WCMATCH nhé!

OK! Bác cũng gõ nhầm nên tôi copy của bác nó mới bị. Đã hiểu. Thanks

[ketxu 2.984]

^^ Fixed

(defun c:test()
(alert (vl-princ-to-string
(apply '+
(mapcar '(lambda(x)(atof (vl-string-left-trim tmp (acet-dxf 1 (entget x)))))
       (acet-ss-to-list (ssget (list (cons 0 "TEXT")(cons 1 (setq tmp (strcat "D" (itoa (getint "\nD : ")) "`,L#*"))))))
)))))

[Doan Van Ha 3.200]

^^

(defun c:test()
(alert (vl-princ-to-string
(apply '+
(mapcar '(lambda(x)(atof (vl-string-trim tmp (acet-dxf 1 (entget x)))))
       (acet-ss-to-list (ssget (list (cons 0 "TEXT")(cons 1 (setq tmp (strcat "D" (itoa (getint "\nD : ")) "`,L#*"))))))
)))))

Bị lỗi rồi Ket ơi. Trích dẫn:

(vl-string-trim "D600,L" "D600,L11") => 11

(vl-string-trim "D600,L" "D600,L10") => 1

[ketxu 2.984]

Bị lỗi rồi Ket ơi. Trích dẫn:

(vl-string-trim "D600,L" "D600,L11") => 11

(vl-string-trim "D600,L" "D600,L10") => 1

Ý, thằng sờ tring trim này nhiêu khê quá, vậy đổi thành vl-string-left-trim ^^

[Tue_NV 3.912]

Ý, thằng sờ tring trim này nhiêu khê quá, vậy đổi thành vl-string-left-trim ^^

Đổi vậy, kết quả tính vẫn còn sai

KetXu test thử với text này là biết :

D600,L60 _____D600,L61______D600,L62.....

D400,L40_____D400,L41_______D400,L42.....

Nó trim luôn cả "#" giống nhau trong string D### và L##

(vl-string-left-trim "D600,L#*" "D600,L60") -> ""

và (vl-string-left-trim "D600,L" "D600,L60") -> ""

Ví dụ : D450,L45 -> vì lisp sẽ trim cái số 45 ở D450 và trim luôn cả số 45 ở L45. Kết quả sẽ là (atof "") -> 0

 

Cái này cũng giải thích vì sao lỗi mà bạn DVH phát hiện ở trên :

(vl-string-trim "D600,L" "D600,L10")

Lisp trim luôn số 0 giống nhau nên kết quả là 1

[ketxu 2.984]

Nguy hiểm vậy ^^ Thế thì lại quay ra substr từ chữ L vậy :) Thật ra 2 hàm này ketxu rất ít dùng, chưa biết là nó lại Trim theo những nguyên tắc khó lường vậy. Cảm ơn bác ĐVH và bác Tuệ :">

[Doan Van Ha 3.200]

Nguy hiểm vậy ^^ Thế thì lại quay ra substr từ chữ L vậy :) Thật ra 2 hàm này ketxu rất ít dùng, chưa biết là nó lại Trim theo những nguyên tắc khó lường vậy. Cảm ơn bác ĐVH và bác Tuệ :">

Nhiều khi nói ra thì hơi quê (mà quê thiệt!): tôi rất sợ dùng 3 hàm: vl-string-trim, vl-string-left-trim, vl-string-right-trim, vì cú pháp nó dễ nhầm lẫn.

Nhân tiện, chơi luôn cái lisp tính chung cho các loại đường kính luôn (cầu mong nó không lỗi!)

(defun C:HA( / entlst dialst)
(princ "\nChon tat ca doi tuong Text/Mtext can thong ke...")
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "TEXT,MTEXT") (1 . "D*#*`,L#*")))))))
(foreach ent entlst
 (setq dialst (cons (atoi (phai_str (trai_str (cdr (assoc 1 (entget ent))) ",") "D")) dialst)))
(setq dialst (vl-sort dialst '<))
(foreach dia dialst
 (princ (strcat "\nD" (itoa dia) " = " (rtos (HA dia entlst) 2 2)))
 (princ)))
(defun HA(dia lstent)	;muon code cua Ketxu. Thanks!
(apply '+ (mapcar '(lambda(x) (atof (if (wcmatch (acet-dxf 1 (entget x)) (strcat "D" (itoa dia) "`,L*")) (phai_str (acet-dxf 1 (entget x)) ",L") "0"))) entlst)))
(defun TRAI_STR(str str1) (if (acet-str-find str1 str) (substr str 1 (- (acet-str-find str1 str) 1))))
(defun PHAI_STR(str str1) (if (TRAI_STR str str1) (substr str (+ 1 (strlen str1) (strlen (TRAI_STR str str1))))))

P/S (13/4/2012): bổ sung mtext

[NguyenNgocSon 43]

Hề hề hề,

Bạn dùng thử cái này coi đã ưng ý chưa nhé.

Cái này được viết theo yêu cầu của người khác nên cách dùng có khác với cách bạn trình bày.

1/- Gõ lệnh tko

2/- Quét chọn toàn bộ vùng chứa các text mà bạn muốn tính.

3/- Nhập giá trị đường kính mà bạn muốn tính

4/- Lisp trả ra kết quả tổng chiều dài các đoạn ống có đường kính đã chọn và nằm trong vùng chọn của bạn.

5/- Nếu muốn lisp có thể thay thế giá trị này vào một text đã có trên bản vẽ của bạn.

 

Hãy dùng thử và nếu có ý kiến gì thì post lên mình sẽ sửa lại.

 

 (defun c:tko ( / sst L DK n els )(command "undo" "be")(setq sst (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "chu_thich") (cons 1 "*L#*")))))(setq L 0)(setq DK (getstring "\n Nhap loai ong can tinh tong chieu dai: ")          n (strlen DK))(foreach en sst(setq els (entget en))(cond   	((= (substr (cdr (assoc 1 els)) 1 n)  DK)        (setq L (+ L  (atof (substr (cdr (assoc 1 els)) (+ n 3))))) )             	(T nil)))(alert (strcat "\n Tong chieu dai ong duong kinh " DK " la: "  (rtos L 2 2) "m"))   (if (= (strcase (getstring "\n Ban muon chon text ghi ket qua <y or n>: ")) "Y") 	(progn 	(setq els (entget (car (entsel "\n Chon text can thay the "))))       	(entmod (subst (cons 1 (rtos L 2 2)) (assoc 1 els) els)) 	))  (command "undo" "e")(princ))

 

Chúc bạn vui...

Có thể nâng cấp cái lisp này như sau không bác?

Lisp chọn tất cả các đường kính D trong bản vẽ thống kê ra chiều dài và xuất ra file Excel (text) không?

Cám ơn !

[Tue_NV 3.912]

Có thể nâng cấp cái lisp này như sau không bác?

Lisp chọn tất cả các đường kính D trong bản vẽ thống kê ra chiều dài và xuất ra file Excel (text) không?

Cám ơn !

Tue_NV thấy là có kết quả rồi thì chỉ việc Xuất kết quả đó ra Excel (file *.csv, *xls) là điều hoàn toàn có thể.

Ngọc Sơn, bạn đã biết đôi chút về LISP, sao bạn không tự chính tay mình thử làm luôn?

Code xuất file cũng đã có trên diễn đàn rồi.

Hãy thử làm đi bạn. Làm xong thấy khoái lắm bạn à. :)

[Doan Van Ha 3.200]

Có thể nâng cấp cái lisp này như sau không bác?

Lisp chọn tất cả các đường kính D trong bản vẽ thống kê ra chiều dài và xuất ra file Excel (text) không?

Cám ơn !

1). Việc xuất file thì bác Tue_NV đã động viên bạn tự làm rồi. Mà nên làm bạn ạ, dựa vào số liệu có được thì xuất không có gì khó đâu.

2). Lisp của tôi ở trang #15 cho phép chọn tất cả đường kính. Bạn ghé qua xem.

3). Tôi hiểu bản chất của loại bản vẽ này: trên nó chỉ có rất ít các loại đường kính, nên dòm bằng F2 có khi tiện hơn xuất file đấy!

[duy782006 1.550]

Đề nghị bác Hà không dùng từ "dòm" đấy là bản quyền của Duy782006 hé hé. Xờ pôm phát ^-^

[phamthanhbinh 3.146]

Có thể nâng cấp cái lisp này như sau không bác?

Lisp chọn tất cả các đường kính D trong bản vẽ thống kê ra chiều dài và xuất ra file Excel (text) không?

Cám ơn !

 

Có thể nâng cấp cái lisp này như sau không bác?

Lisp chọn tất cả các đường kính D trong bản vẽ thống kê ra chiều dài và xuất ra file Excel (text) không?

Cám ơn !

Hề hề hề.

Hoàn toàn có thể bạn ạ. Bạn hãy thử ra tay xem như các bác khác đã nói. Có gì khó khăn hãy post lên anh em củng trao đổi. Việc tách các nhòm đường kính khác nhau bạn có thể dùng hàm điều kiện cond nếu như biết trước số lượng đường kính cần thống kê, hoặc bạn có thể dùng vòng lặp để tách riêng từng nhóm rồi thống kê.

Chúc bạn thành công.

[bach1212 4]

Nhiều khi nói ra thì hơi quê (mà quê thiệt!): tôi rất sợ dùng 3 hàm: vl-string-trim, vl-string-left-trim, vl-string-right-trim, vì cú pháp nó dễ nhầm lẫn.

Nhân tiện, chơi luôn cái lisp tính chung cho các loại đường kính luôn (cầu mong nó không lỗi!)

(defun C:HA( / entlst dialst)
(princ "\nChon tat ca doi tuong can thong ke...")
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "TEXT") (1 . "D*#*`,L#*")))))))
(foreach ent entlst
 (setq dialst (cons (atoi (phai_str (trai_str (cdr (assoc 1 (entget ent))) ",") "D")) dialst)))
(setq dialst (vl-sort dialst '<))
(foreach dia dialst
 (princ (strcat "\nD" (itoa dia) " = " (rtos (HA dia entlst) 2 2)))
 (princ)))
(defun HA(dia lstent)	;muon code cua Ketxu. Thanks!
(apply '+ (mapcar '(lambda(x) (atof (if (wcmatch (acet-dxf 1 (entget x)) (strcat "D" (itoa dia) "`,L*")) (phai_str (acet-dxf 1 (entget x)) ",L") "0"))) entlst)))
(defun TRAI_STR(str str1) (if (acet-str-find str1 str) (substr str 1 (- (acet-str-find str1 str) 1))))
(defun PHAI_STR(str str1) (if (TRAI_STR str str1) (substr str (+ 1 (strlen str1) (strlen (TRAI_STR str str1))))))

E thay tất cả các kí tự "D" trong code của bác thành "B" mà sao nó không nhận đối tượng có dạng tượng tự: D400,L30 là B400,L30?

Vì bản vẽ của e cần thống kê cả dạng B400,L30 này nữa. Mong bác chỉ giáo

[Tue_NV 3.912]

E thay tất cả các kí tự "D" trong code của bác thành "B" mà sao nó không nhận đối tượng có dạng tượng tự: D400,L30 là B400,L30?

Vì bản vẽ của e cần thống kê cả dạng B400,L30 này nữa. Mong bác chỉ giáo

Bạn đã thay code như thế nào? Phiền bạn post lên code mà bạn đã sửa lên đây nhé.

Chúc vui!

[Doan Van Ha 3.200]

E thay tất cả các kí tự "D" trong code của bác thành "B" mà sao nó không nhận đối tượng có dạng tượng tự: D400,L30 là B400,L30?

Vì bản vẽ của e cần thống kê cả dạng B400,L30 này nữa. Mong bác chỉ giáo

Coi chừng bạn replace nhầm. Gởi code lên xem đi!

Trong lisp có 4 chữ D. Bạn lần lượt thay từng chữ D bởi B thì khỏi sợ nhầm.

[bach1212 4]

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=62723&pid=193865&st=0entry193865
(defun C:tgr( / entlst dialst)
(princ "\nChon tat ca doi tuong can thong ke...")
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "TEXT") (1 . "B*#*`,L#*")))))))
(foreach ent entlst
 (setq dialst (cons (atoi (phai_str (trai_str (cdr (assoc 1 (entget ent))) ",") "B")) dialst)))
(setq dialst (vl-sort dialst '<))
(foreach dia dialst
 (princ (strcat "\nB" (itoa dia) " = " (rtos (HA dia entlst) 2 2)))
 (princ)))
(defun HA(dia lstent) ;muon code cua Ketxu. Thanks!
(apply '+ (mapcar '(lambda(x) (atof (if (wcmatch (acet-dxf 1 (entget x)) (strcat "B" (itoa dia) "`,L*")) (phai_str (acet-dxf 1 (entget x)) ",L") "0"))) entlst)))
(defun TRAI_STR(str str1) (if (acet-str-find str1 str) (substr str 1 (- (acet-str-find str1 str) 1))))
(defun PHAI_STR(str str1) (if (TRAI_STR str str1) (substr str (+ 1 (strlen str1) (strlen (TRAI_STR str str1))))))

4 chữ D đã được thay = 4 chữ B

Bác xem sao??

[Doan Van Ha 3.200]

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=62723&pid=193865&st=0entry193865
(defun C:tgr( / entlst dialst)
(princ "\nChon tat ca doi tuong can thong ke...")
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "TEXT") (1 . "B*#*`,L#*")))))))
(foreach ent entlst
 (setq dialst (cons (atoi (phai_str (trai_str (cdr (assoc 1 (entget ent))) ",") "B")) dialst)))
(setq dialst (vl-sort dialst '<))
(foreach dia dialst
 (princ (strcat "\nB" (itoa dia) " = " (rtos (HA dia entlst) 2 2)))
 (princ)))
(defun HA(dia lstent) ;muon code cua Ketxu. Thanks!
(apply '+ (mapcar '(lambda(x) (atof (if (wcmatch (acet-dxf 1 (entget x)) (strcat "B" (itoa dia) "`,L*")) (phai_str (acet-dxf 1 (entget x)) ",L") "0"))) entlst)))
(defun TRAI_STR(str str1) (if (acet-str-find str1 str) (substr str 1 (- (acet-str-find str1 str) 1))))
(defun PHAI_STR(str str1) (if (TRAI_STR str str1) (substr str (+ 1 (strlen str1) (strlen (TRAI_STR str str1))))))

4 chữ D đã được thay = 4 chữ B

Bác xem sao??

Bạn đã thay đúng. Bạn thay TEXT bởi *TEXT để dùng cho mtext luôn xem sao. Tôi test thì ok. Nếu không được nữa thì post bản vẽ lên thôi.