Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
friendship293a

Sửa hộ em code tính tổng lỗi này

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

Code sau em tìm được trên diễn đàn tính tổng tất cả các số và chọn số ghi kết quả nhưng báo lỗi

Select objects: Specify opposite corner: 2 found

Select objects: ; error: no function definition: TAO1

Command:

Ai sửa hộ em với ạ

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;HAM CAN BAN;;;;;;;;;;;;;;;;;;;;;
(defun loc(id ttt) (tao1) (dati) 
(repeat sl (layvt) (laytt id) (if (= tt ttt)(them1)) (tangi) ) (doiss)
)
(defun layvt() (setq vat (ssname ss i)))
(defun laytt(id) (setq tt (cdr (assoc id (entget vat)))))
(defun dati()  (setq i 0))  (defun tangi() (setq i (+ i 1)))
(defun trim(s) (setq n (strlen s) z 1 ep "")
 (repeat n (setq tu (substr s z 1))
  (if (/= tu " ") (setq ep (strcat ep tu))) (setq z (+ 1 z))
 ) (princ ep)
)
(defun nhet(s1 s vt) (setq leftst (left s vt) rightst (right s (+ vt 1))
 stmoi (strcat leftst s1 rightst))
)
(defun be(s1 st) (at s1 st) (setq trai (left st (- m 1)) phai (right st (+ m 1))))
(defun chon1(ttt)  (setq vat (car (entsel ttt))))
(defun solg() (if (/= ss nil) (setq sl (sslength ss))))
(defun C:ch() (setq ss (ssget)) (solg))
(defun doi(id tri) (setq ds (entget vat) 
 ds (subst (cons id tri) (assoc id ds) ds)) (entmod ds) (princ)
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:cso() (c:ch) (loc 0 "TEXT") (setq tong 0) (dati)
(while (<= i (- sl 1)) (layvt) (laytt 1) (trim tt) 
(if (=(substr ep (strlen ep))"f") (progn (be "k" ep) (setq ep trai)))
(setq tong (+ tong (atof ep))) (tangi))
 (if(> tong(fix tong))(setq tong (rtos tong 2))(setq tong (rtos tong 2 0)))
 (chon1 "gan tong:") (laytt 1) (setq kh (substr tt (strlen tt))) 
 (cond ((= kh "f")(if(>=  (atof tong) 1000) (nhet " " tong (- (strlen (itoa(fix (atof tong)))) 3))(setq stmoi tong))
 (doi 1 (strcat stmoi " kgf")) )
	((= kh "g")(if(>=  (atof tong) 1000) (nhet " " tong (- (strlen (itoa(fix (atof tong)))) 3))(setq stmoi tong))
 (doi 1 (strcat stmoi " kg")) )
((= kh "=") (be "x" tt) (if (>=  (atof tong) 1000) (setq tong (nhet " " tong (- (strlen (itoa(fix (atof tong)))) 3))))
 (doi 1 (strcat tong " x" phai)) )
((progn (if (>=  (atof tong) 1000) (setq tong (nhet " " tong (- (strlen (itoa(fix (atof tong)))) 3))))(doi 1 tong)))
)
(setq ss nil) (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

Ở code trên rõ ràng function (tao1) của bạn không có,chắc bạn lấy lisp này từ topic congtrunhanchia :lol:

Bạn có thể dùng code này của các bác trên CV đã viết rồi,áp dụng cho phép cộng (+) và phép nhân (*),tương ứng với lệnh +,* nhé

 

;; free lisp from cadviet.com

;;;-----------------------------------------
(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:*( / 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:+( / 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)
)
;;;-----------------------------------------

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

thì vẫn cái líp lúc nãy bạn hỏi, chỉ sửa 1 tý.

 

(defun c:tt ( / kqua ss sl obj)
(prompt "\nChon text de cong:")
(setq ss (ssget '((0 . "TEXT")))
sl (sslength ss)
kqua 0)
(while (and ss (> (sslength ss) 0))
(setq
kqua (+ kqua
(atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))
)
)
(ssdel ent ss)
)
(princ kqua)

(setq obj (vlax-ename->vla-object
(car (entsel "\nChon text de ghi ket qua:"))
)
)
(vla-put-TextString obj (rtos kqua 2 2))
(princ)
)

  • 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
Tue_NV    3.841
thì vẫn cái líp lúc nãy bạn hỏi, chỉ sửa 1 tý.

 

(defun c:tt ( / kqua ss sl obj)
(prompt "\nChon text de cong:")
(setq ss (ssget '((0 . "TEXT")))
sl (sslength ss)
kqua 0)
(while (and ss (> (sslength ss) 0))
(setq
kqua (+ kqua
(atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))
)
)
(ssdel ent ss)
)
(princ kqua)

(setq obj (vlax-ename->vla-object
(car (entsel "\nChon text de ghi ket qua:"))
)
)
(vla-put-TextString obj (rtos kqua 2 2))
(princ)
)

Một cách viết ngắn gọn code (tiếp cận hàm acet-xxx):

(defun c:tt ( / kq obj)
(prompt "\nChon text de cong:")
(setq kq (rtos (apply '+ (mapcar '(lambda(x) (atof (acet-dxf 1 (entget x))))
			   (acet-ss-to-list (ssget '((0 . "TEXT")))))
	  ) 2 2))
(setq obj (vlax-ename->vla-object (car (entsel "\nChon text de ghi ket qua:"))))
(vla-put-TextString obj kq)
(princ)
)

  • 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
phamthanhbinh    3.123
Một cách viết ngắn gọn code (tiếp cận hàm acet-xxx):

(defun c:tt ( / kq obj)
(prompt "\nChon text de cong:")
(setq kq (rtos (apply '+ (mapcar '(lambda(x) (atof (acet-dxf 1 (entget x))))
			   (acet-ss-to-list (ssget '((0 . "TEXT")))))
	  ) 2 2))
(setq obj (vlax-ename->vla-object (car (entsel "\nChon text de ghi ket qua:"))))
(vla-put-TextString obj kq)
(princ)
)

Chào bác Tue_NV,

Bác có thể hướng dẫn một chút tổng quan về các hàm acet-xxx này không.??? Thực tình mình có biết một vài hàm được giới thiệu trên diễn đàn và cũng cố xài thử, tuy nhiên xài cái nào biết cái đó chứ chả có tí hiểu biết nào về nó cả bác ạ.

Bác có thể cho biết cách tạo các hàm này ra sao??? Nó được viết sẵn như các hàm của lisp hay là phải tự dùng lisp để tạo ra nó như kiểu các hàm con.

Muốn tham khảo về các hàm này thì xem tài liệu ở đâu, vì mình cũng đã cài express tool nhưng chả thấy chỗ nào nói đến nó cả.

Mình cũng có mót được cái thằng acetutil trên diễn đàn nhưng tịnh không thấy nó có mấy cái hàm bác xài nên hơi khó để hiểu bác ạ.

Rất mong bác chỉ giáo thêm....

  • 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

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

Đăng nhập để thực hiện theo  

×