lisp copy tăng số mà chứ giữa nguyên

; Doan Van Ha CADViet.com; Ngay: 15-3-2012. Modify 07-05-2012.
; Copy cac doi tuong, rieng Text (Mtext) 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.
; Chap nhan ca nhung so co chu so 0 dang truoc. VD: "CN: 01XD" tang thanh "CN: 02XD"...
; Trong Text chi duoc chua duy nhat 1 num. Dung duoc cho so nguyen va so thap phan.
(defun C:CY (/ dsdt dt dt1 dt2 p1 p2 x ds daup1 daup2 daup giaso)
(vl-load-com) (command "undo" "be") (setq cmd (getvar "cmdecho")) (setvar "cmdecho" 0)
(setq giaso (getreal "\nGia so tang/giam: "))
(princ "\nChon cac doi tuong can Copy tang/giam...")
(setq dsdt (vl-remove-if 'listp (mapcar 'cadr (ssnamex (setq dt (ssget)))))
dt1 dt p1 (getpoint "\nDiem goc: ") x 1)
(foreach n dsdt
(if (or (= "TEXT" (cdr (assoc 0 (entget n)))) (= "MTEXT" (cdr (assoc 0 (entget n)))))
(if (wcmatch (cdr (assoc 1 (entget n))) "*#*")
(setq dt2 n))))
(if (and dt2 (> (length dsdt) 1)) (setq dt1 (ssdel dt2 dt1)) (setq dt1 nil))
(while (setq p2 (getpoint p1 "\nDiem den: "))
(if dt2
(progn
(command ".copy" "non" dt2 "" p1 p2)
(CHIA3 (cdr (assoc 1 (entget dt2))))
(setq daup1 (if (not (vl-string-search "." (cadr ds))) 0 (- (strlen (cadr ds)) (vl-string-search "." (cadr ds)) 1)))
(setq daup2 (if (not (vl-string-search "." (vl-prin1-to-string giaso))) 0 (- (strlen (vl-prin1-to-string giaso)) (vl-string-search "." (vl-prin1-to-string giaso)) 1)))
(setq daup (max daup1 daup2))
(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
(command ".copy" "non" dt1 "" p1 p2)))
(command "undo" "e") (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)))))
;----- Them so chu so 0 vao dau text cho phu hop.
(defun THEM0(strt strs)
(while (> (- (if (setq m (vl-string-position (ascii ".") strt)) m 0) (if (setq m (vl-string-position (ascii ".") strs)) m 0)) 0)
(setq strs (strcat "0" strs)))
strs)

nguồn bài viết :
https://www.cadviet.com/forum/topic/43968-y%C3%AAu-c%E1%BA%A7u-lisp-copy-t%C4%83ng-s%E1%BB%91-m%C3%A0-ch%E1%BB%A9-gi%E1%BB%AFa-nguy%C3%AAn/