Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
tnmtpc

lisp đọc số thành chữ

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

có mmột câu hỏi ngớ ngẩn, mong các bạn xem xét: lisp có biết đọc số không? ví dụ trên màn hình Cad có một chuõi số thực, chẳng hạn 11541.25, lisp đọc chuỗi này và ghi thành chữ vào một vị trí nào đó trên màn hình, quan trọng là phải "đọc" đúng, nghĩa là phân biệt được "mười", "một", "mốt"; "năm" và "lăm". Ở ví dụ này là "mười một nghìn năm trăm bốn mươi mốt phảy hai lă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

chẳng có gì không được cả, nếu theo depascal mà nói thì chỉ cần vái dòng lệnh kiểu if...then...else là xong 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

Lisp dưới đây biến 1 text là số nguyên dương thành một dòng text, là chữ viết.

 

Ví dụ: 1234567890 sẽ trở thành 'mot nghin hai tram ba muoi tu ty nam tram sau muoi bay trieu tam tram chin muoi'

 

tên lệnh là doctext (đọc text).

 

(setq
 donvi (list " nghin" " trieu" " ty")
 lstso (list
	(cons "0" " khong")
	(cons "1" " mot")
	(cons "2" " hai")
	(cons "3" " ba")
	(cons "4" " bon")
	(cons "5" " nam")
	(cons "6" " sau")
	(cons "7" " bay")
	(cons "8" " tam")
	(cons "9" " chin")
	(cons "0" " muoi")
)
 s_tram " tram"
 s_muoi " muoi"
 s_linh " linh"
 s_tu " tu"
)
(defun c:doctext()  
 (setq ent (car (entsel "\nHay pick vao text so can doc: "))	
tt  (entget ent)
gt  (cdr (assoc 1 tt))
ok  t
lst (mapcar '(lambda (x) (if (or (> x 57) (list gt))
 )
 (if ok
   (progn
     (setq
p   (getpoint "\nPick toa do cua text moi: ")
tt (subst (cons 1 (substr (docso gt) 2)) (cons 1 gt) tt)
    tt (subst (cons 10 p) (assoc 10 tt) tt)
     )
     (entmake tt)
   )
   (alert "\nText vua chon khong phai la so nguyen duong")
 )
)
(defun docso (str)


 (defun doc1 (so)
   (cdr (assoc so lstso))
 )
 (defun doc3 (a b c)
   (if	(= a "0")
     (setq a1 "")
     (setq a1 (strcat (doc1 a) s_tram))
   )
   (if	(= b "0")
     (if (/= a "0")
(setq b1 s_linh)
(setq b1 "")
     )
     (if (= b "1")
(setq b1 s_muoi)
(setq b1 (strcat (doc1 B ) s_muoi))
     )
   )
   (if	(= c "0")
     (setq c1 "")
     (if (and (/= b "0") (= c "4"))
(setq c1 s_tu)
(setq c1 (doc1 c))
     )
   )
   (strcat a1 b1 c1)
 )

 (setq	lstchar	(reverse (mapcar 'chr (vl-string->list str)))
len	(length lstchar)	
dvht	0
kq	""
strdonvi ""
 )

 (while (>= (length lstchar) 3)
   (setq
     kqht    (strcat
	(doc3 (nth 2 lstchar) (nth 1 lstchar) (nth 0 lstchar))
      )
     kq      (strcat kqht strdonvi kq)
     lstchar (cdddr lstchar)
     dvht    (if (= dvht 2)
	0
	(1+ dvht)
      )
     strdonvi (nth dvht donvi)
   )
 )
 (if (/= (length lstchar) 0)
   (progn
     (while (	(setq lstchar (append lstchar (list "0")))
     )
     (setq kqht (strcat
	   (doc3 (nth 2 lstchar) (nth 1 lstchar) (nth 0 lstchar))
	 )
    kq	 (strcat kqht (nth dvht donvi) kq)
     )
   )
 )
 kq
)

  • Vote tăng 5

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
Lisp dưới đây biến 1 text là số nguyên dương thành một dòng text, là chữ viết.

 

Ví dụ: 1234567890 sẽ trở thành 'mot nghin hai tram ba muoi tu ty nam tram sau muoi bay trieu tam tram chin muoi'

 

tên lệnh là doctext (đọc text).

 

(setq
 donvi (list " nghin" " trieu" " ty")
 lstso (list
	(cons "0" " khong")
	(cons "1" " mot")
	(cons "2" " hai")
	(cons "3" " ba")
	(cons "4" " bon")
	(cons "5" " nam")
	(cons "6" " sau")
	(cons "7" " bay")
	(cons "8" " tam")
	(cons "9" " chin")
	(cons "0" " muoi")
)
 s_tram " tram"
 s_muoi " muoi"
 s_linh " linh"
 s_tu " tu"
)
(defun c:doctext()  
 (setq ent (car (entsel "\nHay pick vao text so can doc: "))	
tt  (entget ent)
gt  (cdr (assoc 1 tt))
ok  t
lst (mapcar '(lambda (x) (if (or (> x 57) (< x 48)) (setq ok nil))) (vl-string->list gt))
 )
 (if ok
   (progn
     (setq
p   (getpoint "\nPick toa do cua text moi: ")
tt (subst (cons 1 (substr (docso gt) 2)) (cons 1 gt) tt)
    tt (subst (cons 10 p) (assoc 10 tt) tt)
     )
     (entmake tt)
   )
   (alert "\nText vua chon khong phai la so nguyen duong")
 )
)
(defun docso (str)


 (defun doc1 (so)
   (cdr (assoc so lstso))
 )
 (defun doc3 (a b c)
   (if	(= a "0")
     (setq a1 "")
     (setq a1 (strcat (doc1 a) s_tram))
   )
   (if	(= b "0")
     (if (/= a "0")
(setq b1 s_linh)
(setq b1 "")
     )
     (if (= b "1")
(setq b1 s_muoi)
(setq b1 (strcat (doc1 B ) s_muoi))
     )
   )
   (if	(= c "0")
     (setq c1 "")
     (if (and (/= b "0") (= c "4"))
(setq c1 s_tu)
(setq c1 (doc1 c))
     )
   )
   (strcat a1 b1 c1)
 )

 (setq	lstchar	(reverse (mapcar 'chr (vl-string->list str)))
len	(length lstchar)	
dvht	0
kq	""
strdonvi ""
 )

 (while (>= (length lstchar) 3)
   (setq
     kqht    (strcat
	(doc3 (nth 2 lstchar) (nth 1 lstchar) (nth 0 lstchar))
      )
     kq      (strcat kqht strdonvi kq)
     lstchar (cdddr lstchar)
     dvht    (if (= dvht 2)
	0
	(1+ dvht)
      )
     strdonvi (nth dvht donvi)
   )
 )
 (if (/= (length lstchar) 0)
   (progn
     (while (< (length lstchar) 3)
(setq lstchar (append lstchar (list "0")))
     )
     (setq kqht (strcat
	   (doc3 (nth 2 lstchar) (nth 1 lstchar) (nth 0 lstchar))
	 )
    kq	 (strcat kqht (nth dvht donvi) kq)
     )
   )
 )
 kq
)

Bác Hòanh viết cừ thật, nhưng lisp đọc không đúng và "ngọng líu ngọng lo" Bác ạ, ví dụ nhé:114565231, đọc là: mot tram muoi tu ty nam tram sau muoi nam trieu hai tram ba muoi mot . Không phân biệt "năm", "lăm"...Bác sửa lisp lại chút đi! thêm phần số thập phân nữa chớ

  • 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
nhưng lisp đọc không đúng và "ngọng líu ngọng lo" Bác ạ, ví dụ nhé:114565231, đọc là: mot tram muoi tu ty nam tram sau muoi nam trieu hai tram ba muoi mot . Không phân biệt "năm", "lăm"...Bác sửa lisp lại chút đi! thêm phần số thập phân nữa chớ

 

Đoạn lisp dưới đây đã sửa được lỗi đọc lăm-năm.

(setq
 donvi	 (list " nghin" " trieu" " ty")
 lstso	 (list
   (cons "0" " khong")
   (cons "1" " mot")
   (cons "2" " hai")
   (cons "3" " ba")
   (cons "4" " bon")
   (cons "5" " nam")
   (cons "6" " sau")
   (cons "7" " bay")
   (cons "8" " tam")
   (cons "9" " chin")
   (cons "0" " muoi")
 )
 s_tram " tram"
 s_muoi " muoi"
 s_linh " linh"
 s_tu	 " tu"
 s_lam	 " lam"
)
(defun c:doctext ()
 (setq	ent (car (entsel "\nHay pick vao text so can doc: "))
tt  (entget ent)
gt  (cdr (assoc 1 tt))
ok  t
lst (mapcar '(lambda (x)
	       (if (or (> x 57) (			 (setq ok nil)
	       )
	     )
	    (vl-string->list gt)
    )
 )
 (if ok
   (progn
     (setq
p  (getpoint "\nPick toa do cua text moi: ")
tt (subst (cons 1 (substr (docso gt) 2)) (cons 1 gt) tt)
tt (subst (cons 10 p) (assoc 10 tt) tt)
     )
     (entmake tt)
   )
   (alert "\nText vua chon khong phai la so nguyen duong")
 )
)
(defun docso (str)
 (defun doc1 (so)
   (cdr (assoc so lstso))
 )
 (defun doc3 (a b c)
   (if	(= a "0")
     (setq a1 "")
     (setq a1 (strcat (doc1 a) s_tram))
   )

   (if	(= b "0")
     (if (/= a "0")
(setq b1 s_linh)
(setq b1 "")
     )
     (if (= b "1")
(setq b1 s_muoi)
(setq b1 (strcat (doc1 B ) s_muoi))
     )
   )

   (setq c1
   (cond
     ((= c "0") "")
     ((and (= c "4") (/= b "1")) s_tu)
     ((and (= c "5") (/= b "0")) s_lam)
     (t (doc1 c))
   )
   )

   (strcat a1 b1 c1)
 )

 (setq	lstchar	 (reverse (mapcar 'chr (vl-string->list str)))
len	 (length lstchar)
dvht	 0
kq	 ""
strdonvi ""
 )

 (while (>= (length lstchar) 3)
   (setq
     kqht     (strcat
	 (doc3 (nth 2 lstchar) (nth 1 lstchar) (nth 0 lstchar))
       )
     kq       (strcat kqht strdonvi kq)
     lstchar  (cdddr lstchar)
     dvht     (if (= dvht 2)
	 0
	 (1+ dvht)
       )
     strdonvi (nth dvht donvi)
   )
 )
 (if (/= (length lstchar) 0)
   (progn
     (while (	(setq lstchar (append lstchar (list "0")))
     )
     (setq kqht (strcat
	   (doc3 (nth 2 lstchar) (nth 1 lstchar) (nth 0 lstchar))
	 )
    kq	 (strcat kqht (nth dvht donvi) kq)
     )
   )
 )
 kq
)

  • Vote tăng 2

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
Đoạn lisp dưới đây đã sửa được lỗi đọc lăm-năm.

(setq
 donvi	 (list " nghin" " trieu" " ty")
 lstso	 (list
   (cons "0" " khong")
   (cons "1" " mot")
   (cons "2" " hai")
   (cons "3" " ba")
   (cons "4" " bon")
   (cons "5" " nam")
   (cons "6" " sau")
   (cons "7" " bay")
   (cons "8" " tam")
   (cons "9" " chin")
   (cons "0" " muoi")
 )
 s_tram " tram"
 s_muoi " muoi"
 s_linh " linh"
 s_tu	 " tu"
 s_lam	 " lam"
)
(defun c:doctext ()
 (setq	ent (car (entsel "\nHay pick vao text so can doc: "))
tt  (entget ent)
gt  (cdr (assoc 1 tt))
ok  t
lst (mapcar '(lambda (x)
	       (if (or (> x 57) (< x 48))
		 (setq ok nil)
	       )
	     )
	    (vl-string->list gt)
    )
 )
 (if ok
   (progn
     (setq
p  (getpoint "\nPick toa do cua text moi: ")
tt (subst (cons 1 (substr (docso gt) 2)) (cons 1 gt) tt)
tt (subst (cons 10 p) (assoc 10 tt) tt)
     )
     (entmake tt)
   )
   (alert "\nText vua chon khong phai la so nguyen duong")
 )
)
(defun docso (str)
 (defun doc1 (so)
   (cdr (assoc so lstso))
 )
 (defun doc3 (a b c)
   (if	(= a "0")
     (setq a1 "")
     (setq a1 (strcat (doc1 a) s_tram))
   )

   (if	(= b "0")
     (if (/= a "0")
(setq b1 s_linh)
(setq b1 "")
     )
     (if (= b "1")
(setq b1 s_muoi)
(setq b1 (strcat (doc1 B ) s_muoi))
     )
   )

   (setq c1
   (cond
     ((= c "0") "")
     ((and (= c "4") (/= b "1")) s_tu)
     ((and (= c "5") (/= b "0")) s_lam)
     (t (doc1 c))
   )
   )

   (strcat a1 b1 c1)
 )

 (setq	lstchar	 (reverse (mapcar 'chr (vl-string->list str)))
len	 (length lstchar)
dvht	 0
kq	 ""
strdonvi ""
 )

 (while (>= (length lstchar) 3)
   (setq
     kqht     (strcat
	 (doc3 (nth 2 lstchar) (nth 1 lstchar) (nth 0 lstchar))
       )
     kq       (strcat kqht strdonvi kq)
     lstchar  (cdddr lstchar)
     dvht     (if (= dvht 2)
	 0
	 (1+ dvht)
       )
     strdonvi (nth dvht donvi)
   )
 )
 (if (/= (length lstchar) 0)
   (progn
     (while (< (length lstchar) 3)
(setq lstchar (append lstchar (list "0")))
     )
     (setq kqht (strcat
	   (doc3 (nth 2 lstchar) (nth 1 lstchar) (nth 0 lstchar))
	 )
    kq	 (strcat kqht (nth dvht donvi) kq)
     )
   )
 )
 kq
)

Lần này thì hết "ngọng" nhưng vẫn đọc không đúng Bác Hòanh ạ! Cụ thể là có sự nhầm lẫn từ hàng triệu đọc thành tỷ, nghìn đọc thành triệu(lạm phát ghê quá Bác nhỉ!). Mà sao Bác không viết rộng ra cho cả chuỗi số thực , lỡ gặp tiền xu thì bó tay không đọc được

  • 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
Lần này thì hết "ngọng" nhưng vẫn đọc không đúng Bác Hòanh ạ! Cụ thể là có sự nhầm lẫn từ hàng triệu đọc thành tỷ, nghìn đọc thành triệu(lạm phát ghê quá Bác nhỉ!). Mà sao Bác không viết rộng ra cho cả chuỗi số thực , lỡ gặp tiền xu thì bó tay không đọc được

Xin bác Hoành viết tiếp!

  • 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
hổng biết tại sao link bị error nữa.gửi lại cho a e. Font TCVN nha.

http://www.cadviet.com/upfiles/doctext_2.dvb

sao e up lên cadviet mà cứ bị hư hoài, chẳng biết tại sao, đành fải up lên nơi khác.

http://www.megafileupload.com/en/file/40536/doctext-dvb.html

  • 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

Bạn cần sử dụng lisp này vào việc j vậy.

Nếu nó ko có ứng dụng quá quan trọng thì ko nên làm người khác mất thời gian, còn rất nhiều vấn đề khác nữa cần đc nghiên cứu mà.

Tui nghĩ các anh ấy đã rất nhiệt tình khi tham gia vào toàn bộ các diễn đàn con của CADviet..chúng ta cũng nên tự tìm hiểu và hoàn thiện các lisp mà các anh đã viết free cho chúng ta thay vì cứ yêu cầu và đòi hỏ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ạn cần sử dụng lisp này vào việc j vậy.

Nếu nó ko có ứng dụng quá quan trọng thì ko nên làm người khác mất thời gian, còn rất nhiều vấn đề khác nữa cần đc nghiên cứu mà.

Tui nghĩ các anh ấy đã rất nhiệt tình khi tham gia vào toàn bộ các diễn đàn con của CADviet..chúng ta cũng nên tự tìm hiểu và hoàn thiện các lisp mà các anh đã viết free cho chúng ta thay vì cứ yêu cầu và đòi hỏi

Đúng thế, bác còn vợ con nữa chứ hi hi

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  

×