Lisp tính tổng các text

[vuanhdung 0]

em muon co lisp tính tổng được các chữ số trong bản vễ khi mình chọn đó, cac ban giup em voi em dang rat can. thank cac bac nhe

[tienlagiay_dxt 186]

em muon co lisp tính tổng được các chữ số trong bản vễ khi mình chọn đó, cac ban giup em voi em dang rat can. thank cac bac nhe

Đây là code, mình lấy trên diễn đàn, bạn dùng thử xem

 

;;;-----------------------------------------

(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))

;;;-----------------------------------------

(defun FilObj(ss1 MyType / ss2 i e)

(setq ss2 (ssadd) i 0)

(repeat (sslength ss1)

(setq e (ssname ss1 i) i (1+ i))

(if (CheckObj e MyType) (ssadd e ss2) )

)

(eval ss2)

)

;;;-----------------------------------------

(defun SelData( / OK)

(setq OK nil)

(while (not OK)

(prompt "\tChon cac text can tinh:")

(setq ss (FilObj (ssget) "TEXT"))

(if (> (sslength ss) 0) (setq OK T) (princ "\nDoi tuong chon khong phai text"))

)

)

;;;-----------------------------------------

(defun WriteRes(kq / OK e data)

(setq OK nil)

(while (not OK)

(setq e (car (entsel "\tChon text ghi ket qua:")))

(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text"))

)

(entmod (subst (cons 1 (rtos kq)) (assoc 1 (setq data (entget e))) data))

(princ)

)

;;;-----------------------------------------

(defun C:MUL( / i m e ss)

(SelData) (setq i 0 m 1.0)

(repeat (sslength ss) (setq e (ssname ss i) i (1+ i) m (* m (atof (cdr (assoc 1 (entget e)))))))

(WriteRes m)

)

;;;-----------------------------------------

(defun C:SUM( / i s e ss)

(SelData) (setq i 0 s 0.0)

(repeat (sslength ss) (setq e (ssname ss i) i (1+ i) s (+ s (atof (cdr (assoc 1 (entget e)))))))

(WriteRes s)

)

;;;-----------------------------------------

[duong_nguyen411 0]

Đây là code, mình lấy trên diễn đàn, bạn dùng thử xem

 

;;;-----------------------------------------

(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))

;;;-----------------------------------------

(defun FilObj(ss1 MyType / ss2 i e)

(setq ss2 (ssadd) i 0)

(repeat (sslength ss1)

(setq e (ssname ss1 i) i (1+ i))

(if (CheckObj e MyType) (ssadd e ss2) )

)

(eval ss2)

)

;;;-----------------------------------------

(defun SelData( / OK)

(setq OK nil)

(while (not OK)

(prompt "\tChon cac text can tinh:")

(setq ss (FilObj (ssget) "TEXT"))

(if (> (sslength ss) 0) (setq OK T) (princ "\nDoi tuong chon khong phai text"))

)

)

;;;-----------------------------------------

(defun WriteRes(kq / OK e data)

(setq OK nil)

(while (not OK)

(setq e (car (entsel "\tChon text ghi ket qua:")))

(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text"))

)

(entmod (subst (cons 1 (rtos kq)) (assoc 1 (setq data (entget e))) data))

(princ)

)

;;;-----------------------------------------

(defun C:MUL( / i m e ss)

(SelData) (setq i 0 m 1.0)

(repeat (sslength ss) (setq e (ssname ss i) i (1+ i) m (* m (atof (cdr (assoc 1 (entget e)))))))

(WriteRes m)

)

;;;-----------------------------------------

(defun C:SUM( / i s e ss)

(SelData) (setq i 0 s 0.0)

(repeat (sslength ss) (setq e (ssname ss i) i (1+ i) s (+ s (atof (cdr (assoc 1 (entget e)))))))

(WriteRes s)

)

;;;-----------------------------------------

 

Bác ơi dùng thế nào mà em không chọn đc text số, nó toàn báo "Doi tuong chon khong phai text Chon cac text can tinh:" thôi

[Nguyen Hoanh 4.663]

Bác ơi dùng thế nào mà em không chọn đc text số, nó toàn báo "Doi tuong chon khong phai text Chon cac text can tinh:" thôi

Có thể đối tượng của bạn là mtext,

bạn hãy dùng lệnh explode để phá vỡ nó thành text trước khi dùng lệnh.

[hoai46ctt 33]

Tương tự như lisp tính tổng, mình muốn có lisp tích các text khi được chọn, các bác giúp mình với, thanks.

[Tue_NV 3.912]

Tương tự như lisp tính tổng, mình muốn có lisp tích các text khi được chọn, các bác giúp mình với, thanks.

Trong đoạn code ở trên của ban tienlagiay có lệnh MUL là lệnh tính tích các text khi được chọn rồi đấy.

[xuanhai 6]

Trong đoạn code ở trên của ban tienlagiay có lệnh MUL là lệnh tính tích các text khi được chọn rồi đấy.

Sao không thấy tính hiệu(-) nhỉ?

[Tue_NV 3.912]

Sao không thấy tính hiệu(-) nhỉ?

Bạn xem ở đây nhé : http://www.cadviet.com/forum/index.php?showtopic=205&st=1300

[tien2005 241]

mình đánh lệnh là j vậy

 Bạn hãy đọc bài số 1 ở đây

http://www.cadviet.com/forum/topic/1787-huong-dan-su-dung-ma-lisp/

[trinhngoctri 0]

cảm ơn bạn 

tien2005 nhiều 

[vsy 0]

Nhờ mấy A viết dùm lisp theo nội dung :

Ví dụ:

-Trong bản vẽ có nhiều text, Mtext, như: 1P56(5m), 1P56(3m), 2P110+2P56(3m), 2P110+2P56(2m)… sau khi dùng Polyline bao quang các text trên nó tính ra bảng thống kê khối lượng có 4 cột như sau:

1) Stt.(1,2,3...)

2) Tên text: (1P56; 2P110+2P56...)

3) Đơn vị: (m)

4) Khối lượng: (khối lượng là tổng số trong ngoặc tương ứng  với các text. Ví dụ: 1P56:8; 2P110+2P56: 5).

 

Và sau đó xuất ra Excel.

 

Xin cảm ơn!http://www.cadviet.com/upfiles/6/92823_new_block_2.dwg

[Tot77 508]

Cái này xuất ra excel file csv thì ok, còn lập bảng kẻ line thì chỉ viết ra kết quả thôi.

 

(defun c:ton(/ B1 B2 B3 FILE LI N SS TM VT X)
(setq ss (ssget '((0 . "TEXT")))
li nil
file (open (strcat (getvar "dwgprefix") "1.csv") "a")
v0 (ssname ss 0)
n 0
dd (getpoint "\nVi tri dat bang:"))
 
(foreach v (mapcar '(lambda(x) (cdr (assoc 1 (entget x))))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(if (and (setq vt (vl-string-search "(" v)) (vl-string-search ")" v))
(progn
(setq b1 (substr v 1 (1- vt))
b2 (substr v (+ 2 vt))
b3 (vl-list->string (vl-remove-if '(lambda(x) (or (= 41 x) (<= 48 x 57))) (vl-string->list b2)))
)
(if (setq tm (assoc b1 li))
(setq li (subst (cons b1 (+ (cdr tm) (atof b2))) tm li))
(setq li (cons (cons b1 (atof b2)) li))
)
)
)
)
(foreach v li
(entmake (list (cons 0 "TEXT") (cons 10 dd) (cons 11 dd) (cons 40 (cdr (assoc 40 (entget v0)))) (cons 8 (cdr (assoc 8 (entget v0))))
(cons 41 (cdr (assoc 41 (entget v0)))) (cons 7 (cdr (assoc 7 (entget v0))))
(cons 72 (cdr (assoc 72 (entget v0)))) (cons 73 (cdr (assoc 73 (entget v0))))
(cons 1 (strcat (itoa (setq n (1+ n))) "\t\t\t" (car v) "\t\t\t" (strcase b3) "\t\t\t" (rtos (cdr v))))))
(write-line (strcat (itoa n) "," (car v) "," (strcase b3) "," (rtos (cdr v))) file)
(setq dd (polar dd (* 1.5 pi) (* 2 (cdr (assoc 40 (entget v0))))))
) 
(close file)
)

[vsy 0]

Cảm ơn A Tot77 rất nhiều.

A đã giải quyết dùm e được vấn đề quang trọng nhất là thống kê khối lương.

A có thể giúp dùm e sửa thêm yêu cầu như sau:

- Text thống kê chia ra thành 4 cột (Thành 4 text riêng biệt).

- Hướng dẫn Cách xuất ra file Excel. 

 

E chưa rành về cad lắm nên Anh thông cảm.

[enix 3]

Đây là code, mình lấy trên diễn đàn, bạn dùng thử xem

 

;;;-----------------------------------------

(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))

;;;-----------------------------------------

(defun FilObj(ss1 MyType / ss2 i e)

(setq ss2 (ssadd) i 0)

(repeat (sslength ss1)

(setq e (ssname ss1 i) i (1+ i))

(if (CheckObj e MyType) (ssadd e ss2) )

)

(eval ss2)

)

;;;-----------------------------------------

(defun SelData( / OK)

(setq OK nil)

(while (not OK)

(prompt "\tChon cac text can tinh:")

(setq ss (FilObj (ssget) "TEXT"))

(if (> (sslength ss) 0) (setq OK T) (princ "\nDoi tuong chon khong phai text"))

)

)

;;;-----------------------------------------

(defun WriteRes(kq / OK e data)

(setq OK nil)

(while (not OK)

(setq e (car (entsel "\tChon text ghi ket qua:")))

(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text"))

)

(entmod (subst (cons 1 (rtos kq)) (assoc 1 (setq data (entget e))) data))

(princ)

)

;;;-----------------------------------------

(defun C:MUL( / i m e ss)

(SelData) (setq i 0 m 1.0)

(repeat (sslength ss) (setq e (ssname ss i) i (1+ i) m (* m (atof (cdr (assoc 1 (entget e)))))))

(WriteRes m)

)

;;;-----------------------------------------

(defun C:SUM( / i s e ss)

(SelData) (setq i 0 s 0.0)

(repeat (sslength ss) (setq e (ssname ss i) i (1+ i) s (+ s (atof (cdr (assoc 1 (entget e)))))))

(WriteRes s)

)

;;;-----------------------------------------

Xin lỗi đào mộ nhưng có bác nào biết cách chỉnh lại xuất kết quả là không có thập phân không, mình cộng giá trị tròn mà xuất giá trị nó lấy tới 4 số thập phân .0000

[Doan Van Ha 3.190]

Có biết!

[jangboko 10]

Có biết!

bác trả lời đúng trọng tâm luôn, không thừa cũng không thiếu,

[tuongthi120112 0]

 

Cái này xuất ra excel file csv thì ok, còn lập bảng kẻ line thì chỉ viết ra kết quả thôi.

(defun c:ton(/ B1 B2 B3 FILE LI N SS TM VT X)
(setq ss (ssget '((0 . "TEXT")))
li nil
file (open (strcat (getvar "dwgprefix") "1.csv") "a")
v0 (ssname ss 0)
n 0
dd (getpoint "\nVi tri dat bang:"))
 
(foreach v (mapcar '(lambda(x) (cdr (assoc 1 (entget x))))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(if (and (setq vt (vl-string-search "(" v)) (vl-string-search ")" v))
(progn
(setq b1 (substr v 1 (1- vt))
b2 (substr v (+ 2 vt))
b3 (vl-list->string (vl-remove-if '(lambda(x) (or (= 41 x) (<= 48 x 57))) (vl-string->list b2)))
)
(if (setq tm (assoc b1 li))
(setq li (subst (cons b1 (+ (cdr tm) (atof b2))) tm li))
(setq li (cons (cons b1 (atof b2)) li))
)
)
)
)
(foreach v li
(entmake (list (cons 0 "TEXT") (cons 10 dd) (cons 11 dd) (cons 40 (cdr (assoc 40 (entget v0)))) (cons 8 (cdr (assoc 8 (entget v0))))
(cons 41 (cdr (assoc 41 (entget v0)))) (cons 7 (cdr (assoc 7 (entget v0))))
(cons 72 (cdr (assoc 72 (entget v0)))) (cons 73 (cdr (assoc 73 (entget v0))))
(cons 1 (strcat (itoa (setq n (1+ n))) "\t\t\t" (car v) "\t\t\t" (strcase b3) "\t\t\t" (rtos (cdr v))))))
(write-line (strcat (itoa n) "," (car v) "," (strcase b3) "," (rtos (cdr v))) file)
(setq dd (polar dd (* 1.5 pi) (* 2 (cdr (assoc 40 (entget v0))))))
) 
(close file)
)

Nhờ mấy bác chỉnh sửa dùm lisp.

 

Tương tư như lips của Anh Tot77 nhưng phần khối lượng được phân biệt bằng dấu gạch chéo (thay vì trong ngoặc)

Vi dụ: các text, mtext như sau:

1P56(5m), 1P56(3m), 2P110+2P56(3m), 2P110+2P56(2m) thay bằng 1P56/5m, 1P56/3m, 2P110+2P56/3m, 2P110+2P56/2m.

 

E không biết lội mà mò kim đáy biển, thật rất khó. Nhờ mấy bác giúp dùm cho.

[tuongthi120112 0]

Hihi...

 

Sao không thấy Bác nào giúp mình nhỉ.

 

Yêu cầu có khó quá không ? 

[dohoat 0]

Vào lúc 26/5/2014 tại 16:11, Doan Van Ha đã nói:

Code nhanh cho bạn đây.

 

(defun C:HA( / tong so a i)

 (if (setq tong 0 so (ssget '((0 . "*TEXT") (1 . "~*[~-0--9]*"))))

  (repeat (setq i (sslength so))

   (if (setq a (distof (cdr (assoc 1 (entget (ssname so (setq i (1- i))))))))

   (setq tong (+ tong a)))))

 tong)