Đến nội dung


Hình ảnh
- - - - -

chuyển chữ thành số


  • Please log in to reply
25 replies to this topic

#1 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 07 October 2010 - 05:40 PM

Dạo này ít người yêu cầu viết lisp quá nên mình viết nghịch chơi cái lisp này.
Ngày xưa các bác chắc cũng từng thương thầm chộm nhớ một người nào đấy. Muốn viết thư cho người ta mà lại e ngại không biết ý người ta thế nào.
Thế là các bác này nghĩ ra cái chò viết thư bằng số.
Ý nghĩa là nếu người ta có thích mình thì sẽ tìm cách mày mò để dịch (điều này kiểm tra luôn IQ của người đó). Nếu người đó không thích mình thì vèo một cái bay vào sọt rác.
Code đây (dành cho các bác nhát gan). Chú ý chữ để dịch phải không có dấu.

;; free lisp from cadviet.com
(defun c:chutoso()
(setq lis_chu '("A" "B" "C" "D" "E" "G" "H" "I" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "X" "Y" " "))
(setq lis_so '("4" "13" "6" "15" "3" "9" "76" "1" "16" "1" "111" "11" "0" "10" "2" "12" "5" "7" "22" "21" "96" "27"))
(setq name (car (entsel "\nChon chu la text hay mtext can chuyen sang so")))
(setq ent (entget name))
(setq loai (cdr (assoc 0 ent)))
(if (or (= loai "TEXT") (= loai "MTEXT"))
(progn
(setq chu (strcase (cdr (assoc 1 ent))))
  (setq L (strlen chu) i L ma nil)
  (Repeat L
(if (= (vl-position (substr chu i 1) lis_chu) 22)
(progn
(setq kt " ")
(setq ma (append (list kt) ma))
)
(progn    
(setq kt (atoi (nth (vl-position (substr chu i 1) lis_chu) lis_so)))
    (setq ma (append (list (rtos kt 2 0)) ma))
)
)
(setq i (1- i))
)
(setq dct (getpoint "\nchon diem chen chu da dich")
chumoi (subst (cons 10 dct) (assoc 10 ent) ent)
chumoi (subst (cons 1 (apply 'strcat ma)) (assoc 1 chumoi) chumoi)
)
(entmake chumoi)
)
(alert (strcat "doi tuong ma cac bac chon la : " loai " khong phai la text hay mtext"))
)
)

  • 2
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2 huong259

huong259

    biết lệnh refedit

  • Members
  • PipPipPipPipPipPipPip
  • 596 Bài viết
Điểm đánh giá: 350 (khá)

Đã gửi 07 October 2010 - 05:47 PM

thân gửi anh:phamngoctukts
1643758912785644643461265798255486869168866775468668
347698264665659886696775829449656659595959987668666454565724
43436266656561689664667667666346646676686664628
654456668666866866545454456562246
6566564342
  • 0

#3 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 07 October 2010 - 07:44 PM

thân gửi anh:phamngoctukts
1643758912785644643461265798255486869168866775468668
347698264665659886696775829449656659595959987668666454565724
43436266656561689664667667666346646676686664628
654456668666866866545454456562246
6566564342

Chào em
chỉ số IQ của anh thấp nên không hiểu được nội dung thư em viết cho anh. hê hê.
  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#4 huong259

huong259

    biết lệnh refedit

  • Members
  • PipPipPipPipPipPipPip
  • 596 Bài viết
Điểm đánh giá: 350 (khá)

Đã gửi 07 October 2010 - 08:57 PM

Chào em
chỉ số IQ của anh thấp nên không hiểu được nội dung thư em viết cho anh. hê hê.

Anh khiêm tốn thế thôi em biết mà ! Cảm ơn anh nhiều nhiều và rất là nhiều vì anh đã không "vèo một cái bay vào sọt rác"...
Nội dung thư của em là : Em là nữ anh ạ, em không có nhu cầu viết thư như nam giới các anh . Anh có lisp nào hay do bàn tay anh viết hoặc anh sưu tầm được anh đừng quên chia sẻ với mọi người anh nhé!
Em có ấn tượng về một người có cái tên: phamngoctukts đã mạnh dạn chia sẽ : Các tác phẩm 3d của anh em cadviet, Các công trình dựng bằng 3d max. Đây là topic hay mong anh duy trì đừng để topic này rơi vào quên lãng! Em nghĩ sao viết vậy có gì không phải anh đừng giận em, tội nghiệp em lắm ứ...!

  • 0

#5 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 07 October 2010 - 11:28 PM

Anh khiêm tốn thế thôi em biết mà ! Cảm ơn anh nhiều nhiều và rất là nhiều vì anh đã không "vèo một cái bay vào sọt rác"...
Nội dung thư của em là : Em là nữ anh ạ, em không có nhu cầu viết thư như nam giới các anh . Anh có lisp nào hay do bàn tay anh viết hoặc anh sưu tầm được anh đừng quên chia sẻ với mọi người anh nhé!
Em có ấn tượng về một người có cái tên: phamngoctukts đã mạnh dạn chia sẽ : Các tác phẩm 3d của anh em cadviet, Các công trình dựng bằng 3d max. Đây là topic hay mong anh duy trì đừng để topic này rơi vào quên lãng! Em nghĩ sao viết vậy có gì không phải anh đừng giận em, tội nghiệp em lắm ứ...!

Cám ơn em!
Tất nhiên là anh sẽ cố không để nó rơi vào quên lãng. Nhưng một mình anh thì không đủ vì đây là diễn đàn mà nên cần sự ủng hộ của các thành viên khác nữa.
  • 3
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#6 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 08 October 2010 - 12:27 AM

Cám ơn em!
Tất nhiên là anh sẽ cố không để nó rơi vào quên lãng. Nhưng một mình anh thì không đủ vì đây là diễn đàn mà nên cần sự ủng hộ của các thành viên khác nữa.

Hề hề hê,
Đây là sản phẩm của bác Huong259 thông qua ngôn ngữ của bác Phamngoctukts:
3111 14 1122 41176 4, 3111 16760119 60 117622 6422 21137 77622 117622 114111 6101 646 41176. 41176 60 11510 1140 76427 150 41176 21137 76046 41176 52222 74111 152206 41176 1522119 222311 67614 53 2101 11101 1192201 41176 11763.
3111 60 411 7220119 213 11107 1192201 60 641 7311 10764111119067221675 154 11141176 15411 67614 53: 646 746 10764111 13415 6224 41176 311 641521137, 646 60119 71211176 1522119 13415 111496. 15427 14 11107 701016 76427 1110119 41176 152227 7121 1522119 153 701016 11427 1201 2140 222311 14119. 3111 119761 540 21137 21427, 60 91 16760119 107641 41176 1522119 91411 3111 701 119761310 3111 14111 22


Có gì chưa đúng mọi người đừng trách mình nhen, có trách thì trách bác Phamngoctukts hay bác huong259 ấy nha...
Hề hề hề,
Cái mửng viết thư kiểu này nghe ngộ ghê, nhỏ giờ mới thấy, thấy mà bắt ham luôn. hề hề hề....
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#7 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 08 October 2010 - 12:32 AM

Hề hề hề,
Cái mửng viết thư kiểu này nghe ngộ ghê, nhỏ giờ mới thấy, thấy mà bắt ham luôn. hề hề hề....

Vậy là ngày xưa bác không thương thầm chộm nhớ ai cả hay bác không phải là người nhát gan nhỉ.???
BS: Bác bình ạ! cái code này của em dịch suôi thì được nhưng dịch ngược lại thì hơi khó. Em đang tìm cachs dịch ngược lại làm thành code mã hoá bản vẽ cũng hay.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#8 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1431 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 08 October 2010 - 07:35 AM

Dạo này ít người yêu cầu viết lisp quá nên mình viết nghịch chơi cái lisp này.
Ngày xưa các bác chắc cũng từng thương thầm chộm nhớ một người nào đấy. Muốn viết thư cho người ta mà lại e ngại không biết ý người ta thế nào.
Thế là các bác này nghĩ ra cái chò viết thư bằng số.
Ý nghĩa là nếu người ta có thích mình thì sẽ tìm cách mày mò để dịch (điều này kiểm tra luôn IQ của người đó). Nếu người đó không thích mình thì vèo một cái bay vào sọt rác.
Code đây (dành cho các bác nhát gan). Chú ý chữ để dịch phải không có dấu.


;; free lisp from cadviet.com
(defun c:chutoso()
.............................

Cậu này nhát gan quá, phải tự tin khi viết thư cho ngừoi ấy chứ.
Phòng khi đằng ấy hỏi "mật mã", Bác làm ơn cho 1 Lisp So2Chu (để dịch nguợc í mà).
  • 1

#9 dothuyth07

dothuyth07

    biết zoom

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

Đã gửi 08 October 2010 - 09:21 AM

Dạo này ít người yêu cầu viết lisp quá nên mình viết nghịch chơi cái lisp này.
Ngày xưa các bác chắc cũng từng thương thầm chộm nhớ một người nào đấy. Muốn viết thư cho người ta mà lại e ngại không biết ý người ta thế nào.
Thế là các bác này nghĩ ra cái chò viết thư bằng số.
Ý nghĩa là nếu người ta có thích mình thì sẽ tìm cách mày mò để dịch (điều này kiểm tra luôn IQ của người đó). Nếu người đó không thích mình thì vèo một cái bay vào sọt rác.
Code đây (dành cho các bác nhát gan). Chú ý chữ để dịch phải không có dấu.


;; free lisp from cadviet.com
(defun c:chutoso()
(setq lis_chu '("A" "B" "C" "D" "E" "G" "H" "I" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "X" "Y" " "))
(setq lis_so '("4" "13" "6" "15" "3" "9" "76" "1" "16" "1" "111" "11" "0" "10" "2" "12" "5" "7" "22" "21" "96" "27"))
(setq name (car (entsel "\nChon chu la text hay mtext can chuyen sang so")))
(setq ent (entget name))
(setq loai (cdr (assoc 0 ent)))
(if (or (= loai "TEXT") (= loai "MTEXT"))
(progn
(setq chu (strcase (cdr (assoc 1 ent))))
  (setq L (strlen chu) i L ma nil)
  (Repeat L
(if (= (vl-position (substr chu i 1) lis_chu) 22)
(progn
(setq kt " ")
(setq ma (append (list kt) ma))
)
(progn    
(setq kt (atoi (nth (vl-position (substr chu i 1) lis_chu) lis_so)))
    (setq ma (append (list (rtos kt 2 0)) ma))
)
)
(setq i (1- i))
)
(setq dct (getpoint "\nchon diem chen chu da dich")
chumoi (subst (cons 10 dct) (assoc 10 ent) ent)
chumoi (subst (cons 1 (apply 'strcat ma)) (assoc 1 chumoi) chumoi)
)
(entmake chumoi)
)
(alert (strcat "doi tuong ma cac bac chon la : " loai " khong phai la text hay mtext"))
)
)


cac bac cho em hoi su dung list nay the nao vay ?
  • 0

#10 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 08 October 2010 - 09:25 AM

hì hì Các bạn viết vui ghê, mình góp ý chút xíu nếu sử dụng bảng mã ASCII thì viết không có dấu. Mình cũng đã viết để mã hoá lisp roài chia sẻ cho các bạn một chút hì hì. Bạn thử sử dụng đoạn code sau nhé.
(defun c:mahoa (/ kytu sokytu mahoatong mahokytu ktkytu)
(setq kytu (getstring "\n NhËp key: "))
(setq sokytu (strlen kytu))
(setq i 1)
(while (<= i sokytu)
(setq ktkytu (substr kytu i 1))
(setq mahoakytu (ascii ktkytu))
(setq mahoatong (append mahoatong (list mahoakytu)))
(setq i (+ i 1))
)
(princ mahoatong)
(princ)
)

Còn để dịch ngược thì các bạn dùng hàm vl-list->string chúc các bạn zui zẻ.
PS: Lisp này chỉ viết được 1 đoạn ký tự nối tiếp muốn viết thành đoạn dài thì phải nhập từ DIALOG không có cứ có dấu space là nó kết thúc.
  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#11 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 08 October 2010 - 09:38 AM

hì hì Các bạn viết vui ghê, mình góp ý chút xíu nếu sử dụng bảng mã ASCII thì viết không có dấu. Mình cũng đã viết để mã hoá lisp roài chia sẻ cho các bạn một chút hì hì. Bạn thử sử dụng đoạn code sau nhé.

(defun c:mahoa (/ kytu sokytu mahoatong mahokytu ktkytu)
(setq kytu (getstring "\n NhËp key: "))
(setq sokytu (strlen kytu))
(setq i 1)
(while (<= i sokytu)
(setq ktkytu (substr kytu i 1))
(setq mahoakytu (ascii ktkytu))
(setq mahoatong (append mahoatong (list mahoakytu)))
(setq i (+ i 1))
)
(princ mahoatong)
(princ)
)

Còn để dịch ngược thì các bạn dùng hàm vl-list->string chúc các bạn zui zẻ.
PS: Lisp này chỉ viết được 1 đoạn ký tự nối tiếp muốn viết thành đoạn dài thì phải nhập từ DIALOG không có cứ có dấu space là nó kết thúc.

Lisp lỗi rồi bạn ơi không chạy được. Còn nếu bạn muốn mã hoá text thì code đây (cái này không nhớ của bác nào viết hình như của bác Tue_VN hày Gia_bach ý)

;; free lisp from cadviet.com
;Chuong ma hoa chuoi theo thuat toan Ceasar
(DEFUN ENCRYPT(str n / i l str1 m)
(setq str1 "a")
(setq l (strlen str))
(setq i 1)
(while (<= i l)
(setq c (substr str i 1))
(setq m (- (ascii c) 32))
(setq m (+ m n))
(while (< m 0)
(setq m (+ m 224))
)
(setq m (MOD m 224))
(setq str1 (strcat str1 (chr (nth m LiAlpha))))
(setq i (1+ i))
)
(setq str1 (substr str1 2))
str1
)
(DEFUN DECRYPT (str n / i l str1 m)
(setq str1 "a")
(setq l (strlen str))
(setq i 1)
(while (<= i l)
(setq c (substr str i 1))
(setq m (- (ascii c) 32))
(setq m (- m n))
(while (< m 0)
(setq m (+ m 224))
)
(setq m (MOD m 224))
(setq str1 (strcat str1 (chr (nth m LiAlpha))))
(setq i (1+ i))
)
(setq str1 (substr str1 2))
str1
)

(DEFUN SETALPHA( / Li)
  (setq Li (List))
  (setq i 32)
  (while (<= i 255)
    (setq Li (append Li (List i)))
    (setq i (1+ i))
  )
  (setq LiAlpha Li)
)  
(DEFUN MOD (m n / kq)
(while (>= m n)
(setq m (- m n))
)
(setq kq m)
kq
)
(DEFUN C:ENC (/ ss str str0)
  (SETALPHA)
  (setvar "CMDECHO" 0)
  (princ "\nChon doi tuong can ma hoa:")  
  (setq ss (ssget '((-4 . ""))))
  (setq m (getint "Cho biet ma khoa: "))
  (setq i 0)
  (setq dt (ssname ss 0))  
  (setq n (sslength ss))
  (setq i 0)
  (while (< i n)    
    (setq dt (ssname ss i))    
    (setq str (GETCONTENT dt))    
    (setq str0 str)
    (if (= (TENDOITUONG dt) "TEXT")
      (setq str (ENCRYPT str m))
      (setq str (ENC_MTEXT str m))    
    )    
    (setq obj (entget dt))
    (setq obj (subst (cons 1 str) (cons 1 str0) obj))    
    (entmod obj)
    (entupd dt)
    (setq i (1+ i))
  )
  (setvar "CMDECHO" 0)
  (princ)
)
(DEFUN C:DEC (/ ss str str0)
  (SETALPHA)
  (setvar "CMDECHO" 0)
  (princ "\nChon doi tuong can giai ma:")  
  (setq ss (ssget '((-4 . ""))))
  (setq m (getint "Cho biet ma khoa: "))
  (setq i 0)
  (setq dt (ssname ss 0))  
  (setq n (sslength ss))
  (setq i 0)
  (while (< i n)    
    (setq dt (ssname ss i))    
    (setq str (GETCONTENT dt))    
    (setq str0 str)
    (if (= (TENDOITUONG dt) "TEXT")
      (setq str (DECRYPT str m))
      (setq str (DEC_MTEXT str m))    
    )    
    (setq obj (entget dt))
    (setq obj (subst (cons 1 str) (cons 1 str0) obj))    
    (entmod obj)
    (entupd dt)
    (setq i (1+ i))
  )
  (setvar "CMDECHO" 0)
  (princ)
)

(DEFUN ENC_MTEXT(str m / LiStr i encstr n)
  (setq LiStr (List))
  (setq encstr "a")  
  (setq i (POSTSTR str "\\P"))  
  (if (= i 0)
    (setq LiStr (Append LiStr (List str)))
    (progn      
      (while (> i 0)    
    (setq temp (substr str 1 (1- i)))    
        (setq LiStr (Append LiStr (List temp)))
        (setq str (substr str (+ i 2)))    
    (setq i (POSTSTR str "\\P"))    
      )
      (setq LiStr (Append LiStr (List str)))      
    )
  )
  (setq n (length LiStr))  
  (setq i 0)
  (while(< i n)
    (setq encstr (strcat encstr "\\P" (ENCRYPT (nth i LiStr) m)))
    (setq i (+ i 1))    
  )  
  (setq encstr (substr encstr 4))
  encstr
)  
(DEFUN DEC_MTEXT(str m / LiStr i decstr n)
  (setq LiStr (List))
  (setq decstr "a")  
  (setq i (POSTSTR str "\\P"))  
  (if (= i 0)
    (setq LiStr (Append LiStr (List str)))
    (progn      
      (while (> i 0)    
    (setq temp (substr str 1 (1- i)))    
        (setq LiStr (Append LiStr (List temp)))
        (setq str (substr str (+ i 2)))    
    (setq i (POSTSTR str "\\P"))    
      )
      (setq LiStr (Append LiStr (List str)))      
    )
  )
  (setq n (length LiStr))  
  (setq i 0)
  (while(< i n)
    (setq decstr (strcat decstr "\\P" (DECRYPT (nth i LiStr) m)))
    (setq i (+ i 1))    
  )  
  (setq decstr (substr decstr 4))
  decstr
)
(DEFUN GETCONTENT (obj / cont)
  (setq cont (cdr (assoc 1 (entget obj))))
  cont
)
(DEFUN POSTSTR(str0 str / vt i l0 l)
  (setq vt 0)
  (setq l0 (strlen str0))
  (setq l (strlen str))
  (setq i 1)
  (while (< i (- l0 l -1))
    (if (= (substr str0 i l) str)
      (progn            
        (setq vt i)
        (setq i l0)
      )
    )
    (setq i (1+ i))
  )
  vt
)
(DEFUN TENDOITUONG (obj / name)
  (setq name (CDR (ASSOC 0 (ENTGET obj))))  
  name  
)

  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#12 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 08 October 2010 - 09:43 AM

Lisp lỗi rồi bạn ơi không chạy được. Còn nếu bạn muốn mã hoá text thì code đây (cái này không nhớ của bác nào viết hình như của bác Tue_VN hày Gia_bach ý)


;; free lisp from cadviet.com
;Chuong ma hoa chuoi theo thuat toan Ceasar
(DEFUN ENCRYPT(str n / i l str1 m)
(setq str1 "a")
(setq l (strlen str))
(setq i 1)
(while (<= i l)
(setq c (substr str i 1))
(setq m (- (ascii c) 32))
(setq m (+ m n))
(while (< m 0)
(setq m (+ m 224))
)
(setq m (MOD m 224))
(setq str1 (strcat str1 (chr (nth m LiAlpha))))
(setq i (1+ i))
)
(setq str1 (substr str1 2))
str1
)
(DEFUN DECRYPT (str n / i l str1 m)
(setq str1 "a")
(setq l (strlen str))
(setq i 1)
(while (<= i l)
(setq c (substr str i 1))
(setq m (- (ascii c) 32))
(setq m (- m n))
(while (< m 0)
(setq m (+ m 224))
)
(setq m (MOD m 224))
(setq str1 (strcat str1 (chr (nth m LiAlpha))))
(setq i (1+ i))
)
(setq str1 (substr str1 2))
str1
)

(DEFUN SETALPHA( / Li)
  (setq Li (List))
  (setq i 32)
  (while (<= i 255)
    (setq Li (append Li (List i)))
    (setq i (1+ i))
  )
  (setq LiAlpha Li)
)  
(DEFUN MOD (m n / kq)
(while (>= m n)
(setq m (- m n))
)
(setq kq m)
kq
)
(DEFUN C:ENC (/ ss str str0)
  (SETALPHA)
  (setvar "CMDECHO" 0)
  (princ "\nChon doi tuong can ma hoa:")  
  (setq ss (ssget '((-4 . ""))))
  (setq m (getint "Cho biet ma khoa: "))
  (setq i 0)
  (setq dt (ssname ss 0))  
  (setq n (sslength ss))
  (setq i 0)
  (while (< i n)    
    (setq dt (ssname ss i))    
    (setq str (GETCONTENT dt))    
    (setq str0 str)
    (if (= (TENDOITUONG dt) "TEXT")
      (setq str (ENCRYPT str m))
      (setq str (ENC_MTEXT str m))    
    )    
    (setq obj (entget dt))
    (setq obj (subst (cons 1 str) (cons 1 str0) obj))    
    (entmod obj)
    (entupd dt)
    (setq i (1+ i))
  )
  (setvar "CMDECHO" 0)
  (princ)
)
(DEFUN C:DEC (/ ss str str0)
  (SETALPHA)
  (setvar "CMDECHO" 0)
  (princ "\nChon doi tuong can giai ma:")  
  (setq ss (ssget '((-4 . ""))))
  (setq m (getint "Cho biet ma khoa: "))
  (setq i 0)
  (setq dt (ssname ss 0))  
  (setq n (sslength ss))
  (setq i 0)
  (while (< i n)    
    (setq dt (ssname ss i))    
    (setq str (GETCONTENT dt))    
    (setq str0 str)
    (if (= (TENDOITUONG dt) "TEXT")
      (setq str (DECRYPT str m))
      (setq str (DEC_MTEXT str m))    
    )    
    (setq obj (entget dt))
    (setq obj (subst (cons 1 str) (cons 1 str0) obj))    
    (entmod obj)
    (entupd dt)
    (setq i (1+ i))
  )
  (setvar "CMDECHO" 0)
  (princ)
)

(DEFUN ENC_MTEXT(str m / LiStr i encstr n)
  (setq LiStr (List))
  (setq encstr "a")  
  (setq i (POSTSTR str "\\P"))  
  (if (= i 0)
    (setq LiStr (Append LiStr (List str)))
    (progn      
      (while (> i 0)    
    (setq temp (substr str 1 (1- i)))    
        (setq LiStr (Append LiStr (List temp)))
        (setq str (substr str (+ i 2)))    
    (setq i (POSTSTR str "\\P"))    
      )
      (setq LiStr (Append LiStr (List str)))      
    )
  )
  (setq n (length LiStr))  
  (setq i 0)
  (while(< i n)
    (setq encstr (strcat encstr "\\P" (ENCRYPT (nth i LiStr) m)))
    (setq i (+ i 1))    
  )  
  (setq encstr (substr encstr 4))
  encstr
)  
(DEFUN DEC_MTEXT(str m / LiStr i decstr n)
  (setq LiStr (List))
  (setq decstr "a")  
  (setq i (POSTSTR str "\\P"))  
  (if (= i 0)
    (setq LiStr (Append LiStr (List str)))
    (progn      
      (while (> i 0)    
    (setq temp (substr str 1 (1- i)))    
        (setq LiStr (Append LiStr (List temp)))
        (setq str (substr str (+ i 2)))    
    (setq i (POSTSTR str "\\P"))    
      )
      (setq LiStr (Append LiStr (List str)))      
    )
  )
  (setq n (length LiStr))  
  (setq i 0)
  (while(< i n)
    (setq decstr (strcat decstr "\\P" (DECRYPT (nth i LiStr) m)))
    (setq i (+ i 1))    
  )  
  (setq decstr (substr decstr 4))
  decstr
)
(DEFUN GETCONTENT (obj / cont)
  (setq cont (cdr (assoc 1 (entget obj))))
  cont
)
(DEFUN POSTSTR(str0 str / vt i l0 l)
  (setq vt 0)
  (setq l0 (strlen str0))
  (setq l (strlen str))
  (setq i 1)
  (while (< i (- l0 l -1))
    (if (= (substr str0 i l) str)
      (progn            
        (setq vt i)
        (setq i l0)
      )
    )
    (setq i (1+ i))
  )
  vt
)
(DEFUN TENDOITUONG (obj / name)
  (setq name (CDR (ASSOC 0 (ENTGET obj))))  
  name  
)

Không lỗi đâu bảng mã ASCII là bảng chữ cái không dấu bác à. Đánh không dấu nhé!
  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#13 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 08 October 2010 - 09:54 AM

hì hì Các bạn viết vui ghê, mình góp ý chút xíu nếu sử dụng bảng mã ASCII thì viết không có dấu. Mình cũng đã viết để mã hoá lisp roài chia sẻ cho các bạn một chút hì hì. Bạn thử sử dụng đoạn code sau nhé.

(defun c:mahoa (/ kytu sokytu mahoatong mahokytu ktkytu)
(setq kytu (getstring "\n NhËp key: "))
(setq sokytu (strlen kytu))
(setq i 1)
(while (<= i sokytu)
(setq ktkytu (substr kytu i 1))
(setq mahoakytu (ascii ktkytu))
(setq mahoatong (append mahoatong (list mahoakytu)))
(setq i (+ i 1))
)
(princ mahoatong)
(princ)
)

Còn để dịch ngược thì các bạn dùng hàm vl-list->string chúc các bạn zui zẻ.
PS: Lisp này chỉ viết được 1 đoạn ký tự nối tiếp muốn viết thành đoạn dài thì phải nhập từ DIALOG không có cứ có dấu space là nó kết thúc.

Dài dòng quá :cheers:
Gọn bớt 1 chút :
(defun c:mahoa ()
(princ (vl-string->list (getstring "\n NhËp key: ")))
(princ)
)

  • 0

#14 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 08 October 2010 - 09:59 AM

Dài dòng quá :cheers:
Gọn bớt 1 chút :
(defun c:mahoa ()
(princ (vl-string->list (getstring "\n NhËp key: ")))
(princ)
)

ha ha chính xác là như vậy ha ha ha, cái này mình viết từ hồi chưa biết vl-........ là gì mừ. :cheers:
  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#15 truongvoky

truongvoky

    Chưa sử dụng CAD

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

Đã gửi 20 November 2010 - 11:41 PM

Dạo này ít người yêu cầu viết lisp quá nên mình viết nghịch chơi cái lisp này.
Ngày xưa các bác chắc cũng từng thương thầm chộm nhớ một người nào đấy. Muốn viết thư cho người ta mà lại e ngại không biết ý người ta thế nào.
Thế là các bác này nghĩ ra cái chò viết thư bằng số.
Ý nghĩa là nếu người ta có thích mình thì sẽ tìm cách mày mò để dịch (điều này kiểm tra luôn IQ của người đó). Nếu người đó không thích mình thì vèo một cái bay vào sọt rác.
Code đây (dành cho các bác nhát gan). Chú ý chữ để dịch phải không có dấu.


;; free lisp from cadviet.com
(defun c:chutoso()
(setq lis_chu '("A" "B" "C" "D" "E" "G" "H" "I" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "X" "Y" " "))
(setq lis_so '("4" "13" "6" "15" "3" "9" "76" "1" "16" "1" "111" "11" "0" "10" "2" "12" "5" "7" "22" "21" "96" "27"))
(setq name (car (entsel "\nChon chu la text hay mtext can chuyen sang so")))
(setq ent (entget name))
(setq loai (cdr (assoc 0 ent)))
(if (or (= loai "TEXT") (= loai "MTEXT"))
(progn
(setq chu (strcase (cdr (assoc 1 ent))))
  (setq L (strlen chu) i L ma nil)
  (Repeat L
(if (= (vl-position (substr chu i 1) lis_chu) 22)
(progn
(setq kt " ")
(setq ma (append (list kt) ma))
)
(progn    
(setq kt (atoi (nth (vl-position (substr chu i 1) lis_chu) lis_so)))
    (setq ma (append (list (rtos kt 2 0)) ma))
)
)
(setq i (1- i))
)
(setq dct (getpoint "\nchon diem chen chu da dich")
chumoi (subst (cons 10 dct) (assoc 10 ent) ent)
chumoi (subst (cons 1 (apply 'strcat ma)) (assoc 1 chumoi) chumoi)
)
(entmake chumoi)
)
(alert (strcat "doi tuong ma cac bac chon la : " loai " khong phai la text hay mtext"))
)
)

67640 1346 722!
14119 7764119 712311 151311 75411 776427 11510 6224 1346 76427 76427. 77622 21137 77622 6760 1192291 27322 641 67601.
  • 1

#16 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 20 November 2010 - 11:45 PM

67640 1346 722!
14119 7764119 712311 151311 75411 776427 11510 6224 1346 76427 76427. 77622 21137 77622 6760 1192291 27322 641 67601.

Hê hê!
Chắc ông này viết thư cho Triệu Mẫn.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#17 khaosat2009

khaosat2009

    biết lệnh offset

  • Members
  • PipPipPip
  • 171 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 21 November 2010 - 10:16 AM

Dạo này ít người yêu cầu viết lisp quá nên mình viết nghịch chơi cái lisp này.
Ngày xưa các bác chắc cũng từng thương thầm chộm nhớ một người nào đấy. Muốn viết thư cho người ta mà lại e ngại không biết ý người ta thế nào.
Thế là các bác này nghĩ ra cái chò viết thư bằng số.
Ý nghĩa là nếu người ta có thích mình thì sẽ tìm cách mày mò để dịch (điều này kiểm tra luôn IQ của người đó). Nếu người đó không thích mình thì vèo một cái bay vào sọt rác.
Code đây (dành cho các bác nhát gan). Chú ý chữ để dịch phải không có dấu.


;; free lisp from cadviet.com
(defun c:chutoso()
(setq lis_chu '("A" "B" "C" "D" "E" "G" "H" "I" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "X" "Y" " "))
(setq lis_so '("4" "13" "6" "15" "3" "9" "76" "1" "16" "1" "111" "11" "0" "10" "2" "12" "5" "7" "22" "21" "96" "27"))
(setq name (car (entsel "\nChon chu la text hay mtext can chuyen sang so")))
(setq ent (entget name))
(setq loai (cdr (assoc 0 ent)))
(if (or (= loai "TEXT") (= loai "MTEXT"))
(progn
(setq chu (strcase (cdr (assoc 1 ent))))
  (setq L (strlen chu) i L ma nil)
  (Repeat L
(if (= (vl-position (substr chu i 1) lis_chu) 22)
(progn
(setq kt " ")
(setq ma (append (list kt) ma))
)
(progn    
(setq kt (atoi (nth (vl-position (substr chu i 1) lis_chu) lis_so)))
    (setq ma (append (list (rtos kt 2 0)) ma))
)
)
(setq i (1- i))
)
(setq dct (getpoint "\nchon diem chen chu da dich")
chumoi (subst (cons 10 dct) (assoc 10 ent) ent)
chumoi (subst (cons 1 (apply 'strcat ma)) (assoc 1 chumoi) chumoi)
)
(entmake chumoi)
)
(alert (strcat "doi tuong ma cac bac chon la : " loai " khong phai la text hay mtext"))
)
)

Bạn giúp mình việc chuyển số thành chử. Cám ơn.
  • 0

#18 TokyoNhat

TokyoNhat

    biết vẽ spline

  • Members
  • PipPip
  • 94 Bài viết
Điểm đánh giá: 16 (tàm tạm)

Đã gửi 14 December 2010 - 12:50 AM

@phamngoctukts anh ơi, anh nhận được tin nhắn chưa a ?
Anh Tu ơi anh viết lisp ngược đổi text thanh chu đi , em đang cần có chut việc " Gửi thư rùi nhưng bạn em hỏi có cách nào giải mã không ?" Cám ơn anh trước nha !
  • 0
  • Quá khứ là lịch sử, tương lai là màu nhiệm, còn hiện tại là món quà của cuộc sống...
  • Cuộc sống vốn không công bằng - Hãy tập quen dần với điều đó

#19 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 December 2010 - 08:50 AM

@phamngoctukts anh ơi, anh nhận được tin nhắn chưa a ?
Anh Tu ơi anh viết lisp ngược đổi text thanh chu đi , em đang cần có chut việc " Gửi thư rùi nhưng bạn em hỏi có cách nào giải mã không ?" Cám ơn anh trước nha !

Bác Tú cũng đến khócmất thôi :undecided:
  • 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


#20 TokyoNhat

TokyoNhat

    biết vẽ spline

  • Members
  • PipPip
  • 94 Bài viết
Điểm đánh giá: 16 (tàm tạm)

Đã gửi 14 December 2010 - 10:48 AM

Sao lai khóc hả ban ? Mình tưởng viết lisp ngược lại từ lisp trước không phức tạp lắm chứ !
  • 0
  • Quá khứ là lịch sử, tương lai là màu nhiệm, còn hiện tại là món quà của cuộc sống...
  • Cuộc sống vốn không công bằng - Hãy tập quen dần với điều đó