Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] Lisp kết hợp lệnh Array và Copy


  • Please log in to reply
54 replies to this topic

#41 quickandfine

quickandfine

    biết lệnh copy

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

Đã gửi 09 July 2012 - 04:38 PM

Hề hề hề,
Bạn đã làm như mình nói ở bài post số 38 chưa???
Mình sửa như vầy là thấy OK rồi.
Nếu bạn vân chưa thấy Ok thì mình không biết là lỗi chỗ nào nữa. Đành chớ bác DoanVanHa thôi.

Chào bác phamthanhbinh:
Xấu hổ quá.Em thay mãi mà nó vẫn chưa được bác ạ. Lần thành công nhất mà em thay được là em post ở bài số #37 rồi bác ạ. Nếu tiện bác có thể post đoạn bác thay lên và thử thành công cho em xin được không ạ. Em xin cảm ơn bác nhiều ạ!
  • 0

#42 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 09 July 2012 - 08:27 PM

Chào bác phamthanhbinh:
Xấu hổ quá.Em thay mãi mà nó vẫn chưa được bác ạ. Lần thành công nhất mà em thay được là em post ở bài số #37 rồi bác ạ. Nếu tiện bác có thể post đoạn bác thay lên và thử thành công cho em xin được không ạ. Em xin cảm ơn bác nhiều ạ!

Hề hề hề,
Bạn quá ỷ lại đấy. Những việc đơn giản này mà bạn không muốn làm, chỉ muốn có sẵn là sao nhỉ??? Đọc kỹ những bài mình đã post và sửa đi. Có vậy bạn mới mong có thể hiểu chút chút về lisp mà ứng dụng, chứ còn ngồi chờ như vậy không phải cách của người cần lisp đâu.
Mình đã làm và việc cho bạn chả khó khăn gì, nhưng mình không thích cái sự ỷ lại này. Bạn đã sửa được như bài post số 37 thì không có lý gì không hiểu cái bài post 38 của mình mà chỉ là bạn lười và ỷ lại thôi.
Nếu bạn đã sửa như bài post số 38 của mình mà chưa được thì mới có chuyện để nói, còn nếu bạn không sửa thì mình chịu, không giúp bạn được.
Chúc bạn thành công.
  • -1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#43 quickandfine

quickandfine

    biết lệnh copy

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

Đã gửi 10 July 2012 - 11:11 AM

Hề hề hề,
Bạn quá ỷ lại đấy. Những việc đơn giản này mà bạn không muốn làm, chỉ muốn có sẵn là sao nhỉ??? Đọc kỹ những bài mình đã post và sửa đi. Có vậy bạn mới mong có thể hiểu chút chút về lisp mà ứng dụng, chứ còn ngồi chờ như vậy không phải cách của người cần lisp đâu.
Mình đã làm và việc cho bạn chả khó khăn gì, nhưng mình không thích cái sự ỷ lại này. Bạn đã sửa được như bài post số 37 thì không có lý gì không hiểu cái bài post 38 của mình mà chỉ là bạn lười và ỷ lại thôi.
Nếu bạn đã sửa như bài post số 38 của mình mà chưa được thì mới có chuyện để nói, còn nếu bạn không sửa thì mình chịu, không giúp bạn được.
Chúc bạn thành công.

Chào bác phamthanhbinh.
Trước tiên em cảm ơn bác đã nhiệt tình chỉ bảo, giúp đỡ và trả lời từng thắc mắc của em. Nhưng em có ý kiến thế này.
Em không ỷ lại bác ạ,Oan cho em quá. Em đã thử thay rất nhiều lần mà vẫn không được nên em mới "chai mặt" lên để hỏi lại các bác như thế. Em thử thay bằng Note Pad, Text Pad cả một buổi chiều chưa được nên mới thế thôi ạ. Mỗi lần đọc gợi ý của bác em lại xem lại một lần rồi mới thay nhưng kết quả đều vô vọng.
Đến lúc đọc bài Post số #40 của bác em lại thử thay lại một lần nữa mà vân chưa được (hi). Nhưng thôi,trong khi chờ đợi đến lúc em thay thành công theo gợi ý của bác thì em dùng đoạn lisp cũ (OC_OC_OCA) down trên diễn đàn cũng tốt rồi ạ. Chỉ là em muốn array cho nhanh hơn chút thôi ạ.
Một lần nữa cảm ơn các bác ạ!
Ps: Em chỉ thấy bài post số 36 là bác gợi ý em thay chứ nhỉ. Bài Post số 38 là em Reply lại mà???
  • 0

#44 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 10 July 2012 - 11:16 AM

@quickandfire : bài #38 bạn không thấy do bài trước đó (37) đã bị ẩn kéo theo một loạt bài sau đó. Lý do bị ẩn là bạn post một đoạn code dài mà không buồn cho vào code tag !
  • 1

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


#45 quickandfine

quickandfine

    biết lệnh copy

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

Đã gửi 10 July 2012 - 11:32 AM

@quickandfire : bài #38 bạn không thấy do bài trước đó (37) đã bị ẩn kéo theo một loạt bài sau đó. Lý do bị ẩn là bạn post một đoạn code dài mà không buồn cho vào code tag !

Cảm ơn anh Ket đã thông báo cho em biết lý do. Không biết có phải lúc đó do Internet chỗ em chập chờn hay thế nào mà lại bị thế chứ em không cố ý làm thế đâu ạ. Vậy bây giờ làm thế nào để em thấy lại được bài số 38 mà anh phamthanhbinh đã post ạ?
  • 0

#46 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 10 July 2012 - 11:46 AM

Mình đã view lại
  • 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


#47 quickandfine

quickandfine

    biết lệnh copy

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

Đã gửi 10 July 2012 - 12:00 PM

Mình đã view lại

Em đã Xem lại và thay đoạn lisp theo gợi ý của bác phamthanhbinh thành công.
Cảm ơn anh Ket va anh phamthanhbinh nhiều nhiều ạ
  • 0

#48 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 10 July 2012 - 12:01 PM

Chào bác phamthanhbinh.
Trước tiên em cảm ơn bác đã nhiệt tình chỉ bảo, giúp đỡ và trả lời từng thắc mắc của em. Nhưng em có ý kiến thế này.
Em không ỷ lại bác ạ,Oan cho em quá. Em đã thử thay rất nhiều lần mà vẫn không được nên em mới "chai mặt" lên để hỏi lại các bác như thế. Em thử thay bằng Note Pad, Text Pad cả một buổi chiều chưa được nên mới thế thôi ạ. Mỗi lần đọc gợi ý của bác em lại xem lại một lần rồi mới thay nhưng kết quả đều vô vọng.
Đến lúc đọc bài Post số #40 của bác em lại thử thay lại một lần nữa mà vân chưa được (hi). Nhưng thôi,trong khi chờ đợi đến lúc em thay thành công theo gợi ý của bác thì em dùng đoạn lisp cũ (OC_OC_OCA) down trên diễn đàn cũng tốt rồi ạ. Chỉ là em muốn array cho nhanh hơn chút thôi ạ.
Một lần nữa cảm ơn các bác ạ!
Ps: Em chỉ thấy bài post số 36 là bác gợi ý em thay chứ nhỉ. Bài Post số 38 là em Reply lại mà???

Sorry bạn vì đã nghĩ oan cho bạn. Do mình vẫn đọc được bài post,(mặc dù thấy nó bị đổi màu mà chửa biết tại sao) nên cứ tưởng bạn cũng đọc được.
Vậy thì đền cho bạn nhé.
Đoạn code đó đây:


(if dt2
(progn
(initget "Y N")
(setq ;;;;kwrd (getkword "\nBan muon Text tang dan ? [Y/<N>] ")
giaso (getreal "\nGia so: "))
(setq x 1)
(repeat (1- sl)
(command ".copy" dt2 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
;;;;(if (eq kwrd "Y")
(progn
(CHIA3 (cdr (assoc 1 (entget dt2))))
(setq daup (if (not (vl-string-search "." (cadr ds)))
0
(- (strlen (cadr ds)) (vl-string-search "." (cadr ds)) 1)
)
)
(entmod (subst (cons 1 (strcat (car ds) (THEM0 (cadr ds) (rtos (+ (atof (cadr ds)) (* x giaso)) 2 daup)) (caddr ds)))
(assoc 1 (entget (entlast))) (entget (entlast)))
)
(entupd (entlast))
)
;;;;)
(setq x (1+ x))
)
)
)

Hề hề hề, một lần nữa xin lỗi bạn và mong bạn lần sau rút kinh nghiệm kẻo lại bị các mode cho treo bài nữa thì thiệt thòi lắm lắ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.

#49 quickandfine

quickandfine

    biết lệnh copy

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

Đã gửi 10 July 2012 - 12:04 PM

Sorry bạn vì đã nghĩ oan cho bạn. Do mình vẫn đọc được bài post,(mặc dù thấy nó bị đổi màu mà chửa biết tại sao) nên cứ tưởng bạn cũng đọc được.
Vậy thì đền cho bạn nhé.
Đoạn code đó đây:



(if dt2
(progn
(initget "Y N")
(setq ;;;;kwrd (getkword "\nBan muon Text tang dan ? [Y/<N>] ")
giaso (getreal "\nGia so: "))
(setq x 1)
(repeat (1- sl)
(command ".copy" dt2 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
;;;;(if (eq kwrd "Y")
(progn
(CHIA3 (cdr (assoc 1 (entget dt2))))
(setq daup (if (not (vl-string-search "." (cadr ds)))
0
(- (strlen (cadr ds)) (vl-string-search "." (cadr ds)) 1)
)
)
(entmod (subst (cons 1 (strcat (car ds) (THEM0 (cadr ds) (rtos (+ (atof (cadr ds)) (* x giaso)) 2 daup)) (caddr ds)))
(assoc 1 (entget (entlast))) (entget (entlast)))
)
(entupd (entlast))
)
;;;;)
(setq x (1+ x))
)
)
)

Hề hề hề, một lần nữa xin lỗi bạn và mong bạn lần sau rút kinh nghiệm kẻo lại bị các mode cho treo bài nữa thì thiệt thòi lắm lắm.

Không sao bác ạ. Bác cũng đâu có biết sự thể như vậy đâu.Em thay được đoạn code đó và lisp chạy được là em mừng lắm rồi!
  • 0

#50 nguoihung_3

nguoihung_3

    biết zoom

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

Đã gửi 13 July 2012 - 10:22 AM

@Doan Van Ha bác pro thật!thanks bác!em đang cần lisp này!

  • 0

#51 kimvantoan

kimvantoan

    biết vẽ line

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

Đã gửi 28 March 2013 - 08:35 AM

Rất cảm ơn Ketxu đã có 1 số góp ý để Lisp được hoàn thiện hơn.
Lệnh này Copy_Array các đối tượng, kể cả Text (Mtext). Riêng Text chứa số thì có thể tăng/giảm theo gia số, nó chấp nhận cả số có tiền và/hoặc hậu tố.
Nếu có nhiều Text số được chọn thì chỉ 1 Text số chọn sau cùng được tăng/giảm. Số chữ số thập phân (nếu có) sẽ lấy theo Text chọn.

; Doan Van Ha CADViet.com
; Copy-Array cac doi tuong ke ca Text (Mtext), rieng Text co chua so thi tang giam theo gia so, chap nhan so co tien to va hau to.
; Neu co nhieu Text chua so duoc chon thi chi 1 Text chon sau cung duoc tang/giam. So chu so thap phan (neu co) lay theo Text chon.
; P/S (01-03-2012): bo sung them so chu so 0 dau num de phu hop voi text mau. VD: "CN: 01" tang thanh "CN: 02"...
(defun C:CA (/ dsdt dt dt1 dt2 p1 p2 sl x kwrd strt strp num sym ds daup giaso)
 (vl-load-com)
 (command "undo" "be")
 (setq osm (getvar "osmode") cmd (getvar "cmdecho"))
 (princ "\nChon cac doi tuong can Copy-Array...")
 (setq dsdt (vl-remove-if 'listp (mapcar 'cadr (ssnamex (setq dt (ssget)))))
       	dt1 dt p1 (getpoint "\nDiem goc: ") p2 (getpoint p1 "\nDiem den: ") sl (getint "\nSo lan: ") x 1)
 (setvar "osmode" 0) (setvar "cmdecho" 0)
 (foreach n dsdt
  (if (or (= "TEXT" (cdr (assoc 0 (entget n)))) (= "MTEXT" (cdr (assoc 0 (entget n)))))
   (if (KT_NUM (cdr (assoc 1 (entget n))))
	(setq dt2 n))))
 (if dt2 (setq dt1 (ssdel dt2 dt)))
 (if dt2
  (progn
   (initget "Y N")
   (setq kwrd (getkword "\nBan muon Text tang dan ? [Y/<N>]  ") giaso (getreal "\nGia so: "))
   (setq x 1)
   (repeat (1- sl)
	(command ".copy" dt2 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
	(if (eq kwrd "Y")
 	(progn
  	(CHIA3 (cdr (assoc 1 (entget dt2))))
  	(setq daup (if (not (vl-string-search "." (cadr ds))) 0 (- (strlen (cadr ds)) (vl-string-search "." (cadr ds)) 1)))
  	(entmod (subst (cons 1 (strcat (car ds) (THEM0 (cadr ds) (rtos (+ (atof (cadr ds)) (* x giaso)) 2 daup)) (caddr ds))) (assoc 1 (entget (entlast))) (entget (entlast))))
  	(entupd (entlast))))
	(setq x (1+ x)))))
 (if dt1
  (progn
   (setq x 1)
   (repeat (1- sl)
	(command ".copy" dt1 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
	(setq x (1+ x)))))
 (command "undo" "e")
 (setvar "osmode" osm) (setvar "cmdecho" cmd)
 (princ))
;----- Chia text ra tiento_num_hauto.
(defun CHIA3 (str / trai phai lstt lstn)
 (setq lstt (vl-string->list str) lstn (reverse lstt))
 (while lstt
  (cond ((or (< (car lstt) 48) (> (car lstt) 57)) (setq trai (cons (car lstt) trai) lstt (cdr lstt)))
         	(T (setq lstt nil))))
 (while lstn
  (cond ((or (< (car lstn) 48) (> (car lstn) 57)) (setq phai (cons (car lstn) phai) lstn (cdr lstn)))
         	(T (setq lstn nil))))
 (setq ds (list (vl-list->string (reverse trai))
                    	(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-string-right-trim (vl-list->string phai) (vl-string-left-trim (vl-list->string trai) str)))
                    	(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-list->string phai)))))
;----- Kiem tra 1 text co chua num hay khong?
(defun KT_NUM(str / ds kt)
 (foreach n (vl-string->list str)
  (if (and (>= n 48) (<= n 57)) (setq kt T)))
 kt)
 ;----- Thong ke so chu so truoc dau thap phan.
(defun KT_FIX(str / m)
 (setq m 0)
 (while (and (> (strlen str) 0) (/= (substr str 1 1) "."))
  (setq m (1+ m) str (substr str 2)))
 m)
;----- Them so chu so 0 vao dau text cho phu hop.
(defun THEM0(strt strs)
 (while (> (- (KT_FIX strt) (KT_FIX strs)) 0)
  (setq strs (strcat "0" strs)))
 strs)
P/S: sửa 07/02/2012 để không còn dùng các hàm Acet.
P/S: sửa 01/03/2012 để thêm số chữ số 0 vào đầu Num của Text để phù hợp với Text gốc.

Chào bác Doan Van Ha! Không biết bác có còn theo dõi topic này nữa không. Nếu bác còn theo dõi thì giải quyết giúp tôi vấn đề này với. Tôi đã dowload lisp của bác về dùng. Lisp dùng rất hay và đáp ứng được nhu cầu sử dụng của tôi. Nhưng tôi muốn thay đổi việc "nhập hai điểm đầu tiên là khoảng cách các text và nhập số lần là số text cần copy" bằng việc "nhập hai điểm đầu tiên là khoảng mà text sẽ copy(ví dụ trong khoảng 100m) và chọn hai điểm tiếp theo để lấy khoảng cách giữa hai text(ví dụ là 1m). Tôi thấy làm như thế thì sẽ tiện hơn khi sử dụng(theo tôi là như vậy). Tôi có sưu tầm được một lisp copy và array như thế, nhưng nó không tăng được số. Đây là lisp tôi đang sử dụng http://www.cadviet.com/upfiles/3/67165_copyarray.lsp

Rất cám ơn bác về lisp của bác!


  • 0

#52 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 28 March 2013 - 08:53 AM

Bạn thay đoạn này:

(getint "\nSo lan: ")

Bằng đoạn này:

(fix (+ (/ (distance p1 (getpoint "\nDiem den cuoi cung: ")) (distance p1 p2)) 1))

Chú ý: để chính xác thì 2 khoảng cách chia nhau phải ra 1 số nguyên.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#53 kimvantoan

kimvantoan

    biết vẽ line

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

Đã gửi 28 March 2013 - 04:29 PM

Bạn thay đoạn này:

(getint "\nSo lan: ")

Bằng đoạn này:

(fix (+ (/ (distance p1 (getpoint "\nDiem den cuoi cung: ")) (distance p1 p2)) 1))

Chú ý: để chính xác thì 2 khoảng cách chia nhau phải ra 1 số nguyên.

Cám ơn bác đã hồi đáp! Tôi đã làm theo như thế nhưng vẫn không được, tôi không hiểu nhiều vì lisp, mong bác giúp cho!


  • 0

#54 thai11000

thai11000

    biết vẽ arc

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

Đã gửi 21 March 2014 - 02:58 PM

Các cao thủ thật là tuyệt vời!

Mong các bác luôn chia sẻ và cống hiến để bọn em học hỏi!


  • 0

#55 vuvu93

vuvu93

    Chưa sử dụng CAD

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

Đã gửi 09 May 2016 - 05:53 PM

Rất cảm ơn Ketxu đã có 1 số góp ý để Lisp được hoàn thiện hơn.
Lệnh này Copy_Array các đối tượng, kể cả Text (Mtext). Riêng Text chứa số thì có thể tăng/giảm theo gia số, nó chấp nhận cả số có tiền và/hoặc hậu tố.
Nếu có nhiều Text số được chọn thì chỉ 1 Text số chọn sau cùng được tăng/giảm. Số chữ số thập phân (nếu có) sẽ lấy theo Text chọn.

; Doan Van Ha CADViet.com
; Copy-Array cac doi tuong ke ca Text (Mtext), rieng Text co chua so thi tang giam theo gia so, chap nhan so co tien to va hau to.
; Neu co nhieu Text chua so duoc chon thi chi 1 Text chon sau cung duoc tang/giam. So chu so thap phan (neu co) lay theo Text chon.
; P/S (01-03-2012): bo sung them so chu so 0 dau num de phu hop voi text mau. VD: "CN: 01" tang thanh "CN: 02"...
(defun C:CA (/ dsdt dt dt1 dt2 p1 p2 sl x kwrd strt strp num sym ds daup giaso)
 (vl-load-com)
 (command "undo" "be")
 (setq osm (getvar "osmode") cmd (getvar "cmdecho"))
 (princ "\nChon cac doi tuong can Copy-Array...")
 (setq dsdt (vl-remove-if 'listp (mapcar 'cadr (ssnamex (setq dt (ssget)))))
       	dt1 dt p1 (getpoint "\nDiem goc: ") p2 (getpoint p1 "\nDiem den: ") sl (getint "\nSo lan: ") x 1)
 (setvar "osmode" 0) (setvar "cmdecho" 0)
 (foreach n dsdt
  (if (or (= "TEXT" (cdr (assoc 0 (entget n)))) (= "MTEXT" (cdr (assoc 0 (entget n)))))
   (if (KT_NUM (cdr (assoc 1 (entget n))))
	(setq dt2 n))))
 (if dt2 (setq dt1 (ssdel dt2 dt)))
 (if dt2
  (progn
   (initget "Y N")
   (setq kwrd (getkword "\nBan muon Text tang dan ? [Y/<N>]  ") giaso (getreal "\nGia so: "))
   (setq x 1)
   (repeat (1- sl)
	(command ".copy" dt2 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
	(if (eq kwrd "Y")
 	(progn
  	(CHIA3 (cdr (assoc 1 (entget dt2))))
  	(setq daup (if (not (vl-string-search "." (cadr ds))) 0 (- (strlen (cadr ds)) (vl-string-search "." (cadr ds)) 1)))
  	(entmod (subst (cons 1 (strcat (car ds) (THEM0 (cadr ds) (rtos (+ (atof (cadr ds)) (* x giaso)) 2 daup)) (caddr ds))) (assoc 1 (entget (entlast))) (entget (entlast))))
  	(entupd (entlast))))
	(setq x (1+ x)))))
 (if dt1
  (progn
   (setq x 1)
   (repeat (1- sl)
	(command ".copy" dt1 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
	(setq x (1+ x)))))
 (command "undo" "e")
 (setvar "osmode" osm) (setvar "cmdecho" cmd)
 (princ))
;----- Chia text ra tiento_num_hauto.
(defun CHIA3 (str / trai phai lstt lstn)
 (setq lstt (vl-string->list str) lstn (reverse lstt))
 (while lstt
  (cond ((or (< (car lstt) 48) (> (car lstt) 57)) (setq trai (cons (car lstt) trai) lstt (cdr lstt)))
         	(T (setq lstt nil))))
 (while lstn
  (cond ((or (< (car lstn) 48) (> (car lstn) 57)) (setq phai (cons (car lstn) phai) lstn (cdr lstn)))
         	(T (setq lstn nil))))
 (setq ds (list (vl-list->string (reverse trai))
                    	(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-string-right-trim (vl-list->string phai) (vl-string-left-trim (vl-list->string trai) str)))
                    	(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-list->string phai)))))
;----- Kiem tra 1 text co chua num hay khong?
(defun KT_NUM(str / ds kt)
 (foreach n (vl-string->list str)
  (if (and (>= n 48) (<= n 57)) (setq kt T)))
 kt)
 ;----- Thong ke so chu so truoc dau thap phan.
(defun KT_FIX(str / m)
 (setq m 0)
 (while (and (> (strlen str) 0) (/= (substr str 1 1) "."))
  (setq m (1+ m) str (substr str 2)))
 m)
;----- Them so chu so 0 vao dau text cho phu hop.
(defun THEM0(strt strs)
 (while (> (- (KT_FIX strt) (KT_FIX strs)) 0)
  (setq strs (strcat "0" strs)))
 strs)
P/S: sửa 07/02/2012 để không còn dùng các hàm Acet.
P/S: sửa 01/03/2012 để thêm số chữ số 0 vào đầu Num của Text để phù hợp với Text gốc.

 

Xin lỗi vì đã up lại bài viết cũ. Cảm ơn bác rất nhiều ạ,em muốn không có hộp thoại"Bạn có muốn Text tăng dần" mà mặc định nó luôn là Yes thì thay lệnh ntn ạ,em mò hổi mà k ra vì e k biết gì về lập trình. Cảm ơn bác


  • -1