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

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

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

 

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!

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 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.

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 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!

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

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

  • Vote giảm 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

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  

×