Đến nội dung


Hình ảnh
* * * * * 1 Bình chọn

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


  • Please log in to reply
6 replies to this topic

#1 friendship293a

friendship293a

    biết lệnh erase

  • Members
  • PipPipPip
  • 102 Bài viết
Điểm đánh giá: -9 (bình thường)

Đã gửi 21 October 2010 - 04:23 PM

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

  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 21 October 2010 - 04:56 PM

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

  • 0

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


#3 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 21 October 2010 - 05:00 PM

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

  • 1

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#4 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 21 October 2010 - 05:23 PM

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

  • 1

#5 friendship293a

friendship293a

    biết lệnh erase

  • Members
  • PipPipPip
  • 102 Bài viết
Điểm đánh giá: -9 (bình thường)

Đã gửi 22 October 2010 - 09:02 AM

Các bác quá cao thủ làm em mở rộng tầm mắt. hehe
  • 0

#6 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 22 October 2010 - 09:19 AM

1 câu hỏi mà nhận được 3 đáp án ^^,bác cứ tùy nghi hút máu thôi :lol:
  • 0

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


#7 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 22 October 2010 - 09:22 AM

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....
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.