Đế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

#21 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 21 September 2011 - 11:14 PM

Ket viết nhiều chắc biết kiểu viết lsp theo y/c như đề này là rất nhạy cảm! Có cái thì không tiền/hậu tố, có cái thì có tiền/hậu tố, lại có cái có cả tiền và hậu tố. Có cái là int, lại có cái là real (khổ nhất nó). Chao ôi nó đa đoan! Hì! Riêng 2 câu hỏi của Ket xin trả lời như sau:
1). Khi có nhiều txt thì biết chọn cái nào để tăng, còn nếu tăng tất cả là không thực tế lắm, thành ra chỉ chọn 1 txt thôi. Còn chặt chẽ hơn (tất nhiên sử dụng sẽ phức tạp hơn!) thì sau khi chọn dt cần phải thêm 1 bước chọn txt để tăng nữa (nhằm cho các txt khác đứng yên).
2). Chỉ viết ngang cỡ "ab5.3cdf" thôi, chứ "a4b5" thì biết chọn tăng số 4 hay số 5 đây? Hay phải thêm 1 vài bước nữa, chà!
Thân thương!

- Chọn 1 Text thì e k nói, nhưng lại xóa các đối tượng Text khác thì quả là không hay. Có thể bác chỉ cần chỉ định 1 thằng Text trong đống đó để thao tác ^^
- Nếu format được giới hạn trong [Tiền tố] số [Hậu tố] thì ok rồi. Nhưng bác cũng phải chú ý nếu gặp phải text không hề có số nhé, lúc đó hàm chia của bác lỗi luôn ^^
À, code của bác đúng là dài thật, lại ưa xài Express quá ^^ Em thì nghĩ chỉ cần thế này thôi

(defun txt2num (str / num pos)
(setq pos (vl-string-search (setq num (vl-list->string (vl-remove-if-not '(lambda (x) (or (< 44 x 47)(< 47 x 58)))(vl-string->list str))))str))
(list
(substr str 1 pos)
(if (vl-string-search "." num)(atof num)(atoi num))
(substr str (+ 1 pos (strlen num)))
))
=> trả về list (Tiền tố - số - Hậu tố)
Ví dụ :

(txt2num "abcde12.3fghijk") => ("abcde" 12.3 "fghijk")


(txt2num "abcde123fghijk") => ("abcde" 123 "fghijk")
(txt2num "abcdef") => ("" 0 "abcdef")


Chúc bác ngày càng mạnh khỏe và có nhiều lisp hay.

P/s : nhân tiện hàm vừa viết, e update luôn cái Dynamic Array ^^
  • 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


#22 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 22 September 2011 - 07:48 AM

Sáng dậy làm thêm phát nữa ^^ : (đầu cuối số)

(defun tach (str / i j dau cuoi tmp tmp1 tmp2)
(setq lst (vl-string->list str) i -1 j (strlen str))
(list
(setq tmp1 (vl-list->string (reverse (while (not (or (<= 48 (setq tmp (nth (setq i (1+ i)) lst)) 57) (>= i j))) (setq dau (cons tmp dau))))))
(setq tmp2(vl-list->string (while (not (or (<= 48 (setq tmp (nth (setq j (1- j)) lst)) 57) (<= j i))) (setq cuoi (cons tmp cuoi)))))
(if (vl-string-search "." (setq num (vl-string-left-trim tmp1 (vl-string-right-trim tmp2 str)))) (atof num) (atoi num))
)
)
Hì hì ^^
  • 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


#23 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 22 September 2011 - 11:38 AM

Sáng dậy làm thêm phát nữa ^^ : (đầu cuối số)
(defun tach()...
Hì hì ^^

Chỉ mỗi hàm chia Text có/không tiền/hậu tố ra thành 3 phần: tiền tố, số, hậu tố mà đã lắm vấn đề! Cả 3 hàm: chia, txt2num, tach đều có vấn đề, trích dẫn:
(chia "a.bcd.gh") => ; error: bad argument type: stringp nil => NO!
(txt2num "a.b012.3400cd.gh") => ; error: bad argument type: numberp: nil => NO!
(tach "a.b012.3400cd.gh") => ("a.b" "cd.gh" 12.34) => NO! (vì bỏ số 0 đằng trước số và bỏ 2 số 0 đằng sau của số)
Hy vọng hàm dưới đây không có sự cố. Trên cơ sở đó sẽ h/c và bổ sung thêm 1 số vấn đề cho lệnh copy-Array ở trên. Ket test giùm nhé!
Trích dẫn:
(ha "a.b012.3400cd.gh") => ("a.b" "012.3400" "cd.gh")
(ha "012.3400cd.gh") => ("" "012.3400" "cd.gh")
(ha "a.b012.3400") => ("a.b" "012.3400" "")
(ha "a.bcd.gh") => ("a.bcd.gh" "" "")

(defun HA (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))))
(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))))

  • 1

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


#24 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 22 September 2011 - 06:04 PM

Tks bác ĐVH. E rất khâm phục tính quyết làm tới cùng của bác..^^ Tuy nhiên em thấy code HA vẫn... dài quá
Cả 2 hàm e viết đều dựa trên ý tách ab5.3cdf của bác và ngắn hơn, chứ không phải là xử lý tất cả tình huống.
Hàm txt2num e viết với ý đồ cụm số phải liền nhau, k ngờ tới có cụm số thâm như thế, nên pos trả về giá trị Nil ^^
Hàm tach, trong ví dụ của bác, theo em thế là đạt yêu cầu (tất nhiên với nhiều trường hợp bác chưa nêu thì còn ốm nữa ^^)
Ở đây 12.34 chính là kết quả của (atof "012.3400"), chứ bác để "012.3400" thì là định dạng số gì ạ ? cộng trừ nó thế nào ? Chẳng qua là em đã gộp bước chuyển sang số vào trong kết quả thôi ^^. Nếu không tin, bác có thể thử bỏ những dòng atof, atoi đi thì kết quả sẽ ra y hệt hàm của bác ^^ (định dạng đầu - cuối - string thể hiện số)

(defun tach (str / i j dau cuoi tmp tmp1 tmp2)
(setq lst (vl-string->list str) i -1 j (strlen str))
(list
(setq tmp1 (vl-list->string (reverse (while (not (or (<= 48 (setq tmp (nth (setq i (1+ i)) lst)) 57) (>= i j))) (setq dau (cons tmp dau))))))
(setq tmp2(vl-list->string (while (not (or (<= 48 (setq tmp (nth (setq j (1- j)) lst)) 57) (<= j i))) (setq cuoi (cons tmp cuoi)))))
(setq num (vl-string-left-trim tmp1 (vl-string-right-trim tmp2 str))))
)

Command: (tach "a.b012.3400cd.gh")
("a.b" "cd.gh" "012.3400")

Command: (tach "012.3400cd.gh")
("" "cd.gh" "012.3400")

Command: (tach "a.b012.3400")
("a.b" "" "012.3400")

Command: (tach "a.bcd.gh")
("a.bcd.gh" "" "")


  • 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


#25 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 22 September 2011 - 09:27 PM

Tks bác ĐVH. E rất khâm phục tính quyết làm tới cùng của bác..^^ Tuy nhiên em thấy code HA vẫn... dài quá
Cả 2 hàm e viết đều dựa trên ý tách ab5.3cdf của bác và ngắn hơn, chứ không phải là xử lý tất cả tình huống.
Hàm txt2num e viết với ý đồ cụm số phải liền nhau, k ngờ tới có cụm số thâm như thế, nên pos trả về giá trị Nil ^^
Hàm tach, trong ví dụ của bác, theo em thế là đạt yêu cầu (tất nhiên với nhiều trường hợp bác chưa nêu thì còn ốm nữa ^^)
Ở đây 12.34 chính là kết quả của (atof "012.3400"), chứ bác để "012.3400" thì là định dạng số gì ạ ? cộng trừ nó thế nào ? Chẳng qua là em đã gộp bước chuyển sang số vào trong kết quả thôi ^^. Nếu không tin, bác có thể thử bỏ những dòng atof, atoi đi thì kết quả sẽ ra y hệt hàm của bác ^^ (định dạng đầu - cuối - string thể hiện số)

1). Tôi cũng rất khâm phục tính theo tới cùng của Ket. Tất nhiên nhờ vậy mà tôi và Ket đều biết lỗi của mình là ở chỗ nào.
2). Cả 3 hàm Chia, Tach, Txt2num đều có những lỗi nào đó, thôi không bàn nữa, vì Ket và tôi đã vá được rồi.
3). Hàm "HA" dài quá: tôi thấy nó cũng không dài lắm so với hàm "TACH", nhưng dẫu có dài thì cũng không đến nỗi gì, vì chúng ta đã đạt mục đích chung.
4). Ket nói "012.3400" là định dạng số gì ạ, thì câu này hơi lạ. Ai cũng biết 012.3400 chính là 12.34, nhưng 2 cách viết thể hiện 2 ý đồ khác nhau: cách viết đầu ý muốn số trước thập phân phải thể hiện bằng 3 chữ số, còn số sau thập phân là 4 chữ số. Tại sao biển số xe mới đây người ta ghi 001.20 mà không ghi 1.2 cho gọn. Còn cộng trừ nhân chia... thì nó vẫn vô tư.
Thân thương!
  • 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.


#26 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 22 September 2011 - 10:10 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.
  • 1

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


#27 tiendung89

tiendung89

    biết lệnh move

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

Đã gửi 07 February 2012 - 09:19 PM

các bác giúp e sao mà em dùng lisp trên thì khi đánh lệnh CA nó lại báo lỗi như sau


Command: ca
undo Enter the number of operations to undo or
[Auto/Control/BEgin/End/Mark/Back] <1>: be
Command: ; error: bad argument type: FILE nil
  • 0
Tôi không phải là đặc biệt, nhưng tôi là duy nhất ^^

#28 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 07 February 2012 - 10:00 PM

các bác giúp e sao mà em dùng lisp trên thì khi đánh lệnh CA nó lại báo lỗi như sau
Command: ca
undo Enter the number of operations to undo or
[Auto/Control/BEgin/End/Mark/Back] <1>: be
Command: ; error: bad argument type: FILE nil

Nếu lỗi ở giữa chương trình thì còn tin được, chứ sao lại lỗi lúc vừa gọi lệnh được nhỉ? Bạn up bản vẽ lên xem sao hè!
  • 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.


#29 tiendung89

tiendung89

    biết lệnh move

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

Đã gửi 07 February 2012 - 10:28 PM

em up bản vẽ lên đây bác xem qua cho em với ạ(ở đây em dùng lisp mà bác mới up đấy ạ- dùng lệnh HA để vẽ)
http://www.cadviet.c..._dia_hinh_1.dwg
  • 0
Tôi không phải là đặc biệt, nhưng tôi là duy nhất ^^

#30 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 07 February 2012 - 11:10 PM

em up bản vẽ lên đây bác xem qua cho em với ạ(ở đây em dùng lisp mà bác mới up đấy ạ- dùng lệnh HA để vẽ)
http://www.cadviet.c..._dia_hinh_1.dwg

Lúc đầu bạn nói dùng lệnh CA, giờ bạn nói dùng lệnh HA (trong topic này không có lệnh HA)?!? Lúc đầu bạn nói lỗi khác, bây giờ bạn gởi bản vẽ thì lỗi khác. Căn cứ trên bản vẽ của bạn thì lỗi là do bạn chưa cài Tool Exprees nên các hàm Acet không hiểu. Tôi đã sửa lại cho bạn ở trên (mục #27, lệnh CA).
  • 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.


#31 tiendung89

tiendung89

    biết lệnh move

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

Đã gửi 07 February 2012 - 11:28 PM

đã đc rồi bác hà ạ
thanks bác
nhân tiện bác cho e hỏi muốn cài Tool Exprees thì làm thế nào ạ? em đang chạy HS nên phải dùng Cad2005
  • 0
Tôi không phải là đặc biệt, nhưng tôi là duy nhất ^^

#32 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 07 February 2012 - 11:45 PM

đã đc rồi bác hà ạ
thanks bác
nhân tiện bác cho e hỏi muốn cài Tool Exprees thì làm thế nào ạ? em đang chạy HS nên phải dùng Cad2005

Bạn đọc ở đây xem:
http://www.cadviet.c...?showtopic=9949
  • 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.


#33 ngotheanh

ngotheanh

    biết vẽ circle

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

Đã gửi 29 February 2012 - 03:04 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.
(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) (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)
P/S: sửa 07/02/2012 để không còn dùng các hàm Acet.


Mình thấy Lisp của bác rất hay, nhưng còn hạn chế ở một chỗ là khi coppy tăng dần text chẳng hạn như CN: 01, khi tăng dần lên 1 đơn vị thì các text sau chỉ còn là CN: 2 CN: 3..... thôi. Mong bác sửa lại sao cho các text sau coppy vẫn là CN: 02, CN: 03 ......
  • 0

#34 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 01 March 2012 - 11:16 AM

Mình thấy Lisp của bác rất hay, nhưng còn hạn chế ở một chỗ là khi coppy tăng dần text chẳng hạn như CN: 01, khi tăng dần lên 1 đơn vị thì các text sau chỉ còn là CN: 2 CN: 3..... thôi. Mong bác sửa lại sao cho các text sau coppy vẫn là CN: 02, CN: 03 ......

Đã sửa cho bạn và mọi người khác cần. Link vẫn như cũ.
  • 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.


#35 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 07 July 2012 - 08:55 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.

Em chào bác DoanVanHa.
Em down đoạn lisp của bác về sử dụng nhưng lại có một vấn đề là text tăng dần không đúng theo mong muốn của em. Em Post bản vẽ lên mong bác chỉnh sửa lại một chút giúp em cho phù hợp với ạ. Khi sửa bác có thể để mặc định là sẽ copy tăng dần giúp em (không cần hỏi "bạn có muốn copy text tăng dần? nữa). Chi tiết cụ thể em có trình bày trong bản vẽ đính kèm. Mong bác giúp đỡ, Chúc bác cũng như toàn thể anh em Cadviet khỏe mạnh!
http://www.cadviet.c...072_reinf_1.dwg
  • 0

#36 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 07 July 2012 - 11:40 AM

Em chào bác DoanVanHa.
Em down đoạn lisp của bác về sử dụng nhưng lại có một vấn đề là text tăng dần không đúng theo mong muốn của em. Em Post bản vẽ lên mong bác chỉnh sửa lại một chút giúp em cho phù hợp với ạ. Khi sửa bác có thể để mặc định là sẽ copy tăng dần giúp em (không cần hỏi "bạn có muốn copy text tăng dần? nữa). Chi tiết cụ thể em có trình bày trong bản vẽ đính kèm. Mong bác giúp đỡ, Chúc bác cũng như toàn thể anh em Cadviet khỏe mạnh!
http://www.cadviet.c...072_reinf_1.dwg

Hề hề hề,
Mạn phép bác DoanVanHa trả lời bạn nhé.
Lisp bác ha viết không xét trường hợp trong tiền tố và hậu tố lại có lẫn text số như của bạn. Việc mình sửa sau đây cũng chỉ áp dụng được cho trường hợp tiền tố của bạn không chứa hai chữ số liền nhau. Việc giải quyết toàn bộ các trường hợp có thể là một điều không dễ vì người dùng có rất nhiều dạng đặt tiền tố và hậu tố khác nhau. Bởi vậy hãy lưu ý tới việc mình sửa này để bạn có thể tự làm khi thay đổi tiền tố và hậu tố cho phù hợp.
1/- Bạn hãy mở lisp ra tìm tới dòng code sau trong hàm con (chia3 .....)
((or (< (car lstt) 48) (> (car lstt) 57)) (setq trai (cons (car lstt) trai) lstt (cdr lstt)))
Thay nó bằng dòng code :
((or (or (< (car lstt) 48) (> (car lstt) 57)) (or (< (cadr lstt) 48) (> (cadr lstt) 57))) (setq trai (cons (car lstt) trai) lstt (cdr lstt)))
2/- Trong hàm chính bạn tìm tới dòng code:
(setq kwrd (getkword "\nBan muon Text tang dan ? [Y/<N>] ") giaso (getreal "\nGia so: "))
Thay bằng:
(setq giaso (getreal "\nGia so: "))
Đồng thời xóa bỏ dòng code :
(if (eq kwrd "Y")
và một dấu ngoặc đóng ) tại dòng code:
(setq x (1+ x)))))
để thành
(setq x (1+ x))))
Sau đó lưu lại lisp và test thử xem đã dúng ý chưa nhé.
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.

#37 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 07 July 2012 - 02:34 PM

Chào bác phamthanhbinh.
Em thay đoạn code theo gợi ý của bác thì gặp phải trường hợp sau:
số gia đã tăng, nhưng mình nhập số lần vào thì sau khi kết thúc lệnh tất cả các text sau đều nằm trùng nhau Bác xem em thay bị lỗi ở đoạn nào giúp em với ạ. Cảm ơn bác nhiều>


Hề hề hề,
Sorry, xin lỗi bạn vì mình nhầm chút xíu khi đọc lisp của bác Ha.
Bạn hãy sửa lại, thay vì xóa dấu ngoặc đóng ở dòng
(setq x (1+ x)))))
bạn hãy xóa ngoặc đóng ở dòng code
(entupd (entlast))))
Bạn hãy sửa lại nhé, một lần nữa xin lỗi vì sự cẩu thả, không kiểm tra lại trước khi post bài.
Mong rằng lần sửa này sẽ đáp ứng đúng yêu cầu của bạn.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#38 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 09 July 2012 - 10:01 AM

Các anh ơi giúp em với ạ! Em đã thử lại nhiều lần rồi mà vẫn chưa được.

Hề hề hề,
Bạn đã sửa như mình nói chưa???
nều vậy mà chưa được thì đành chờ bác đoàn van Ha vậy vì mình hết võ rồi.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#39 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 - 10:26 AM

Hề hề hề,
Bạn đã sửa như mình nói chưa???
nều vậy mà chưa được thì đành chờ bác đoàn van Ha vậy vì mình hết võ rồi.

Chào bác phamthanhbinh.
Em sửa theo cách anh nói thì gặp phải trường hợp là các text sau cứ nằm trùng vị trí của nhau,và số gia chỉ tăng đúng một lần thôi ạ. Ví dụ mình CA một text là A0-0010, khoảng cách là 420, số gia là 10, số lần array là 5 thì 4 text sau chỉ là A0-0020 và nằm trùng nhau hết ở vị trí cách text đầu 420. Em nhờ các bác xem đoạn code em thay nó bị lỗi ở chỗ nào ạ.(Đoạn code em thay ở phía trên ạ)
Em xin cảm ơn nhiều ạ
  • 0

#40 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 09 July 2012 - 02:17 PM

Chào bác phamthanhbinh.
Em sửa theo cách anh nói thì gặp phải trường hợp là các text sau cứ nằm trùng vị trí của nhau,và số gia chỉ tăng đúng một lần thôi ạ. Ví dụ mình CA một text là A0-0010, khoảng cách là 420, số gia là 10, số lần array là 5 thì 4 text sau chỉ là A0-0020 và nằm trùng nhau hết ở vị trí cách text đầu 420. Em nhờ các bác xem đoạn code em thay nó bị lỗi ở chỗ nào ạ.(Đoạn code em thay ở phía trên ạ)
Em xin cảm ơn nhiều ạ

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.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.