Viết Lisp theo yêu cầu

[Nguyen Hoanh 4669]

Jin vẽ mặt bằng kết cấu, các tầng giống nhau nên copy lên rồi sửa text theo tầng rất mệt. Jin muốn có một lisp để edit một text với yêu cầu:

- Chọn text

- Nhập số tầng

 

Chẳng hạn: có sẵn một text là D2-16 (22x50)

Thì số 2 ở đây là tầng 2, bây giờ Jin muốn một lisp cho phép chọn text trên, nhập tên tầng là 3, thì text mới sẽ thành: D3-16(22x50), nhập tầng là 13 thì text sẽ thành: D13-16(22x50)

 

Lệnh RTF của chương trình dưới đây sẽ làm được điều Jin muốn.

Chương trình sẽ yêu cầu nhập vào:

- từ đứng trước: là cụm từ nhận dạng đứng đằng trước từ cần thay. trong ví dụ của Jin, từ này có thể là 'D'.

- từ đứng sau: là cụm từ nhận dạng đứng đằng sau từ cần thay. trong ví dụ của Jin, từ này có thể là '-16(220x50)' hoặc '-16' đều được.

- từ mới muốn thay: là từ muốn thay vào giữa hai cụm từ nhận dạng trên. Trong ví dụ của jin, từ này là '13'.

- các text cần thay: chọn các text cần thay.

 

Các giá trị này được lưu lại, nếu các lần dùng lệnh sau mà không muốn thay đổi giá trị, chỉ việc nhấn enter lúc chương trình hỏi.

 

Cách hoạt động của chương trình theo ví dụ của Jin: tìm tất cả các từ có cấu trúc D*-16 và thay bằng D13-16.

 

(defun c:RTF ()
 (defun sudung	(ham ss / sodt index entdt soapp)
   (setq sodt	(cond
	  (ss (sslength ss))
	  (t 0)
	)
  soapp	0
  index	0
   )
   (repeat sodt
     (setq entdt (ssname ss index)
    index (1+ index)
     )
     (if (ham entdt)
(setq soapp (1+ soapp))
     )
   )
   soapp
 )

 (defun pos (sub st / l1 l2 index)
   (setq index	1
  l1	(strlen sub)
  l2	(strlen st)
   )
   (while
     (and (       (setq index (1+ index))
   )
   (if	(= sub (substr st index l1))
     index
     nil
   )
 )

 (defun transtext (str / kq)
   (setq kq "")
   (while (wcmatch str (strcat "*" CV_TUTRUOC "*" CV_TUSAU "*"))
     (setq vt1	  (pos CV_TUTRUOC str)	    
    vt2	  (+ vt1 (strlen CV_TUTRUOC) (pos CV_TUSAU (substr str (+ vt1 (strlen CV_TUTRUOC)))) (strlen CV_TUSAU)  -1)
    truoc (substr str 1 (1- vt1))	    
    str (substr str vt2)	    
    kq	(strcat kq truoc CV_TUTRUOC CV_TUGIUA CV_TUSAU)	   
     )
   )
   (setq kq (strcat kq str))
 )
 (defun thaytext (ent / tt)
   (setq tt  (entget ent)
  old (assoc 1 tt)
  new (cons 1 (transtext (cdr old)))
  tt  (subst new old tt)
   )
   (entmod tt)
   (entupd ent)
 )

 (defun Nhapstr (TU promt / tmp)
   (while (or (not tmp)
       (= tmp "")
   )
     (setq tmp	(getstring (strcat promt
			   " 				   (cond
			     (TU TU)
			     (t "")
			   )
			   ">: "
		   )
	)
     )
     (if (= tmp "")
(setq tmp TU)
     )
   )
   tmp
 )
 ;;;---------------- Main ----------------------------------
 (princ "\nRTF - © CADViet.com")
 (setq
   CV_TUTRUOC (Nhapstr CV_TUTRUOC "\nNhap tu dung truoc")
   CV_TUSAU   (Nhapstr CV_TUSAU "\nNhap tu dung sau")    
   CV_TUGIUA  (Nhapstr CV_TUGIUA "\nNhap tu can thay o giua")
 )
 (princ "\nChon cac doi tuong TEXT: ")
 (setq sstext     (ssget '((0 . "TEXT"))))
 (sudung thaytext sstext)
 (princ)
)
(princ "\nLenh Replace Text Format - thay the text theo dinh dang")
(princ "\n© CADViet.com - Hay dung lenh RTF de bat dau!")
(princ)

[Jin Yong 337]

Lệnh RTF của chương trình dưới đây sẽ làm được điều Jin muốn.

Chương trình sẽ yêu cầu nhập vào:

- từ đứng trước: là cụm từ nhận dạng đứng đằng trước từ cần thay. trong ví dụ của Jin, từ này có thể là 'D'.

- từ đứng sau: là cụm từ nhận dạng đứng đằng sau từ cần thay. trong ví dụ của Jin, từ này có thể là '-16(220x50)' hoặc '-16' đều được.

- từ mới muốn thay: là từ muốn thay vào giữa hai cụm từ nhận dạng trên. Trong ví dụ của jin, từ này là '13'.

- các text cần thay: chọn các text cần thay.

Các giá trị này được lưu lại, nếu các lần dùng lệnh sau mà không muốn thay đổi giá trị, chỉ việc nhấn enter lúc chương trình hỏi.

Cách hoạt động của chương trình theo ví dụ của Jin: tìm tất cả các từ có cấu trúc D*-16 và thay bằng D13-16.

Tuyệt vời!

 

Nhưng gặp một trở ngại lớn

Đó là việc các dầm tầng 1 sẽ có tên như sau: D1-1 (22x30), D1-2 (22x30), D1-3 (22x50)....

Và muốn đổi tất cả sang tầng 2 thì lại phải lần lượt khai các đuôi của nó, sẽ là -1 (22x30), -2 (22x30) và -3 (22x50).... Như vậy thì mất công quá, mà những 100 text như thế thì Jin phải nhấn chuột bao nhiêu lần.

Anh Hoành có thể:

 

1. Sửa để Lisp chỉ cần tìm theo cấu trúc D*-* được không?

 

2. Thay thế hàng loạt bằng cách chọn một lúc nhiều text được không?

[conghoa 136]

@Jin bạn đọc bài viết của mình bên trên bài của bạn Nguyen Hoanh chưa vậy :s_dead: cái đó có thể đáp ứng được hết yêu cầu của bạn.

 

@Nguyen Hoanh. Không hiểu sao cái lisp offset tuong sang hai bên của bạn lúc mình làm được, lúc thì nó lại nhảy cả hai đường mới ofset về 1 phía (tứ là 2 đường trùng nhau chứ không đối xứng nhua qua trục). Bạn kiểu tra lại giúp mình nhé!

 

Thanks

[Jin Yong 337]

@Jin bạn đọc bài viết của mình bên trên bài của bạn Nguyen Hoanh chưa vậy :ph34r: cái đó có thể đáp ứng được hết yêu cầu của bạn.

 

@Nguyen Hoanh. Không hiểu sao cái lisp offset tuong sang hai bên của bạn lúc mình làm được, lúc thì nó lại nhảy cả hai đường mới ofset về 1 phía (tứ là 2 đường trùng nhau chứ không đối xứng nhua qua trục). Bạn kiểu tra lại giúp mình nhé!

 

Thanks

Đã đọc bài của bạn rồi mừ, nhưng mà muốn thực hiện được thì lại phải copy sang bản CAD khác để khỏi mất các bản vẽ cũ, thế thì không được tiện cho lắm.

 

Anh Hoành ơi, làm hộ tiếp cho Jin một chút đi :s_dead:

[conghoa 136]

Sao lại phải copy sang bản vẽ khác. Có thể chọn vùng tìm kiếm được mà. trong bảng Find có cái nút trên cùng bên phải có biểu tượng con chuột và chữ x màu đỏ. Bạn bấm vào đó rồi chọn bản vẽ KC-... , chương trình sẽ chỉ tìm và thay thế trong vùng trọn thôi!

[Nguyen Hoanh 4669]

@Jin: Lisp trên muốn làm như Jin nói, chỉ cần cấu trúc D*- là được mà. Tức là từ trước là 'D', từ sau là '-'. Lisp trên đã làm được nhiều đối tượng một lúc rồi mà.

 

@conghoa: bạn có thể upload file mà lisp chạy bị lỗi lên được không! tôi sẽ xem chính xác được lisp bị lỗi gì. cảm ơn bạn.

[conghoa 136]

@NguyenHoanh mình chưa biết cách up lên host của fỏum ntn :s_dead:. Nhưng hầu như file cad nào của mình cũng sảy ra trường họp trên, có nét được, có nét ko Những nét vẽ dài phần lớn là ko được. (>20000mm).

[conghoa 136]

Lâu không thấy ai post, xin mạn phép post tiếp vậy :s_dead:

 

Mình đã phải ngồi căn lại khoảng cách giữa các dòng dim cho nó bằng nhau và cảm thấy hơi vất.

 

Mình muốn các bạn giúp cho 1 lisp có thể tự động căn chỉnh khoảng cách các dòng dim bằng nhau.

ví dụ:- có 3 hàng dim (dim mặt bằng, có khoảng cách không bằng nhau ). Khi dùng lisp sẽ tự động căn chỉnh khoảng khoảng cách giũa các hàng dim bằng 1 giá trị nhập vào từ bàn phím.

 

Thanks!

[nguoi bi an 4]

các bác ơi giúp em với , em cũng chỉ là sv mới ra trường nền cung chưa có rành lắm về autolip.mong các bác chỉ giáo thêm.

nhân tiện đầy em nhờ các bác giúp cho em một cái lip mà thay đổi cỡ chữ cũng như font chữ ,gống như lệnh ma(ma ko làm dc trong mtext)

cảm ơn các bác trước nha.

[xaydung 12]

Anh Hoanh ơi. Em đang rất cần lisp có nội dung như sau

khi tải lisp yêu cầu nhập kí tự(string) cần tìm sau đó nhập

điểm chèn trên màn hình, hiện ra kết quả là số lượng ký tự như thế đã tìm thấy là bao nhiêu

Em có biết đến lệnh find nhưng lệnh này nó tìm (find) và thay thế (replace) chứ không

đếm được số lượng như trên.

Anh giúp em với nha. Em cám ơn nhiều

[Nguyen Hoanh 4669]

[/b]11 AM']Anh Hoanh ơi. Em đang rất cần lisp có nội dung như sau

khi tải lisp yêu cầu nhập kí tự(string) cần tìm sau đó nhập

điểm chèn trên màn hình, hiện ra kết quả là số lượng ký tự như thế đã tìm thấy là bao nhiêu

Em có biết đến lệnh find nhưng lệnh này nó tìm (find) và thay thế (replace) chứ không

đếm được số lượng như trên.

Anh giúp em với nha. Em cám ơn nhiều

 

Lệnh là WCNT (viết tắt của word count):

(defun c:wcnt (/ sw ss sotu pp)
 (defun sudung	(ham ss / sodt index entdt soapp)
   (setq sodt	(cond
	  (ss (sslength ss))
	  (t 0)
	)
  soapp	0
  index	0
   )
   (repeat sodt
     (setq entdt (ssname ss index)
    index (1+ index)
     )
     (if (ham entdt)
(setq soapp (1+ soapp))
     )
   )
   soapp
 )
 (defun dem (ent / tt gt)
   (setq tt (entget ent)
  gt (cdr (assoc 1 tt))
   )
   ([b][color="#0000FF"]if[/color][/b]	(wcmatch gt (strcat "*" sw "*"))
     (setq
sotu (1+ sotu)
[b][color="#0000FF"];;[/color][/b]	gt   (vl-string-subst "" sw gt)
     )
   )
 )
 (princ "\nWord Count © CADViet.com 2007")
 (while (or (not sw)
     (= sw "")
 )
   (setq sw [b][color="#0000FF"](cdr (assoc 1 (entget (car (entsel "\nPick vao doi tuong text de lay gia tri: "))))[/color][/b])
   )
 )
 (setq
   ss	 (ssget '((0 . "TEXT")))
   sotu 0
 )

 (sudung dem ss)
 (setq	pp (strcat "\nSo tu "
	   sw
	   " xuat hien trong cac doi tuong text vua chon la: "
	   (itoa sotu)
   )
 )
 (princ pp)

 (entmake
   (list
     (cons 0 "TEXT")
     (cons 10
    (setq tmp (getpoint "\nVao diem chen text ket qua: "))
     )
     (cons 40 (getdist tmp "\nVao chieu cao chu: "))
     (cons 1 pp)
   )
 )
 (princ)
)
(vl-load-com)
(princ "\nWord Count © 2007, CADViet.com")
(princ "\nSu dung lenh WCNT de bat dau!")
(princ)

[xaydung 12]

trước tiên xin cảm ơn bác Hoanh đã trả lời dùm em

nhưng bác ơi cái lisp này còn 1 số hạn chế như sau:

a. không gõ được ký tự cách mà chỉ gõ được các string liền nhau

 

b. không tìm được các ký tự bằng tiếng Việt( em đã dùng unicode, TCVN3)

 

Về vấn đề a thì có lẽ em còn khắc phục được ( thêm chữ T gì gì đó)

 

Còn về ý b thì ôi thôi , em...bó tay

Mong bác giúp em chút nữa nha. thanks bác trước!

[Nguyen Hoanh 4669]

nhưng bác ơi cái lisp này còn 1 số hạn chế như sau:

a. không gõ được ký tự cách mà chỉ gõ được các string liền nhau

b. không tìm được các ký tự bằng tiếng Việt( em đã dùng unicode, TCVN3)

a. Trong lisp trên, bạn thay mã lệnh (getstring "\nChuoi can tim: ") bằng (getstring T "\nChuoi can tim: ") là khắc phục được.

b. Nếu dùng mã tiếng Việt VNI hay TCVN3 (mã 1 byte) vẫn tìm được như thường.

[Nguyen Hoanh 4669]

các bác ơi giúp em với , em cũng chỉ là sv mới ra trường nền cung chưa có rành lắm về autolip.mong các bác chỉ giáo thêm.

nhân tiện đầy em nhờ các bác giúp cho em một cái lip mà thay đổi cỡ chữ cũng như font chữ ,gống như lệnh ma(ma ko làm dc trong mtext)

cảm ơn các bác trước nha.

Lệnh MA vẫn dùng được với MTEXT mà!

nếu file của bạn gặp trục trặc, bạn có thể upload nó lên diễn đàn được không? mọi người sẽ có cơ hội giúp bạn.

[xaydung 12]

Khổ cái thân em quá bác ơi, em đã gõ tiếng việt nhiều rồi nhưng nó toàn ra các ký tự lằng nhằng của

cái font txt.shx của text style standard đó.(ở dòng command:) em đã chuyển sang font arial rùi

cũng không được

em dùng VietKey 2000 beta3

quá tam 3 bận bác cố gắng giúp em nha!

[Nguyen Hoanh 4669]

Khổ cái thân em quá bác ơi, em đã gõ tiếng việt nhiều rồi nhưng nó toàn ra các ký tự lằng nhằng của

cái font txt.shx của text style standard đó.(ở dòng command:) em đã chuyển sang font arial rùi

cũng không được

em dùng VietKey 2000 beta3

quá tam 3 bận bác cố gắng giúp em nha!

 

xin lỗi, tôi chưa hiểu sự khó khăn của bạn ở đâu?

là vấn đề tiếng Viêt trong AutoCAD?

hay hiển thị sai tiếng Việt tại dòng command?

[xaydung 12]

Đúng rồi đó bác à, chính là vấn đề hiển thị sai tiếng Việt tại dòng command

Còn gõ tiếng việt tại màn hình nền thì hổng vấn đề

bác giúp em nha , em đang rất cần! thanks

[Nguyen Hoanh 4669]

Đúng rồi đó bác à, chính là vấn đề hiển thị sai tiếng Việt tại dòng command

Còn gõ tiếng việt tại màn hình nền thì hổng vấn đề

bác giúp em nha , em đang rất cần! thanks

bạn đọc cái này: http://www.cadviet.com/forum/index.php?showtopic=458

[xaydung 12]

Lại phiền bác Hoành chút rùi

Em vẫn chưa gõ được bác à

thôi thế này đi: Bác sửa dùm em cái lisp 1 chút nữa nha

Lần này không nhập string tại dòng nhắc nữa mà

khi khởi động lisp yêu cầu chọn trực tiếp

text trên màn hình acad. Em nghĩ cũng tiện đó

Bác giúp em nha!

[Nguyen Hoanh 4669]

Lại phiền bác Hoành chút rùi

Em vẫn chưa gõ được bác à

thôi thế này đi: Bác sửa dùm em cái lisp 1 chút nữa nha

Lần này không nhập string tại dòng nhắc nữa mà

khi khởi động lisp yêu cầu chọn trực tiếp

text trên màn hình acad. Em nghĩ cũng tiện đó

Bác giúp em nha!

bạn thay dòng lệnh

(getstring T "\nChuoi can tim: ")

bằng

(cdr (assoc 1 (entget (car (entsel "\nPick vao doi tuong text de lay gia tri: ")))))

là được.

[xaydung 12]

Cám ơn bác, đạt 80% yêu cầu của em rùi

tuy nhiên vẫn còn chút lăn tăn bác ạ

Ví dụ: khi chọn 1 text mẫu có tên là "ghế"

trên màn hình có các text sau: ghế, bàn ghế, ghế tre, ghế mây. em chọn các text này

thì báo là : chu ghế xuat hien trong cac doi tuong text vua chon la: 4

điều này là sai vì chỉ có 1 text là ghế thôi, còn "bàn ghế, ghế tre, ghế mây" là 1 dòng text

có nghĩa lisp này đã đếm chữ ghế trong cả 1 text liền dòng

ý em hơi khác 1 chút tức là chỉ cần báo:

chu ghế xuat hien trong cac doi tuong text vua chon la: 1

Bác hiểu ý em chưa , lại phiền bác nghiên cứu giúp em tí nữa vậy!

em cám ơn

[Nguyen Hoanh 4669]

bạn bỏ chữ while thay bằng chữ if trong dòng mã: (while (wcmatch gt (strcat "*" sw "*"))

Như vậy, dòng mã mới là: (if (wcmatch gt (strcat "*" sw "*"))

[xaydung 12]

Vẫn chưa được bác à, bác xem lại cho em chút nữa nha!

em còn thay cả (while (or (not sw)...

thành (if (or (not sw)...

cũng vẫn vậy bác à, không suy suyển chi cả??!

[Nguyen Hoanh 4669]

Vẫn chưa được bác à, bác xem lại cho em chút nữa nha!

em còn thay cả (while (or (not sw)...

thành (if (or (not sw)...

cũng vẫn vậy bác à, không suy suyển chi cả??!

Bạn hăng hái quá.

Chỉ cần thay 1 chỗ như tôi chỉ thôi, thay cả 2 thì vô nghĩa.

Sau đây là đoạn lisp sau 2 lần nâng cấp theo ý của bạn:

(defun c:wcnt (/ sw ss sotu pp)
 (defun sudung	(ham ss / sodt index entdt soapp)
   (setq sodt	(cond
	  (ss (sslength ss))
	  (t 0)
	)
  soapp	0
  index	0
   )
   (repeat sodt
     (setq entdt (ssname ss index)
    index (1+ index)
     )
     (if (ham entdt)
(setq soapp (1+ soapp))
     )
   )
   soapp
 )
 (defun dem (ent / tt gt)
   (setq tt (entget ent)
  gt (cdr (assoc 1 tt))
   )
   ([color="#FF0000"]if[/color]	(wcmatch gt (strcat "*" sw "*"))
     (setq
sotu (1+ sotu)
[color="#FF0000"];;;[/color]	gt   (vl-string-subst "" sw gt)
     )
   )
 )
 (princ "\nWord Count © CADViet.com 2007")
 (while (or (not sw)
     (= sw "")
 )
   (setq sw [color="#FF0000"](cdr (assoc 1 (entget (car (entsel "\nPick vao doi tuong text de lay gia tri: ")))))[/color])
 )
 (setq
   ss	 (ssget '((0 . "TEXT")))
   sotu 0
 )

 (sudung dem ss)
 (setq	pp (strcat "\nSo tu "
	   sw
	   " xuat hien trong cac doi tuong text vua chon la: "
	   (itoa sotu)
   )
 )
 (princ pp)

 (entmake
   (list
     (cons 0 "TEXT")
     (cons 10
    (setq tmp (getpoint "\nVao diem chen text ket qua: "))
     )
     (cons 40 (getdist tmp "\nVao chieu cao chu: "))
     (cons 1 pp)
   )
 )
 (princ)
)
(vl-load-com)
(princ "\nWord Count © 2007, CADViet.com")
(princ "\nSu dung lenh WCNT de bat dau!")
(princ)

[xaydung 12]

Vẫn không được bác à, khắc phục được 90% rùi

Tức là nhiều chữ trùng nhau trong 1 dòng thì nó đếm là 1 đơn vị

(khá hơn 1 chút so với khi chưa thay IF)

nhưng 100% thì phải là

nhiều chữ trùng nhau trong 1 dòng thì đếm là 0

(Vì chỉ đếm những text giống y sỳ text được chọn thôi)

Em đang dùng cad 2005 - hay nó bị lỗi gì hả bác?