Đến nội dung


Hình ảnh
- - - - -

Nhờ Chỉnh Sửa Lisp Cộng Giá Trị Text Của Vật Tư Ngành Nước


  • Please log in to reply
9 replies to this topic

#1 jangboko

jangboko

    biết vẽ arc

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

Đã gửi 14 August 2016 - 12:30 AM

 (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 kq) (assoc 1 (setq data (entget e)))  data))
(princ)
)
 
(defun getchar(s)
(vl-list->string (vl-remove-if '(lambda(x) (<= 48 x 57)) (vl-string->list s)))
)
;;;-----------------------------------------
(defun C:MUL (/ i m e ss vt chu dv)
(SelData)
(setq i 0
m 1.0
)
(repeat (sslength ss)
(setq e (ssname ss i)
i (1+ i))
(if (setq vt (vl-string-search "- L" (setq chu (cdr (assoc 1 (entget e))))))
(setq m (* m (atof (substr chu (+ 4 vt)))))
)
(setq dv (getchar (substr chu (+ 4 vt))))
)
(WriteRes (strcat (rtos m) dv))
)
;;;-----------------------------------------
(defun C:SUM (/ i s e ss chu vt dv)
(SelData)
(setq i 0
s 0.0
)
(repeat (sslength ss)
(setq e (ssname ss i)
i (1+ i))
(if (setq vt (vl-string-search "- L" (setq chu (cdr (assoc 1 (entget e))))))
(setq s (+ s (atof (substr chu (+ 4 vt)))))
)
(setq dv (getchar (substr chu (+ 4 vt))))
)
(WriteRes (strcat (rtos s) dv))
)
 

Lisp này có tác dụng cộng các text có dạng D32 PVC - L150m, dùng để thống kê vật tư ngành nước. 

em lấy lisp này  của bác Tot77, trong bài viết: www.cadviet.com/forum/topic/164711-nho-cac-bac-chinh-sua-lai-lisp-cong-tong-text-cho-truong-hop-cua-em/

Em thấy lisp này hoạt động được trên file cad của tác giả, em viết đoạn text có cấu trúc giống tác giả thì lisp lại không hoạt động được, và có báo lỗi 

 
Command: sum
 Chon cac text can tinh:
Select objects: 1 found
 
Select objects: Specify opposite corner: 2 found, 3 total
 
Select objects:  ; error: bad argument type: numberp: nil
 
hề hề, cứ nhờ không các bác thế này cũng ngại, em đã lục tung diễn đàn lên mà không tìm thấy lisp nào tương tự, nên đành mặt dày làm kinh động đến các bác. Mong các bác giúp em.
Em xin cảm ơn các bác, chúc các bác luôn mạnh khỏe.
 
 
 

  • 0

#2 jangboko

jangboko

    biết vẽ arc

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

Đã gửi 14 August 2016 - 12:34 AM

 (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 kq) (assoc 1 (setq data (entget e)))  data))
(princ)
)
 
(defun getchar(s)
(vl-list->string (vl-remove-if '(lambda(x) (<= 48 x 57)) (vl-string->list s)))
)
;;;-----------------------------------------
(defun C:MUL (/ i m e ss vt chu dv)
(SelData)
(setq i 0
m 1.0
)
(repeat (sslength ss)
(setq e (ssname ss i)
i (1+ i))
(if (setq vt (vl-string-search "- L" (setq chu (cdr (assoc 1 (entget e))))))
(setq m (* m (atof (substr chu (+ 4 vt)))))
)
(setq dv (getchar (substr chu (+ 4 vt))))
)
(WriteRes (strcat (rtos m) dv))
)
;;;-----------------------------------------
(defun C:SUM (/ i s e ss chu vt dv)
(SelData)
(setq i 0
s 0.0
)
(repeat (sslength ss)
(setq e (ssname ss i)
i (1+ i))
(if (setq vt (vl-string-search "- L" (setq chu (cdr (assoc 1 (entget e))))))
(setq s (+ s (atof (substr chu (+ 4 vt)))))
)
(setq dv (getchar (substr chu (+ 4 vt))))
)
(WriteRes (strcat (rtos s) dv))
)
 

Lisp này có tác dụng cộng các text có dạng D32 PVC - L150m, dùng để thống kê vật tư ngành nước. 

em lấy lisp này  của bác Tot77, trong bài viết: www.cadviet.com/forum/topic/164711-nho-cac-bac-chinh-sua-lai-lisp-cong-tong-text-cho-truong-hop-cua-em/

Em thấy lisp này hoạt động được trên file cad của tác giả, em viết đoạn text có cấu trúc giống tác giả thì lisp lại không hoạt động được, và có báo lỗi 

 
Command: sum
 Chon cac text can tinh:
Select objects: 1 found
 
Select objects: Specify opposite corner: 2 found, 3 total
 
Select objects:  ; error: bad argument type: numberp: nil
 
hề hề, cứ nhờ không các bác thế này cũng ngại, em đã lục tung diễn đàn lên mà không tìm thấy lisp nào tương tự, nên đành mặt dày làm kinh động đến các bác. Mong các bác giúp em.
Em xin cảm ơn các bác, chúc các bác luôn mạnh khỏe.

 


  • 0

#3 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5451 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 14 August 2016 - 06:59 AM

Lỗi của bạn nằm ở chỗ không đưa lisp bạn viết lên, và cũng không giải thích khi dùng lisp thì cad bị nhức đầu hay tiêu chảy.


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#4 jangboko

jangboko

    biết vẽ arc

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

Đã gửi 14 August 2016 - 08:07 AM

Lỗi của bạn nằm ở chỗ không đưa lisp bạn viết lên, và cũng không giải thích khi dùng lisp thì cad bị nhức đầu hay tiêu chảy.

cảm ơn bác đã quan tâm và phúc đáp thắc mắc của em, có lẽ em ko biết post bài đúng cách nên 1 phần bài viết không hiển thị hết, thế nên ở bài #2 em phải tự reply bài #1 của em

Bài viết hoàn chỉnh của em nằm ở bài #2, mong bác quan tâm giúp đỡ.


  • 0

#5 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 14 August 2016 - 09:29 AM

Tôi xin đính chính là lsp này không phải của tôi, chỉ là tôi sửa lại thôi.

Bạn đưa bản vẽ cái mẫu chữ của bạn lên mới biết lỗi ở chỗ nào.


  • 1

#6 jangboko

jangboko

    biết vẽ arc

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

Đã gửi 14 August 2016 - 09:51 AM

Tôi xin đính chính là lsp này không phải của tôi, chỉ là tôi sửa lại thôi.

Bạn đưa bản vẽ cái mẫu chữ của bạn lên mới biết lỗi ở chỗ nào.

http://www.cadviet.c...ua_loi_lisp.dwg

 

Mình up mẫu bản vẽ có mẫu text của bạn và mẫu text của mình. bạn kiểm tra hộ mình nhé. cảm ơn bạn


  • 0

#7 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5451 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 14 August 2016 - 10:16 AM

Sửa giùm cho bạn nè!

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/165286-nho-chinh-sua-lisp-cong-gia-tri-text-cua-vat-tu-nganh-nuoc/
 (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 kq) (assoc 1 (setq data (entget e)))  data))
(princ)
)
 
(defun getchar(s)
(vl-list->string (vl-remove-if '(lambda(x) (<= 48 x 57)) (vl-string->list s)))
)
;;;-----------------------------------------
(defun C:MUL (/ i m e ss vt chu dv)
(SelData)
(setq i 0
m 1.0
)
(repeat (sslength ss)
(setq e (ssname ss i)
i (1+ i))
(if (setq vt (vl-string-search "- L" (strcae (setq chu (cdr (assoc 1 (entget e)))))))
(setq m (* m (atof (substr chu (+ 4 vt)))))
)
(setq dv (getchar (substr chu (+ 4 vt))))
)
(WriteRes (strcat (rtos m) dv))
)
;;;-----------------------------------------
(defun C:SUM (/ i s e ss chu vt dv)
(SelData)
(setq i 0
s 0.0
)
(repeat (sslength ss)
(setq e (ssname ss i)
i (1+ i))
(if (setq vt (vl-string-search "- L" (strcase (setq chu (cdr (assoc 1 (entget e)))))))
(setq s (+ s (atof (substr chu (+ 4 vt)))))
)
(setq dv (getchar (substr chu (+ 4 vt))))
)
(WriteRes (strcat (rtos s) dv))
)

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#8 jangboko

jangboko

    biết vẽ arc

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

Đã gửi 14 August 2016 - 10:42 AM

 

Sửa giùm cho bạn nè!

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/165286-nho-chinh-sua-lisp-cong-gia-tri-text-cua-vat-tu-nganh-nuoc/
 (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 kq) (assoc 1 (setq data (entget e)))  data))
(princ)
)
 
(defun getchar(s)
(vl-list->string (vl-remove-if '(lambda(x) (<= 48 x 57)) (vl-string->list s)))
)
;;;-----------------------------------------
(defun C:MUL (/ i m e ss vt chu dv)
(SelData)
(setq i 0
m 1.0
)
(repeat (sslength ss)
(setq e (ssname ss i)
i (1+ i))
(if (setq vt (vl-string-search "- L" (strcae (setq chu (cdr (assoc 1 (entget e)))))))
(setq m (* m (atof (substr chu (+ 4 vt)))))
)
(setq dv (getchar (substr chu (+ 4 vt))))
)
(WriteRes (strcat (rtos m) dv))
)
;;;-----------------------------------------
(defun C:SUM (/ i s e ss chu vt dv)
(SelData)
(setq i 0
s 0.0
)
(repeat (sslength ss)
(setq e (ssname ss i)
i (1+ i))
(if (setq vt (vl-string-search "- L" (strcase (setq chu (cdr (assoc 1 (entget e)))))))
(setq s (+ s (atof (substr chu (+ 4 vt)))))
)
(setq dv (getchar (substr chu (+ 4 vt))))
)
(WriteRes (strcat (rtos s) dv))
)

cảm ơn bác, Lisp hoạt động tốt lắm ạ

Bác có thể chỉnh sửa nâng cao giúp em lisp này được không ạ. Bài toán là trong 1 sơ đồ không gian cấp (thoát) nước có nhiều loại đường ống, D21 - L35m, D27 -L42m, D34 - L15m,..., em muốn click đầu tiên chọn loại đường kính ống mẫu, sau đó quét toàn bộ sơ đồ, lisp sẽ chỉ cộng các ống mẫu đã được chọn. Em cảm ơn bác nhiều.


  • 0

#9 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 14 August 2016 - 11:48 AM

Ket thấy có quá nhiều yêu cầu dạng này rồi. Chỉ cần sử dụng lệnh Dataextraction + vài thủ thuật nhỏ bên Excel là có thể có bảng thống kê toàn diện, k hiểu tại sao các bạn làm bên thống kê lại "quên" lệnh này đi mà thích yêu cầu lisp :)

Hơn nữa, khi vẽ cần chuẩn hóa / phân loại dữ liệu đầu vào để sau này trích xuất dữ liệu, nếu các bạn làm tốt thì công việc thống kê cực kỳ dễ dàng. Ví dụ như mỗi loại ống vẽ bằng 1 layer, hay mỗi loại ghi chú cho chiều dài nằm ở 1 layer hoặc 1 att mang giá trị khác nhau ....Chứ kiểu chữa cháy này thì 1 yêu cầu còn phát sinh nhiều yêu cầu tương tự


  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#10 jangboko

jangboko

    biết vẽ arc

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

Đã gửi 14 August 2016 - 03:17 PM

Ket thấy có quá nhiều yêu cầu dạng này rồi. Chỉ cần sử dụng lệnh Dataextraction + vài thủ thuật nhỏ bên Excel là có thể có bảng thống kê toàn diện, k hiểu tại sao các bạn làm bên thống kê lại "quên" lệnh này đi mà thích yêu cầu lisp :)

Hơn nữa, khi vẽ cần chuẩn hóa / phân loại dữ liệu đầu vào để sau này trích xuất dữ liệu, nếu các bạn làm tốt thì công việc thống kê cực kỳ dễ dàng. Ví dụ như mỗi loại ống vẽ bằng 1 layer, hay mỗi loại ghi chú cho chiều dài nằm ở 1 layer hoặc 1 att mang giá trị khác nhau ....Chứ kiểu chữa cháy này thì 1 yêu cầu còn phát sinh nhiều yêu cầu tương tự

cảm ơn bạn đã gợi ý cho mình 1 hướng đi mới, mình vừa search tìm hiểu lệnh data extraction nhưng hình như lệnh này sử dụng cho cad 2008 trở lên thì phải, mình đang sử dụng cad 2007 nên không sử dụng được data extraction.


  • 0