Chuyển đến nội dung
Diễn đàn CADViet
vuanhdung

Lisp tính tổng các text

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

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)

)

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

  • 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
Đâ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

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
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.

  • Like 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

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.

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ươ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.

  • 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
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ỉ?

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

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

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á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)
)

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 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.

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 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

  • Vote giảm 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

 

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.

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 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)

 

 

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

×