Nhờ Các Bác Chỉnh Sửa Lại Lisp Cộng Tổng Text Cho Trường Hợp Của Em

[pirates0511 4]

Đây là Code mình lấy của 1 bạn trên diễn đàn về lisp cộng tổng text 

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

Mình chuyên thiết kế về cấp nước, khi ghi chú trên đường ống thường ghi là :"D160PVC - L50m". chữ "D160 PVC" có thể thay đổi theo từng loại đường ống, nhưng cụm chữ "L50m thì không thay đổi, chỉ thay đổi chiều dài (50 hoặc 60). Nếu theo lisp trên nó sẽ không cộng được với dãy chữ và số của em. Giờ em muốn các bác sửa lại cho em là: nó chỉ cộng cái "L50m'' thôi, còn trước đó có cái gì thì nó không đụng đến, nghĩa là D160PVC - L50m + D90 HDPE - L60M = 110m ( 50+60=110)

 Em xin cám ơn các bác trước

[pirates0511 4]

không có bác nào giúp em cái à. buồn thế  :(

[Tot77 508]

Bác giúp em cái này này! Lưu ý:

1/ Trong chữ phải có cụm "- L" (giữa - và L có dấu cách.

2/ Lsp không biết đổi đơn vị, cho nên các cụm từ muốn tính phải có cùng đơn vị (hoặc đều là m, dm, cm, mm)

 

 

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

[pirates0511 4]

Cám ơn bác nhiều nhé. Nhưng sao em làm mà nó lại không cộng nhỉ. Bác xem lại hộ em cái

Command: SUM

Chon cac text can tinh:

Select objects: 1 found

Select objects: 1 found, 2 total

Select objects:  ; error: bad argument type: numberp: nil

[Tot77 508]

Bạn đưa file lên mới biết tại sao không cộng được.

[pirates0511 4]

<img src="http://i.imgur.com/5dwexmM.jpg"/>

em ko up file cad cho bác xem được (chắc do mạng, bác chịu khó xem hình). em cộng 2 text "D75 HDPE - L56M và D75 HDPE - L63M", nhưng nó ko cộng được. bác ngó lại cho em phát nhé

[Tot77 508]

Bạn ko đưa file thì làm sao mà ngó được!!

File của tôi thì cộng tốt.

http://www.cadviet.com/upfiles/6/127168_drawing1_1.dwg

[pirates0511 4]

bác cho em cái mail. em gửi qua đó cho. em ko up lên diễn đàn được (ko biết tại sao)

[nobitalx 1]

e đang dùng pdfFactory Pro 5.12 để xuất file cad ra pdf nhưng lại bị lỗi font , khi mới view thì thấy ok nhưng khi in ra file pdf thì bị lỗi font. một số bị lỗi 1 số thì không, đã thử mọi cách cài thêm font hay gỡ ra cài lại mà vẫn không được mọi người giúp e với.

[pirates0511 4]

em gửi mail cho bác rồi nhé. mở file cad xem hộ em phát 

Tot77