Lisp Ghép Text Cần Giúp Đỡ

[gia_bach 1.549]

Bạn gia_bach sửa giùm mình thêm tí là kết quả text nối theo thứ tự các text được chọn. Mình nối 2 dòng text trên và dưới thì kết quả là text trên luôn được chuyển ra đầu.

Cật nhật theo yêu cầu : Nối text theo thứ tự các text được chọn.

(defun c:at2t (/ center color data edata ent i sel ss str);All Text to Text
 (defun centerSS (ss / lst_max lst_min maxpt minpt ll ur)
   (vl-load-com)
   (foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (vla-GetBoundingBox ent 'minpt 'maxpt)
     (setq lst_min (cons (vlax-safearray->list minpt) lst_min)
    lst_max (cons (vlax-safearray->list maxpt) lst_max)  )   )
   (setq ll (list (car (vl-sort (mapcar 'car lst_min) '<))
	   (car (vl-sort (mapcar 'cadr lst_min) '<))  )
  ur (list (last (vl-sort (mapcar 'car lst_max) '<))
	   (last (vl-sort (mapcar 'cadr lst_max) '<)) ) )
   (mapcar '/ (mapcar '+ ll ur) '(2.0 2.0 2.0))    )  

 (defun Change_Str (data pt str color)
   (entmake (list (cons 0 "TEXT") (assoc 8 data) (cons 10 pt)
	   (cons 11 pt) (assoc 7 data) (assoc 40 data)
	   (cons 71 0) (cons 72 1) (cons 73 2)
	   (cons 1 str) (cons 62 color)
	   (if (assoc 6 data)  (assoc 6 data)  '(6 . "BYLAYER") )
	   (if (assoc 39 data) (assoc 39 data) '(39 . 0) )
	   (if (assoc 370 data) (assoc 370 data) '(370 . -1) ) ))  )

 (defun dxf (tag obj) (cdr (assoc tag obj)))
;main
 (or *color* (setq *color* 6 ))
 (setq color (getint (strcat "\nNhap so mau cua Text sau khi hoan thanh <" (itoa *color*) "> :")) )
 (if color (setq *color* color) (setq color *color*))
 (setq ss (ssadd))
 (while (setq sel (entsel "\nChon cac Text can noi voi nhau: "))
   (setq ent (car sel))
   (if (= (cdr (assoc 0 (entget ent))) "TEXT")
     (ssadd ent ss)) )  
 (if (> (sslength ss) 0)
   (progn
     (setq i -1
    str ""
    center (centerSS ss)	    
    data (entget (ssname ss 0))	    )
     (while (setq ent (ssname ss (setq i (1+ i))))
(setq edata (entget ent)
      str (strcat str " " (dxf 1 edata))  )
(entdel ent)	)
     (Change_Str data center (substr str 2) color)     )
   (princ "\nKhong chon duoc Text !"))
 (princ))

[ToTo08 2]

Cật nhật theo yêu cầu : Nối text theo thứ tự các text được chọn.

(defun c:at2t (/ center color data edata ent i sel ss str);All Text to Text
 (defun centerSS (ss / lst_max lst_min maxpt minpt ll ur)
   (vl-load-com)
   (foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (vla-GetBoundingBox ent 'minpt 'maxpt)
     (setq lst_min (cons (vlax-safearray->list minpt) lst_min)
    lst_max (cons (vlax-safearray->list maxpt) lst_max)  )   )
   (setq ll (list (car (vl-sort (mapcar 'car lst_min) '<))
	   (car (vl-sort (mapcar 'cadr lst_min) '<))  )
  ur (list (last (vl-sort (mapcar 'car lst_max) '<))
	   (last (vl-sort (mapcar 'cadr lst_max) '<)) ) )
   (mapcar '/ (mapcar '+ ll ur) '(2.0 2.0 2.0))    )  

 (defun Change_Str (data pt str color)
   (entmake (list (cons 0 "TEXT") (assoc 8 data) (cons 10 pt)
	   (cons 11 pt) (assoc 7 data) (assoc 40 data)
	   (cons 71 0) (cons 72 1) (cons 73 2)
	   (cons 1 str) (cons 62 color)
	   (if (assoc 6 data)  (assoc 6 data)  '(6 . "BYLAYER") )
	   (if (assoc 39 data) (assoc 39 data) '(39 . 0) )
	   (if (assoc 370 data) (assoc 370 data) '(370 . -1) ) ))  )

 (defun dxf (tag obj) (cdr (assoc tag obj)))
;main
 (or *color* (setq *color* 6 ))
 (setq color (getint (strcat "\nNhap so mau cua Text sau khi hoan thanh <" (itoa *color*) "> :")) )
 (if color (setq *color* color) (setq color *color*))
 (setq ss (ssadd))
 (while (setq sel (entsel "\nChon cac Text can noi voi nhau: "))
   (setq ent (car sel))
   (if (= (cdr (assoc 0 (entget ent))) "TEXT")
     (ssadd ent ss)) )  
 (if (> (sslength ss) 0)
   (progn
     (setq i -1
    str ""
    center (centerSS ss)	    
    data (entget (ssname ss 0))	    )
     (while (setq ent (ssname ss (setq i (1+ i))))
(setq edata (entget ent)
      str (strcat str " " (dxf 1 edata))  )
(entdel ent)	)
     (Change_Str data center (substr str 2) color)     )
   (princ "\nKhong chon duoc Text !"))
 (princ))

 

Lisp chạy rất ổn, cám ơn bạn.

[thangbkpro 0]

Thực sự cảm ơn gia_bach với lisp này. Mình tìm được lip này và lip đếm text cũng của bạn giúp mình rút ngăn rất nhiều thời gian bóc khối lượng bản vẽ!

Mình có một vấn đề này sinh khi nối text là mình phải lặp lại lệnh at2t rất nhiều lần . Liệu có cách nào tự động nối những text có vị trí gần nhau hơn một khoảng định sẵn thành 1 text không bạn ? những text gần nhau tự nối với nhau và không nối với text khác!

Ví dụ : bản vẽ của mình có rất nhiều 4 text gần nhau có dạng như: "MCB" "3P" "32A" "10kA" sẽ được nối thành các text "MCB 3P 32A 10kA"

http://www.cadviet.com/upfiles/3/mcb.dwg

Thank again!

[thangbkpro 0]

Thực sự cảm ơn gia_bach với lisp này. Mình tìm được lip này và lip đếm text cũng của bạn giúp mình rút ngăn rất nhiều thời gian bóc khối lượng bản vẽ!

Mình có một vấn đề này sinh khi nối text là mình phải lặp lại lệnh tkt rất nhiều lần . Liệu có cách nào tự động nối những text có vị trí gần nhau hơn một khoảng định sẵn thành 1 text không bạn ? những text gần nhau tự nối với nhau và không nối với text khác!

Ví dụ : bản vẽ của mình có rất nhiều 4 text gần nhau có dạng như: "MCB" "3P" "32A" "10kA" cùng mô tả về một thiết bị sẽ được nối thành các text "MCB 3P 32A 10kA". Sau đó mình thực hiện lip đếm text sẽ thống kê được số lượng và chủng loại aptomat trong bản vẽ.

http://www.cadviet.com/upfiles/3/mcb.dwg

Thank again!

Chờ tin của bác từng ngày:)

[viettien_03 1]

Do có lỗi trong Insert Code Box

Đã Upload file . xem bài số 7

mình load về rùi ,chạy nó báo lỗi này error: malformed list on input vậy là sao bạn ơi ,hix help me

 

edit mình load được list mới rồi thank ,nhưng lần theo bài này đến đây

thì mình thử dùng mà không cái nào thành công ,đọc rất khó hiểu để sử dụng ,bạn hướng dẫn so qua được không

[mokara30 1]

Nhờ bác giabach chỉnh sửa lại lisp đơn giản thế này thôi, nối liền nhiều dtext lại với nhau thành Dtext và thứ tự nối là lần lượt là thứ tự các dtext được chọn, và lấy layer của Dtext đầu tiên được chọn.

[gia_bach 1.549]

Nhờ bác giabach chỉnh sửa lại lisp đơn giản thế này thôi, nối liền nhiều dtext lại với nhau thành Dtext và thứ tự nối là lần lượt là thứ tự các dtext được chọn, và lấy layer của Dtext đầu tiên được chọn.

Phải như thế này ko?

(defun c:at2t (/ center color data edata ent i sel ss str);All Text to Text
 (defun centerSS (ss / lst_max lst_min maxpt minpt ll ur)
(vl-load-com)
(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 	(vla-GetBoundingBox ent 'minpt 'maxpt)
 	(setq lst_min (cons (vlax-safearray->list minpt) lst_min)
	lst_max (cons (vlax-safearray->list maxpt) lst_max)  )   )
(setq ll (list (car (vl-sort (mapcar 'car lst_min) '<))
	(car (vl-sort (mapcar 'cadr lst_min) '<))  )
  ur (list (last (vl-sort (mapcar 'car lst_max) '<))
	(last (vl-sort (mapcar 'cadr lst_max) '<)) ) )
(mapcar '/ (mapcar '+ ll ur) '(2.0 2.0 2.0))	) 
 (defun Change_Str (data pt str color)
(entmake (list (cons 0 "TEXT") (assoc 8 data) (cons 10 pt)
	(cons 11 pt) (assoc 7 data) (assoc 40 data)
	(cons 71 0) (cons 72 1) (cons 73 2)
	(cons 1 str) (cons 62 color)
	(if (assoc 6 data)  (assoc 6 data)  '(6 . "BYLAYER") )
	(if (assoc 39 data) (assoc 39 data) '(39 . 0) )
	(if (assoc 370 data) (assoc 370 data) '(370 . -1) ) ))  )
 (defun dxf (tag obj) (cdr (assoc tag obj)))
;main
 (setq ss (ssadd))
 (while (setq sel (entsel "\nChon cac Text can noi voi nhau: "))
(setq ent (car sel))
(if (= (cdr (assoc 0 (entget ent))) "TEXT")
 	(ssadd ent ss)) ) 
 (if (> (sslength ss) 0)
(progn
 	(setq i -1
	str ""
	center (centerSS ss)    
	data (entget (ssname ss 0))
	color (dxf 62 data))
 	(while (setq ent (ssname ss (setq i (1+ i))))
(setq edata (entget ent)
  	str (strcat str " " (dxf 1 edata))  )
(entdel ent) )
 	(Change_Str data center (substr str 2) color) 	)
(princ "\nKhong chon duoc Text !"))
 (princ))

[mokara30 1]

Trước hết rất cảm ơn giabach vì phản hồi rất sớm, thực ra mình cần 1 cái lisp đơn giản như cái đầu tiên bạn đưa lên trong topic này thôi.

Mình diễn đạt như thế này cho dễ hiểu nhé:

- Thực ra trước giờ mình dùng lệnh "HT" của Speedcad V2.0 để nối 2 dtxet lại với nhau, (nghĩa là Dtext sau tự động nối vào đuôi Dtext trước và đương nhiên là có khoảng trắng ở giữa và vị trí của Dtext sau khi nối là vị trí của Text mình chọn đầu tiên). Nếu đã xài qua SpeedCad chắc cũng biết.

- Mình thấy Lisp đầu tiên của giabach chỉ cần chỉnh sửa thêm khoảng trắng ở giữa các text nối lại với nhau, và vị trí của text sau khi nối là text đầu tiên mình chọn là ok rồi. Chiều giờ mình cũng mày mò chỉnh sửa mà ko được như ý, chắc trình độ lisp của mình còn có hạn.

- Mong bác giabach chỉnh sửa lisp đầu tiên theo vài ý của mình, tại vì không hiểu sao Speedcad mình đang sử dụng lại không dùng được lệnh ''HT" nữa (mặc dù đã tháo ra và cài lại nhiều lần)

Cảm ơn bác giabach nhé.

[gia_bach 1.549]

Trước hết rất cảm ơn giabach vì phản hồi rất sớm, thực ra mình cần 1 cái lisp đơn giản như cái đầu tiên bạn đưa lên trong topic này thôi.

Mình diễn đạt như thế này cho dễ hiểu nhé:

- Thực ra trước giờ mình dùng lệnh "HT" của Speedcad V2.0 để nối 2 dtxet lại với nhau, (nghĩa là Dtext sau tự động nối vào đuôi Dtext trước và đương nhiên là có khoảng trắng ở giữa và vị trí của Dtext sau khi nối là vị trí của Text mình chọn đầu tiên). Nếu đã xài qua SpeedCad chắc cũng biết.

- Mình thấy Lisp đầu tiên của giabach chỉ cần chỉnh sửa thêm khoảng trắng ở giữa các text nối lại với nhau, và vị trí của text sau khi nối là text đầu tiên mình chọn là ok rồi. Chiều giờ mình cũng mày mò chỉnh sửa mà ko được như ý, chắc trình độ lisp của mình còn có hạn.

- Mong bác giabach chỉnh sửa lisp đầu tiên theo vài ý của mình, tại vì không hiểu sao Speedcad mình đang sử dụng lại không dùng được lệnh ''HT" nữa (mặc dù đã tháo ra và cài lại nhiều lần)

Cảm ơn bác giabach nhé.

Tiếc nhỉ, tui chả biết Speedcad là cái gì ?

Phải đơn giản như thế này ko?

(defun c:at2t (/  data edata ent i sel ss str);All Text to Text
 (defun dxf (tag obj) (cdr (assoc tag obj)))
 (setq ss (ssadd))
 (while (setq sel (entsel "\nChon cac Text can noi voi nhau: "))
(setq ent (car sel))
(if (= (cdr (assoc 0 (entget ent))) "TEXT")
 	(ssadd ent ss)) ) 
 (if (> (sslength ss) 0)
(progn
 	(setq i 0      
	data (entget (ssname ss 0))
	str (dxf 1 data))
 	(while (setq ent (ssname ss (setq i (1+ i))))
(setq edata (entget ent)
  	str (strcat str " " (dxf 1 edata))  )
(entdel ent) )
 	(entmod (subst (cons 1 str) (assoc 1 data) data))  )
(princ "\nKhong chon duoc Text !"))
 (princ))

[ketxu 2.984]

Có lẽ phải thêm 1 cái kiểm tra có / không có dxf 62 nữa bác ạ ^^ (# 32)

[mokara30 1]

Cảm ơn pác giabach, mình chỉ cần có vậy thôi, hì.

 

- Nhưng khi chọn các dtext mình có làm hiển thị các text đã chọn không, y chang như đối tượng được chọn trong cad đó. (khi chọn objects thì objects đó được hightligh (nghĩa là có nét đứt đứt) thể hiện object đó được chọn,) như vậy sẽ dễ kiểm soát hơn.

 

- Dù sao cũng cảm ơn pac nhiều nhé, ít nhất cái này cũng dùng được cho việc của mình rồi.

[mokara30 1]

Hôm nay chắc pác giabach bận rồi, mình có nhờ pac làm hiển thị các text được chọn nhằm dễ kiểm soát hơn, pác có thể giúp mình thêm lần này nữa được không.

Cảm ơn pac'!

[phamthanhbinh 3.146]

Hôm nay chắc pác giabach bận rồi, mình có nhờ pac làm hiển thị các text được chọn nhằm dễ kiểm soát hơn, pác có thể giúp mình thêm lần này nữa được không.

Cảm ơn pac'!

Hề hề hề,

Bạn hãy thử thay đoạn code sau:

(setq ss (ssadd)) (while (setq sel (entsel "\nChon cac Text can noi voi nhau: ")) (setq ent (car sel)) (if (= (cdr (assoc 0 (entget ent))) "TEXT") (ssadd ent ss)) )

bằng đoạn code này xem sao nhé

(prompt "\n Hay chon cac text bang cach pick text theo thu tu can noi")

(setq ss (ssget (list (cons 0 "text"))))

 

Thực ra vấn đề của bạn là do bác Gia bach sử dụng hàm entsel để bạn pick đối tượng mà hàm này mỗi lần chỉ chọn một đối tượng duy nhất nên nó không highlight mà thôi.

Chúc bạn vui.

[ketxu 2.984]

Hoặc là bạn chuyển phương thức chọn thành ssget như của bác Bình, hoặc nếu muốn giữ code bác gia_bach thì thêm redraw vào :

(defun c:at2t (/  data edata ent i sel ss str);All Text to Text
 (defun dxf (tag obj) (cdr (assoc tag obj)))
 (setq ss (ssadd))
 (while (setq sel (entsel "\nChon cac Text can noi voi nhau: "))
(setq ent (car sel))
(if (= (dxf 0 (entget ent)) "TEXT")
(progn
 (ssadd ent ss)
(redraw ent 3)
)
))
 (if (> (sslength ss) 0)
(progn
  (setq i 0    
 data (entget (ssname ss 0))
 str (dxf 1 data))
  (while (setq ent (ssname ss (setq i (1+ i))))
 (setq edata (entget ent)
 str (strcat str " " (dxf 1 edata))  )
 (entdel ent) )
  (entmod (subst (cons 1 str) (assoc 1 data) data))  )
(princ "\nKhong chon duoc Text !"))
 (princ))

[Doan Van Ha 3.191]

CV hôm nay sao kỳ vậy trời. Vào trang nào con chuột cũng đơ hết, sao đây hè?

[phamthanhbinh 3.146]

Hoặc là bạn chuyển phương thức chọn thành ssget như của bác Bình, hoặc nếu muốn giữ code bác gia_bach thì thêm redraw vào :

(defun c:at2t (/  data edata ent i sel ss str);All Text to Text
 (defun dxf (tag obj) (cdr (assoc tag obj)))
 (setq ss (ssadd))
 (while (setq sel (entsel "\nChon cac Text can noi voi nhau: "))
(setq ent (car sel))
(if (= (dxf 0 (entget ent)) "TEXT")
(progn
 (ssadd ent ss)
(redraw ent 3)
)
))
 (if (> (sslength ss) 0)
(progn
  (setq i 0    
 data (entget (ssname ss 0))
 str (dxf 1 data))
  (while (setq ent (ssname ss (setq i (1+ i))))
 (setq edata (entget ent)
 str (strcat str " " (dxf 1 edata))  )
 (entdel ent) )
  (entmod (subst (cons 1 str) (assoc 1 data) data))  )
(princ "\nKhong chon duoc Text !"))
 (princ))

Hề hề hề,

É é, bác ketxu ơi, hình như còn phải thêm (redraw ent 4) nữa thì phải?????

@ Bác DoanVanHa: Chắc bác chửa cho nó ăn sáng mà bắt no làm việc ngay nên nó đơ thui mà..... Cho nó một suất 75.000 VNĐ là nó lại chạy veo véo bác ạ....

[ketxu 2.984]

Sau khi đã entdel những thằng bị Highlight rồi thì ta bỏ qua redraw 4 ạ ^^

Thằng đầu tiên sau khi entmod nó rồi thì nó cũng bị un-highlight luôn ^^

[Doan Van Ha 3.191]

Hề hề hề,

É é, bác ketxu ơi, hình như còn phải thêm (redraw ent 4) nữa thì phải?????

@ Bác DoanVanHa: Chắc bác chửa cho nó ăn sáng mà bắt no làm việc ngay nên nó đơ thui mà..... Cho nó một suất 75.000 VNĐ là nó lại chạy veo véo bác ạ....

 

Hình như không cần (redraw ent 4) vì trong trường hợp này thằng ent bị biến chất rồi

@PTB: Vào "Sửa" hoặc "Sử dụng trình soạn thảo đầy đủ" thì chuột nó "sống" nhưng vào "Trả lời" thì nó "chết" là sao?

[mokara30 1]

Thanks pac phamthanhbinh và pac ketxu nhé,

@phamthanbinh, em thử thay phần code của pac nhưng vẫn không có kết quả,

@ketxu, lisp của pac em load thử và chạy thì báo lỗi thế này nè "Command: at2t ; error: too many arguments"

Pac nào có cao kiến giúp em thêm chút xíu nữa nhé.

Chân thành cám ơn!

[ketxu 2.984]

Có ai bị như mokara hem nhỉ ^^ Mình down về test bình thường :) Chắc bị lỗi trong quá trình down.

Nếu bạn thích chọn từng cái 1 thì viết thêm 1 cái khác cũng được :)

(defun c:test (/  dxf str data tmp);All Text to Text
(defun dxf (tag obj) (cdr (assoc tag obj)))
(if
(and
 (setq sel (entsel "\nChon Text dau tien : "))
 (wcmatch (dxf 0 (setq data (entget (car sel)))) "*TEXT")  
 (setq str (dxf 1 data)) 
)
(while
(and
 (setq tmp (entsel "\nChon Text tiep theo : "))
 (wcmatch (dxf 0 (entget (setq tmp (car tmp)))) "*TEXT") 
 (setq str (strcat str " " (dxf 1 (entget tmp))))
)
(entdel tmp)
(entmod (subst (cons 1 str) (assoc 1 data) data))
)
)
)

[xuandung87hp 9]

Các bác có thể sửa lisp cho e theo yêu cầu như sau không ạ:

+ Ghép 2 dtext thành 1 text, text có height lớn hơn là phần nguyên, text còn lại là phần thập phân ( ví dụ như 4 và 5 ghép thành 4.5)

+ Ngăn cách giữa 2 text là dấu chấm

+ Có thể quét nhìu cặp text như vậy trong một bình đồ, với đk ghép 2 text có khoảng cách gần nhau nhất

Thanks các bác rất nhiếu!

[Doan Van Ha 3.191]

Các bác có thể sửa lisp cho e theo yêu cầu như sau không ạ:

+ Ghép 2 dtext thành 1 text, text có height lớn hơn là phần nguyên, text còn lại là phần thập phân ( ví dụ như 4 và 5 ghép thành 4.5)

+ Ngăn cách giữa 2 text là dấu chấm

+ Có thể quét nhìu cặp text như vậy trong một bình đồ, với đk ghép 2 text có khoảng cách gần nhau nhất

Thanks các bác rất nhiếu!

Hề, hề!

Hôm qua post bài sai quy định nên qua "tạm trú" bên thùng rác rồi.

Đây là lisp theo y/c dựa vào bản vẽ hôm qua bạn gởi. Hết sức chú ý để chọn đối tượng!

;Doan Van Ha - CADViet.com - Ngay 16-3-2012
;Muc dich: Noi tung cap text kieu num gan nhau nhat, bang dau ".". VD: noi "5" va "3" thanh "5.3".
(defun C:HA(/ ss lst1 lst2 pt1 pt2 dis ent3)
(princ "\nChon tap hop cac Text can noi...")
(setq ss (ssget '((0 . "TEXT") (8 . "SOLON-2011,SOBE-2011"))))
(setq lst1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (chiaSS ss "SOLON-2011")))))
(setq lst2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (chiaSS ss "SOBE-2011")))))
(if (/= (length lst1) (length lst2))
 (alert "Yeu cau so luong 2 nhom Text phai bang nhau!")
 (progn
  (foreach ent1 lst1
(setq pt1 (cdr (assoc 10 (entget ent1))))
(setq dis (* 2 (distance pt1 (cdr (assoc 10 (entget (nth 0 lst2)))))))
(foreach ent2 lst2
(setq pt2 (cdr (assoc 10 (entget ent2))))
(if (< (distance pt1 pt2) dis)
 	(setq dis (distance pt1 pt2) ent3 ent2)))
(entmod (subst (cons 1 (strcat (cdr (assoc 1 (entget ent1))) "." (cdr (assoc 1 (entget ent3))))) (assoc 1 (entget ent1)) (entget ent1))))
  (foreach ent2 lst2
(entdel ent2))))
(princ))
;----- Chia ss thanh ss1 va ss2 theo lop doi tuong.
(defun chiaSS(ss lop)
(acet-list-to-ss (vl-remove-if '(lambda(x) (null (wcmatch (acet-dxf 8 (entget x)) lop))) (acet-ss-to-list ss))))

[xuandung87hp 9]

Thanks bác Doan Van Ha rất nhiều. :D

[ketxu 2.984]

Trong bài toán tìm cặp, theo ketxu nên dùng while để loại bỏ những thằng đã xét rồi ^^

[xuandung87hp 9]

Thanks 2 bác. Bác Ha cho e hỏi là lisp này e thấy chỉ dùng đựoc trong bản vẽ e up lên, e thử sang bản khác lại không dùng đựoc. Em không rành về lisp nên mong bác giúp đỡ vì em có làm rất nhiều bản vẽ như thế này.