[Yêu cầu] lisp copy tăng số mà chứ giữa nguyên

[tuvanthietke.hcm 4]

Mình có ABC10

mình muốn copy thành ABC11, ABC12,...

 

Cảm ơn các bạn

[tpthainguyen 5]

Mình có ABC10

mình muốn copy thành ABC11, ABC12,...

 

Cảm ơn các bạn

bạn vào đây nhé

 

http://www.cadviet.com/forum/index.php?showtopic=34029

 

mình dùng lips này rồi, rất thich nhé

[ketxu 2.984]

Bạn đã thử tìm chưa ??

;01-10-2010***Copy Inte..******************************************
(defun ketthuc ()
(setvar "cmdecho" luuecho)
(setq *error* luu
luu nil
luuecho nil
);setq
(princ)
)
;*********************************************************************
(defun modau ()
(setq luu *error
luuecho (getvar "cmdecho")
*error (ketthuc)
)
)
;*********************************************************************
(defun xulytext (text / kytu ma sokt luusokt lui )
(setq kytu (substr text (strlen text))
ma (ascii kytu)
sokt (read kytu)
lui 1
)
(if (numberp sokt)
(progn
(setq luusokt (1+ sokt))
(if (and (numberp sokt)
(> (strlen text) 1)
)
(progn
(setq kytu (substr text (1- (strlen text)))
sokt (read kytu)
)
(if (numberp sokt)
(setq luusokt (1+ sokt)
lui 2

)
)
);progn
)
(if (= luusokt 100) (setq luusokt 0))
(setq kytu (rtos luusokt 2 0)

text (strcat (substr text 1 (- (strlen text) lui)) kytu)
)
);progn
(if (or (= kytu "z")
(= kytu "Z")
)
(setq text (strcat text "0")
textxl "0"
)
(setq ma (1+ ma)
text (strcat (substr text 1 (1- (strlen text))) (chr ma))
)
);if
);if
)
;*********************************************************************
(defun doitext(tendoituong / chuoi doituong thoat tam dsach kieu text vitri10 vitri11 dem canle)
;Neu doi tuong la text thi tiep tuc
(setq doituong (entget tendoituong)
kieu (cdr (assoc 0 doituong))
canle (cdr (assoc 72 doituong))
)
(if (or (= kieu "TEXT")
(= kieu "MTEXT")
)
(progn
(setq textxl (xulytext textxl)
text (cons 1 textxl)
vitri10 (cdr (assoc 10 doituong))
vitri10 (list (+ (car vitri10) (car vitrilech)) (+ (nth 1 vitri10) (nth 1 vitrilech)))
vitri10 (cons 10 vitri10)
vitri11 (cdr (assoc 11 doituong))
vitri11 (list (+ (car vitri11) (car vitrilech)) (+ (nth 1 vitri11) (nth 1 vitrilech)))
vitri11 (cons 11 vitri11)
dem 0
dsach nil
)
(foreach tam doituong
(cond
((= (car tam) 1) (setq dsach (append dsach (list text))))
((= (car tam) 10) (setq dsach (append dsach (list vitri10))))
((= (car tam) 11) (setq dsach (append dsach (list vitri11))))
((setq dsach (append dsach (list tam))))
)
)
(entmake dsach)
);progn
);if
);
;*********************************************************************
;sao doi tuong cu sang vi tri moi

(defun copy_dt (tendoituong )
(command "copy" tendoituong "" goc toi )
);defun

;*********************************************************************
(defun c:co ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(princ "\nCopy thong minh...\n")
(setq luuecho (getvar "cmdecho")
luu *error*
*error* ketthuc
cumdt (ssget)
dodai (sslength cumdt)
goc (getpoint "\nDiem goc copy:")
thoat nil
dem 0
textxl nil
);
(setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
(while (and (= thoat nil)
(< dem dodai)
)
(setq ten (ssname cumdt dem)
dem (1+ dem)
doituong (entget ten)
kieu (cdr (assoc 0 doituong))
)

(if (or (= kieu "TEXT")
(= kieu "MTEXT")
)
(setq thoat T
textxl (cdr (assoc 1 doituong))
)
)
);
(while T
(setq toi (getpoint "\nDiem dat doi tuong: " goc)
vitrilech (list (- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
dem 0
)
(while (< dem dodai)
(setq ten (ssname cumdt dem)
dem (1+ dem)
doituong (entget ten)
kieu (cdr (assoc 0 doituong))
)

(if (or (= kieu "TEXT")
(= kieu "MTEXT")
)
(doitext ten)
(copy_dt ten)

);if
)
);while
(ketthuc)
);defun
(princ)
;Note: bien toan cuc: textxl vitrilech

[tuvanthietke.hcm 4]

Bạn đã thử tìm chưa ??

;01-10-2010***Copy Inte..******************************************
(defun ketthuc ()
(setvar "cmdecho" luuecho)
(setq *error* luu
luu nil
luuecho nil
);setq
(princ)
)
;*********************************************************************
(defun modau ()
(setq luu *error
luuecho (getvar "cmdecho")
*error (ketthuc)
)
)
;*********************************************************************
(defun xulytext (text / kytu ma sokt luusokt lui )
(setq kytu (substr text (strlen text))
ma (ascii kytu)
sokt (read kytu)
lui 1
)
(if (numberp sokt)
(progn
(setq luusokt (1+ sokt))
(if (and (numberp sokt)
(> (strlen text) 1)
)
(progn
(setq kytu (substr text (1- (strlen text)))
sokt (read kytu)
)
(if (numberp sokt)
(setq luusokt (1+ sokt)
lui 2

)
)
);progn
)
(if (= luusokt 100) (setq luusokt 0))
(setq kytu (rtos luusokt 2 0)

text (strcat (substr text 1 (- (strlen text) lui)) kytu)
)
);progn
(if (or (= kytu "z")
(= kytu "Z")
)
(setq text (strcat text "0")
textxl "0"
)
(setq ma (1+ ma)
text (strcat (substr text 1 (1- (strlen text))) (chr ma))
)
);if
);if
)
;*********************************************************************
(defun doitext(tendoituong / chuoi doituong thoat tam dsach kieu text vitri10 vitri11 dem canle)
;Neu doi tuong la text thi tiep tuc
(setq doituong (entget tendoituong)
kieu (cdr (assoc 0 doituong))
canle (cdr (assoc 72 doituong))
)
(if (or (= kieu "TEXT")
(= kieu "MTEXT")
)
(progn
(setq textxl (xulytext textxl)
text (cons 1 textxl)
vitri10 (cdr (assoc 10 doituong))
vitri10 (list (+ (car vitri10) (car vitrilech)) (+ (nth 1 vitri10) (nth 1 vitrilech)))
vitri10 (cons 10 vitri10)
vitri11 (cdr (assoc 11 doituong))
vitri11 (list (+ (car vitri11) (car vitrilech)) (+ (nth 1 vitri11) (nth 1 vitrilech)))
vitri11 (cons 11 vitri11)
dem 0
dsach nil
)
(foreach tam doituong
(cond
((= (car tam) 1) (setq dsach (append dsach (list text))))
((= (car tam) 10) (setq dsach (append dsach (list vitri10))))
((= (car tam) 11) (setq dsach (append dsach (list vitri11))))
((setq dsach (append dsach (list tam))))
)
)
(entmake dsach)
);progn
);if
);
;*********************************************************************
;sao doi tuong cu sang vi tri moi

(defun copy_dt (tendoituong )
(command "copy" tendoituong "" goc toi )
);defun

;*********************************************************************
(defun c:co ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(princ "\nCopy thong minh...\n")
(setq luuecho (getvar "cmdecho")
luu *error*
*error* ketthuc
cumdt (ssget)
dodai (sslength cumdt)
goc (getpoint "\nDiem goc copy:")
thoat nil
dem 0
textxl nil
);
(setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
(while (and (= thoat nil)
(< dem dodai)
)
(setq ten (ssname cumdt dem)
dem (1+ dem)
doituong (entget ten)
kieu (cdr (assoc 0 doituong))
)

(if (or (= kieu "TEXT")
(= kieu "MTEXT")
)
(setq thoat T
textxl (cdr (assoc 1 doituong))
)
)
);
(while T
(setq toi (getpoint "\nDiem dat doi tuong: " goc)
vitrilech (list (- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
dem 0
)
(while (< dem dodai)
(setq ten (ssname cumdt dem)
dem (1+ dem)
doituong (entget ten)
kieu (cdr (assoc 0 doituong))
)

(if (or (= kieu "TEXT")
(= kieu "MTEXT")
)
(doitext ten)
(copy_dt ten)

);if
)
);while
(ketthuc)
);defun
(princ)
;Note: bien toan cuc: textxl vitrilech

 

 

Bạn ơi nó chỉ cho copy đến 100 thôi còn lại là trở về 0 à, sao cho nó copy được đến 999

[banbe0274 0]

Nhờ các bác sửa giùm lisp trên khi copy tăng số mã chữ giữ nguyên

khi số đứng trước mà chữ đứng sau .1a...2a.....3a.

[Doan Van Ha 3.186]

Nhờ các bác sửa giùm lisp trên khi copy tăng số mã chữ giữ nguyên

khi số đứng trước mà chữ đứng sau .1a...2a.....3a.

Bạn đọc link này (trang #26), có lisp của tôi copy tăng dần khi số có tiền và/hoặc hậu tố.

http://www.cadviet.com/forum/index.php?showtopic=54624&st=20

[hugo007 1]

Bạn đọc link này (trang #26), có lisp của tôi copy tăng dần khi số có tiền và/hoặc hậu tố.

http://www.cadviet.c...pic=54624&st=20

Lisp này ghi gõ lệnh CA chỉ dùng array không thấy có chức năng tăng dần bác ah.Bác chỉ giúp.Thanks.

[banbe0274 0]

lisp ca của Bác copy tăng theo aray. Em muốn nhờ Bác chỉnh sửa lisp copy

tăng dần theo tiền tố và hậu tố bằng cách Pick từng điểm 1 giống như lisp co.

 

[Doan Van Ha 3.186]

lisp ca của Bác copy tăng theo aray. Em muốn nhờ Bác chỉnh sửa lisp copy

tăng dần theo tiền tố và hậu tố bằng cách Pick từng điểm 1 giống như lisp co.

Đây bạ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)

P/S: modify: 07-05-2012

[Tue_NV 3.912]

Đây bạn!

; Doan Van Ha CADViet.com; Ngay: 15-3-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"...
(defun C:CY (/ 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"))
(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 (KT_NUM (cdr (assoc 1 (entget n))))
(setq dt2 n))))
(if dt2 (setq dt1 (ssdel dt2 dt) dt3 dt1))
(while (setq p2 (getpoint p1 "\nDiem den: "))
 (setvar "osmode" 0) (setvar "cmdecho" 0)
 (if dt2
  (progn
(command ".copy" dt2 "" p1 p2)
(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
  (command ".copy" dt1 "" p1 p2)))
(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)

Nếu tiền tố hoặc hậu tố có chứa số thì Lisp chạy không còn đúng nữa?

 

Hàm KT_NUM ; ;----- Kiem tra 1 text co chua num hay khong?

có thể viết gọn lại :

(defun KT_NUM(str) (wcmatch str "*#*"))

 

Hàm KT_FIX ;----- Thong ke so chu so truoc dau thap phan.

có thể viết gọn lại :

(defun KT_FIX(str) (vl-string-position (ascii ".") str))

[Doan Van Ha 3.186]

Nếu tiền tố hoặc hậu tố có chứa số thì Lisp chạy không còn đúng nữa?

 

Hàm KT_NUM ; ;----- Kiem tra 1 text co chua num hay khong?

có thể viết gọn lại :

(defun KT_NUM(str) (wcmatch str "*#*"))

 

Hàm KT_FIX ;----- Thong ke so chu so truoc dau thap phan.

có thể viết gọn lại :

(defun KT_FIX(str) (vl-string-position (ascii ".") str))

Thanks 2 cái defun!

Nếu tiền/hậu tố chứa số thì về nguyên tắc vẫn làm được, nhưng rắc rối thêm 1 chút nữa là phải nhập tiền/hậu tố vào, còn nếu không nhập thì trong text đó có tới 2 hoặc 3 số hoặc nhiều hơn nữa, lisp chỉ lấy một số, nhưng biết số nào đây? Thành ra, list này chỉ giới hạn 1 số thôi là vậy.

[Tue_NV 3.912]

Thanks 2 cái defun!

Nếu tiền/hậu tố chứa số thì về nguyên tắc vẫn làm được, nhưng rắc rối thêm 1 chút nữa là phải nhập tiền/hậu tố vào, còn nếu không nhập thì trong text đó có tới 2 hoặc 3 số hoặc nhiều hơn nữa, lisp chỉ lấy một số, nhưng biết số nào đây? Thành ra, list này chỉ giới hạn 1 số thôi là vậy.

Đâu có cần phải nhập vào nữa đâu bạn?

Trim-chữ 2 đầu rồi -> Kiểm tra cái chữ giữa còn chứa chữ không thì trim tiếp (có thể chứa chữ lẫn số) -> Trim 2 đầu cho đến khi nào cái chữ giữa không còn chứa chữ nữa thì đó chính là Số cần tìm

He he. đó là ý tưởng hoàn toàn có thể thực hiện được nhưng hơi khó viết ^_^

 

Ý của mình là nên mở rộng thêm tiền tố hoặc hậu tố có chứa 1 dãy số duy nhât.

Ví dụ : CTNT1: 01 -> Số 01 là số cần lấy

CTNT2: 02-XD2J -> Số 02 là số cần lấy

[Doan Van Ha 3.186]

Đâu có cần phải nhập vào nữa đâu bạn?

Trim-chữ 2 đầu rồi -> Kiểm tra cái chữ giữa còn chứa chữ không thì trim tiếp (có thể chứa chữ lẫn số) -> Trim 2 đầu cho đến khi nào cái chữ giữa không còn chứa chữ nữa thì đó chính là Số cần tìm

He he. đó là ý tưởng hoàn toàn có thể thực hiện được nhưng hơi khó viết ^_^

 

Ý của mình là nên mở rộng thêm tiền tố hoặc hậu tố có chứa 1 dãy số duy nhât.

Ví dụ : CTNT1: 01 -> Số 01 là số cần lấy

CTNT2: 02-XD2J -> Số 02 là số cần lấy

Tôi vẫn hơi thắc mắc chỗ này (nếu như không nhập tiền/hâu tố): CTNT2: 02-XD2J

Một người xem "02" là số, "CTNT2: " là tiền tố, "-XD2J" là hậu tố.

Một người xem "2" là số, "CTNT" là tiền tố, " 02-XD2J" là hậu tố.

Một người xem "2" là số, "CTNT2: 02-XD" là tiền tố, "J" là hậu tố.

Vậy thì sao nhỉ?

[Tue_NV 3.912]

Tôi vẫn hơi thắc mắc chỗ này (nếu như không nhập tiền/hâu tố): CTNT2: 02-XD2J

Một người xem "02" là số, "CTNT2: " là tiền tố, "-XD2J" là hậu tố.

Một người xem "2" là số, "CTNT" là tiền tố, " 02-XD2J" là hậu tố.

Một người xem "2" là số, "CTNT2: 02-XD" là tiền tố, "J" là hậu tố.

Vậy thì sao nhỉ?

Tr­ường hợp mà mình đặt ra là 1 trong trường hợp đó thôi, (để đỡ khỏi phải nhập tiền/ tố hậu tố)

Còn Tổng quát thì có lẽ phải nhập thêm tiền tố/ hậu tố

Thanks

[banbe0274 0]

Theo em Tiền tố hay Hậu tố lên phân biệt nhau bằng ký tự (“-“ hoặc “.” hặc “/” hoặc “:” thì hay hơn VD 2CNTT.2 hoặc 2CNTT-02 ; 2CNTT/2 ; 2CNTT/2

[TháiThanhPhong 0]

Mình thấy lisp này chưa hay lắm...mình có qua công ty khác có lần thấy..người ta dùng lệnh

và di chuyển text từ vi trí này đến vị trí kia là tăng lên ngây...ví dụ A1>>>A2>>>A3....

còn : CA>>>>CB>>>>>CC...

không biết có anh em nào có lisp như vậy không nữa...cho phong xin...tks

[HOAILINHLINH 23]

Vào lúc 15/3/2012 tại 09:45, Doan Van Ha đã nói:

Đây bạn!

 

• cy.lsp
  
• [✎]
   

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

 

 

P/S: modify: 07-05-2012

lisp nay điểm đầu tiên thì có chế độ bắt điểm từ điểm thứ hai thì chế độ bắt điểm bị tắt bác có thể thêm vào cho chế độ bắt điểm luôn bậc được không

[sonmk2019 2]

Lisp của bạn đoàn văn hà chỉ tăng được text cuối cùng được chọn , bạn nào có lisp copy tăng hoặc giảm nhiều text với 1 số bất kỳ cho mình xin nhé.

 

[sonmk2019 2]

bạn đoàn văn hà cho xin lisp đi nó gần giống lisp cy.lsp của bạn đấy nhưng là nhiều text