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

Tháng 7 15, 2015

Bạn anti lazy nên thông cảm, vì đa phần các yêu cầu là từ những người không biết gì về lisp. Chắc bạn ấy cũng vậy (?)

Trường hợp biết mà ỷ lại và khoái nhờ vả hơn lao động thì thật đáng trách.

cảm ơn bác Doan van Ha rât nhiều, em không biết gì về lisp cả, nên không biết sửa như thế nào. bác hướng dẩn như trên em làm theo và được rồi, đa tạ bác.

Tháng 10 16, 2015

Các bác giúp em ca này với. bản vẽ sau khi em đã sử dụng lisp exa của 1 bác trên diễn đàn. xuất dữ liệu bản vẽ ra bảng rồi . sau khi em explode và em muốn nối 2 cột text thành 1 cột và text của 2 cột gộp với nhau ở giữa có dấu – được không ? http://www.cadviet.com/upfiles/5/146910_mau.dwg

Tháng 10 16, 2015

Các bác giúp em ca này với. bản vẽ sau khi em đã sử dụng lisp exa của 1 bác trên diễn đàn. xuất dữ liệu bản vẽ ra bảng rồi . sau khi em explode và em muốn nối 2 cột text thành 1 cột và text của 2 cột gộp với nhau ở giữa có dấu – được không ? http://www.cadviet.com/upfiles/5/146910_mau.dwg

Hề hề hề,

Quả là "không hề đơn giản" .....

Gửi một bản vẽ có cái bảng mà chả hiểu cần phải làm gì nữa. Ghép chàng nào với cô nào, cho ở chung tập thể hay mỗi cặp một buồng??? Thật là "không hề đơn giản" bác chủ thớt ạ.

Tháng 10 16, 2015

Hề hề hề,

Quả là "không hề đơn giản" .....

Gửi một bản vẽ có cái bảng mà chả hiểu cần phải làm gì nữa. Ghép chàng nào với cô nào, cho ở chung tập thể hay mỗi cặp một buồng??? Thật là "không hề đơn giản" bác chủ thớt ạ.

Mục đích của em là xin lisp để nối text trong 2 cột thành 1 cột và ở giữa có dấu – như trong bản vẽ dưới đây ạhttp://www.cadviet.com/upfiles/5/146910_mau_1.dwg

Tháng 10 17, 2015

Mục đích của em là xin lisp để nối text trong 2 cột thành 1 cột và ở giữa có dấu – như trong bản vẽ dưới đây ạhttp://www.cadviet.com/upfiles/5/146910_mau_1.dwg

Hề hề hề,

Vậy là bạn muốn cho các cập đôi này sống chung trong một chuồng . Vậy thì thử cái này coi sao.

http://www.cadviet.com/upfiles/5/5194_ghepcot.lsp

(defun c:ghct (/ p p1 p2 h ht r1 r2 ls1 ls2 ls3 ss txt)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq p1 (getpoint "\n Chon diem goc tren ben trai cot 1")
          p2 (getpoint "\n Chon diem goc trên ben trai cot 2")
          h (getdist p2 "\n Chon diem xac dinh chieu cao hang cua bang")
          r1 (getdist p1 "\n Chon diem xac dinh chieu rong cot 1")
          r2 (getdist p2 "\n Chon diem xac dinh chieu rong cot 2")
          ls1 (list)
          ls2 (list)
          ls3 (list)  )
(while (setq ss (ssget "f" (list p1 (list (+ (car p1) r1) (- (cadr p1) h))) (list (cons 0 "*text")) ))
         (setq txt (cdr (assoc 1 (entget (ssname ss 0))))
                   ls1 (append ls1 (list txt))
                   p1 (list (car p1) (- (cadr p1) h)) 
                   ht (cdr (assoc 40 (entget (ssname ss 0)))) )
)
(while (setq ss (ssget "f" (list p2 (list (+ (car p2) r2) (- (cadr p2) h))) (list (cons 0 "*text")) ))
         (setq txt (cdr (assoc 1 (entget (ssname ss 0))))
                   ls2 (append ls2 (list txt))
                   p2 (list (car p2) (- (cadr p2) h))  )
)   
(if (= (length ls1) (length ls2))
    (setq ls3 (mapcar '(lambda (x y) (strcat  x "-" y)) ls1 ls2))
)
(if ls3
    (command "rectangle" (setq p1 (getpoint "\n Chon diem dat bang moi")) (list (+ (car p1) r1 r2) (- (cadr p1) (* h (length ls3))))  )
)
(foreach txt ls3
    (setq p (list (+ (car p1) (/ (+ r1 r2) 2)) (- (cadr p1) (/ h 2))))
    (command "text" "j" "mc" p ht 0 txt)
    (setq p1 (list (car p1) (- (cadr p1) h)))
)
(setvar "osmode" oldos)
(princ)
)

Tháng 10 17, 2015

Hề hề hề,

Vậy là bạn muốn cho các cập đôi này sống chung trong một chuồng . Vậy thì thử cái này coi sao.

http://www.cadviet.com/upfiles/5/5194_ghepcot.lsp

(defun c:ghct (/ p p1 p2 h ht r1 r2 ls1 ls2 ls3 ss txt)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq p1 (getpoint "\n Chon diem goc tren ben trai cot 1")
          p2 (getpoint "\n Chon diem goc trên ben trai cot 2")
          h (getdist p2 "\n Chon diem xac dinh chieu cao hang cua bang")
          r1 (getdist p1 "\n Chon diem xac dinh chieu rong cot 1")
          r2 (getdist p2 "\n Chon diem xac dinh chieu rong cot 2")
          ls1 (list)
          ls2 (list)
          ls3 (list)  )
(while (setq ss (ssget "f" (list p1 (list (+ (car p1) r1) (- (cadr p1) h))) (list (cons 0 "*text")) ))
         (setq txt (cdr (assoc 1 (entget (ssname ss 0))))
                   ls1 (append ls1 (list txt))
                   p1 (list (car p1) (- (cadr p1) h)) 
                   ht (cdr (assoc 40 (entget (ssname ss 0)))) )
)
(while (setq ss (ssget "f" (list p2 (list (+ (car p2) r2) (- (cadr p2) h))) (list (cons 0 "*text")) ))
         (setq txt (cdr (assoc 1 (entget (ssname ss 0))))
                   ls2 (append ls2 (list txt))
                   p2 (list (car p2) (- (cadr p2) h))  )
)   
(if (= (length ls1) (length ls2))
    (setq ls3 (mapcar '(lambda (x y) (strcat  x "-" y)) ls1 ls2))
)
(if ls3
    (command "rectangle" (setq p1 (getpoint "\n Chon diem dat bang moi")) (list (+ (car p1) r1 r2) (- (cadr p1) (* h (length ls3))))  )
)
(foreach txt ls3
    (setq p (list (+ (car p1) (/ (+ r1 r2) 2)) (- (cadr p1) (/ h 2))))
    (command "text" "j" "mc" p ht 0 txt)
    (setq p1 (list (car p1) (- (cadr p1) h)))
)
(setvar "osmode" oldos)
(princ)
)

em load syntax error bác ạ

Tháng 10 17, 2015

Hề hề hề,

Vậy là bạn muốn cho các cập đôi này sống chung trong một chuồng . Vậy thì thử cái này coi sao.

http://www.cadviet.com/upfiles/5/5194_ghepcot.lsp

(defun c:ghct (/ p p1 p2 h ht r1 r2 ls1 ls2 ls3 ss txt)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq p1 (getpoint "\n Chon diem goc tren ben trai cot 1")
          p2 (getpoint "\n Chon diem goc trên ben trai cot 2")
          h (getdist p2 "\n Chon diem xac dinh chieu cao hang cua bang")
          r1 (getdist p1 "\n Chon diem xac dinh chieu rong cot 1")
          r2 (getdist p2 "\n Chon diem xac dinh chieu rong cot 2")
          ls1 (list)
          ls2 (list)
          ls3 (list)  )
(while (setq ss (ssget "f" (list p1 (list (+ (car p1) r1) (- (cadr p1) h))) (list (cons 0 "*text")) ))
         (setq txt (cdr (assoc 1 (entget (ssname ss 0))))
                   ls1 (append ls1 (list txt))
                   p1 (list (car p1) (- (cadr p1) h)) 
                   ht (cdr (assoc 40 (entget (ssname ss 0)))) )
)
(while (setq ss (ssget "f" (list p2 (list (+ (car p2) r2) (- (cadr p2) h))) (list (cons 0 "*text")) ))
         (setq txt (cdr (assoc 1 (entget (ssname ss 0))))
                   ls2 (append ls2 (list txt))
                   p2 (list (car p2) (- (cadr p2) h))  )
)   
(if (= (length ls1) (length ls2))
    (setq ls3 (mapcar '(lambda (x y) (strcat  x "-" y)) ls1 ls2))
)
(if ls3
    (command "rectangle" (setq p1 (getpoint "\n Chon diem dat bang moi")) (list (+ (car p1) r1 r2) (- (cadr p1) (* h (length ls3))))  )
)
(foreach txt ls3
    (setq p (list (+ (car p1) (/ (+ r1 r2) 2)) (- (cadr p1) (/ h 2))))
    (command "text" "j" "mc" p ht 0 txt)
    (setq p1 (list (car p1) (- (cadr p1) h)))
)
(setvar "osmode" oldos)
(princ)
)

em load syntax error bác ạ

Hề hề hề,

Bạn nên download file theo dường dẫn mình gửi, đừng download từ code box bởi hình như code box của diễn đàn có lỗi. Lisp mình đã test Ok rồi mới post.

Tháng 10 17, 2015

Hề hề hề,

Bạn nên download file theo dường dẫn mình gửi, đừng download từ code box bởi hình như code box của diễn đàn có lỗi. Lisp mình đã test Ok rồi mới post.

Em lại làm phiền bác chút.lísp chạy đôi lúc không hiện bước cuối là : điểm để xuất ra bảng và do đó ko hiện bảng .Giờ em ko quan tâm cái bảng đó nữa. em copy 2 cột text đó ra bác sửa cái lísp sao cho em quét chuột 1 cái mà 2 cột tự ghép lại được không và ở giữa các text có dấu ''-'' ạ ? và đối tượng dtext và mtext đều được ạ.

Tháng 10 17, 2015

Em lại làm phiền bác chút.lísp chạy đôi lúc không hiện bước cuối là : điểm để xuất ra bảng và do đó ko hiện bảng .Giờ em ko quan tâm cái bảng đó nữa. em copy 2 cột text đó ra bác sửa cái lísp sao cho em quét chuột 1 cái mà 2 cột tự ghép lại được không và ở giữa các text có dấu ''-'' ạ ? và đối tượng dtext và mtext đều được ạ.

Hề hề hề,

1/-Sở dĩ lisp không chạy ra bảng có thể do số lượng các text trong mỗi cột không bằng nhau.

2/- Không hiểu điều bạn muốn.

Tháng 10 17, 2015

Hề hề hề,

1/-Sở dĩ lisp không chạy ra bảng có thể do số lượng các text trong mỗi cột không bằng nhau.

2/- Không hiểu điều bạn muốn.

ý em là để cho đơn giản vấn đề thì em có 2 cột dtext(mtext ) như sau:

1a b3

2n 1-r

sd 3

lsd 1-r

... ....

bác có thể giúp em sao cho khi đánh lệnh rồi chọn quét tất cả sẽ tạo ra :

1a-b3

2n-1-r

sd-3

lsd-1r

....

Tháng 10 17, 2015

ý em là để cho đơn giản vấn đề thì em có 2 cột dtext(mtext ) như sau:

1a b3

2n 1-r

sd 3

lsd 1-r

... ....

bác có thể giúp em sao cho khi đánh lệnh rồi chọn quét tất cả sẽ tạo ra :

1a-b3

2n-1-r

sd-3

lsd-1r

....

Bạn thử lisp này

(defun c:gct (/ ss1 ss2 _NHT:sssortXY)
  ;;sap xep cac toi tuong theo X hoac Y
;;ss - selection by ssget
;;dir: T - sap xep theo X tang dan
;;     nil - sap xep theo Y giam dan
;;vla: T/nil
;;return OBJECT/ENAME

(defun _NHT:sssortXY (ss dir vla / lstent)
  ;(setq ss(ssget))
  (if ss
    (progn
    (setq lstent
	   (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
		    (if	dir
		      
		      '(lambda (x y)
			 
			 (< (car (cdr (assoc 10 (entget x))))
			    (car (cdr (assoc 10 (entget y))))
			 )
		       )
		      
		      '(lambda (x y)
			 (> (cadr (cdr (assoc 10 (entget x))))
			    (cadr (cdr (assoc 10 (entget y))))
			 )
		       )
		    )
	   )
    )
    (if vla (setq lstent(mapcar 'vlax-ename->vla-object lstent)) lstent)
    )
    lstent
  )
)
  (command "_.undo" "be")
  (if (and
	(princ "\nChon cac text o cot 1")
	(setq ss1 (ssget '((0 . "text, mtext"))))
	(princ "\nChon cac text o cot 2")
	(setq ss2 (ssget '((0 . "text, mtext"))))
      )
    (mapcar
      '(lambda (x y)
	 (vla-put-textstring
	   x
	   (strcat (vla-get-textstring x) "-" (vla-get-textstring y))
	 )
       )
      (_NHT:sssortXY ss1 nil t)
      (_NHT:sssortXY ss2 nil t)
    )
  )
  (command "_.undo" "e")
  (princ)
  )

Tháng 10 17, 2015

Một cách viết khác, quét 1 phát ( với điều kiện các text trong mỗi cột tương đối ngăn nắp 1 tý ):

(defun c:test (/ ss ent hei lst ls1 ls2 i lse)
(vl-load-com)
(if (setq ss (ssget '((0 . "*TEXT"))))
(progn (repeat (setq i (sslength ss))
(setq ent (ssname ss (setq i (1- i)))
hei (cdr (assoc 40 (entget ent)))
lst (cons (cons (cdr (assoc 10 (entget ent))) (cdr (assoc 1 (entget ent)))) lst)
lst (vl-sort lst '(lambda (x y) (< (car (car x)) (car (car y)))))))
(foreach x lst
(if (equal (caar x) (caaar lst) (* 0.1 hei))
(setq ls1 (cons (cdr x) ls1))
(setq ls2 (cons (cdr x) ls2))))
(setq lst (mapcar '(lambda (x y) (strcat x "-" y)) ls1 ls2))
(setq i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(if (member (cdr (assoc 1 (entget ent))) ls2)
(entdel ent)
(setq lse (cons ent lse))))
(mapcar '(lambda (x y) (vla-put-textstring (vlax-ename->vla-object x) y)) lse lst)))
(princ))

Tháng 10 19, 2015

Bạn thử lisp này

(defun c:gct (/ ss1 ss2 _NHT:sssortXY)
  ;;sap xep cac toi tuong theo X hoac Y
;;ss - selection by ssget
;;dir: T - sap xep theo X tang dan
;;     nil - sap xep theo Y giam dan
;;vla: T/nil
;;return OBJECT/ENAME

(defun _NHT:sssortXY (ss dir vla / lstent)
  ;(setq ss(ssget))
  (if ss
    (progn
    (setq lstent
	   (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
		    (if	dir
		      
		      '(lambda (x y)
			 
			 (< (car (cdr (assoc 10 (entget x))))
			    (car (cdr (assoc 10 (entget y))))
			 )
		       )
		      
		      '(lambda (x y)
			 (> (cadr (cdr (assoc 10 (entget x))))
			    (cadr (cdr (assoc 10 (entget y))))
			 )
		       )
		    )
	   )
    )
    (if vla (setq lstent(mapcar 'vlax-ename->vla-object lstent)) lstent)
    )
    lstent
  )
)
  (command "_.undo" "be")
  (if (and
	(princ "\nChon cac text o cot 1")
	(setq ss1 (ssget '((0 . "text, mtext"))))
	(princ "\nChon cac text o cot 2")
	(setq ss2 (ssget '((0 . "text, mtext"))))
      )
    (mapcar
      '(lambda (x y)
	 (vla-put-textstring
	   x
	   (strcat (vla-get-textstring x) "-" (vla-get-textstring y))
	 )
       )
      (_NHT:sssortXY ss1 nil t)
      (_NHT:sssortXY ss2 nil t)
    )
  )
  (command "_.undo" "e")
  (princ)
  )

Lisp bác viết chạy rất ổn. Em cảm ơn các bác đã nhiệt tình giúp đỡ em ạ

Tháng 10 20, 2015

Nhoc Test Code Anh quocmanh04tt sao quơ 1 phát thì thấy râu ông nọ cắm cằm bà kia là sao ta ...

Tháng 10 20, 2015

Nhoc biết code mà ( ở trên có ghi chú đó thôi ) - Trong code có phân loại giá trị x - dxf 10 của mỗi cột text -> nên mới có ghi chú là "Ngăn Nắp".

Tháng 10 20, 2015

Thì Nhoc lấy bản vẽ của chủ thót Test... 2 thằng đầu ok, 2 thằng cúi thì lộn tùng phèo ... Chắc Sort có vấn đề

Tháng 10 20, 2015

Cái đó do cột thứ 2 dxf 10 không cùng x.

Tháng 10 20, 2015

Ah ah, Nhoc thix nhanh gọn quơ 1 phát ... Vậy có lẻ chơi Sort theo y là Ok Ps : sao mạng gởi bài khổ quá !!!

(defun c:test (/ ss ent hei lst ls1 ls2 i lse)
(vl-load-com)
(if (setq ss (ssget '((0 . "*TEXT"))))
 (progn
    (repeat (setq i (sslength ss))
             (setq ent (ssname ss (setq i (1- i)))
                      hei (cdr (assoc 40 (entget ent)))
                      lst (cons (cons (cdr (assoc 10 (entget ent))) (cdr (assoc 1 (entget ent)))) lst)
                      lst (vl-sort lst '(lambda (x y) (< (cadr (car x)) (cadr (car y)))))
             )
    )
    (foreach x lst
           (if (equal (caar x) (caar (last lst)) (* 0.1 hei))
               (setq ls1 (cons (cdr x) ls1))
               (setq ls2 (cons (cdr x) ls2))
           )
    )
    (setq lst (mapcar '(lambda (x y) (strcat x "-" y)) ls1 ls2))
    (setq i -1)
    (while (setq ent (ssname ss (setq i (1+ i))))
           (if (member (cdr (assoc 1 (entget ent))) ls2)
               (entdel ent)
               (setq lse (cons ent lse))
           )
    )
    (mapcar '(lambda (x y) (vla-put-textstring (vlax-ename->vla-object x) y)) lse lst)
  )
)
(princ)
)

Tháng 10 20, 2015

OK

P/s: Nếu cột 1 có x khác nhau thì lại có vấn đề ...

Tháng 10 21, 2015

mình thấy lisp của Nhoc rất ổn đấy chứ.

Tháng 10 21, 2015

Mấu chốt vấn đề ở đây là phân loại những thằng nào nằm ở cột 1, thằng nào nằm ở cột 2 (Khi quét 1 phát). Trên file của bạn, bạn thử move 1 thằng text theo chiều x đi 1 tý thì sẽ hiểu ngay vấn đề. Nếu trong hai cột mỗi cột đều có điểm chèn text giống nhau, thì cả 2 phương án sort ở trên đều OK. File của bạn ở cột 2 giá trị X điểm chèn của các text không bằng nhau.

Tháng 9 20, 2016

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

E đang dùng lisp này của bác gia_bach. chạy rất ok, nhưng chỉ có hơi bất tiện ở chỗ: mỗi đợt nối 2 text (mỗi đợt nối text thì có mỗi yêu cầu khác nhau), cần thêm 1 cụm từ gì vào gữa 2 text cần nối thì e phải vào sửa code trong lisp. lúc thì nối không có khoảng trống, lúc thì nối cần có khoảng trống, lúc thì cần thêm cụm "-D" hoặc "-L=",... thì hơi mất công tý, mà e thì ko biết về lisp nên ko sửa cho trọn vẹn được ạ. nay e nhờ bác sửa cái lisp trên giúp e :

gõ n2t;

lisp sẽ nhắc: "thêm ký hiệu giữa 2 text" có thể là chữ, dấu, số,... nếu cần thêm gì thì gõ vào, ko cần thì thôi, ấn enter hoặc space (mặc định của lisp là nối text ko cần khoảng trắng. còn nếu cần nối text có khỏang trắng thì e sử dụng lại lisp ở trên.

chọn text theo thứ tự nối, ấn space, text được nối. chọn tiếp các text, ấn space, text được nối. ấn speace 2 lần để kết thúc lệnh (hoặc ấn esc để thoát lệnh mà cad ko bị lỗi :) ). mong bác gia_bach và mọi người giúp e ạ. e cảm ơn

Tháng 9 22, 2016

E đang dùng lisp này của bác gia_bach. chạy rất ok, nhưng chỉ có hơi bất tiện ở chỗ: mỗi đợt nối 2 text (mỗi đợt nối text thì có mỗi yêu cầu khác nhau), cần thêm 1 cụm từ gì vào gữa 2 text cần nối thì e phải vào sửa code trong lisp. lúc thì nối không có khoảng trống, lúc thì nối cần có khoảng trống, lúc thì cần thêm cụm "-D" hoặc "-L=",... thì hơi mất công tý, mà e thì ko biết về lisp nên ko sửa cho trọn vẹn được ạ. nay e nhờ bác sửa cái lisp trên giúp e :

gõ n2t;

lisp sẽ nhắc: "thêm ký hiệu giữa 2 text" có thể là chữ, dấu, số,... nếu cần thêm gì thì gõ vào, ko cần thì thôi, ấn enter hoặc space (mặc định của lisp là nối text ko cần khoảng trắng. còn nếu cần nối text có khỏang trắng thì e sử dụng lại lisp ở trên.

chọn text theo thứ tự nối, ấn space, text được nối. chọn tiếp các text, ấn space, text được nối. ấn speace 2 lần để kết thúc lệnh (hoặc ấn esc để thoát lệnh mà cad ko bị lỗi :) ). mong bác gia_bach và mọi người giúp e ạ. e cảm ơn

Update theo yêu cầu:

 (defun c:at2t (/ center ent i sel ss str ans obj tobj dyn);All Text to Text
  (vl-load-com)
  (defun centerSS (ss / lst_max lst_min maxpt minpt ll ur)
    (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))	) 
;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) 1)
    (progn
      (setq dyn (getvar "DYNMODE"))
      (setvar "DYNMODE" 0)
      (setq *connect (getstring t "\nKi hieu giua 2 text:"))
      (setvar "DYNMODE"  dyn)
      (setq i 0	    
	    center (centerSS ss)
	    obj (vlax-ename->vla-object (ssname ss 0))
	    str (vlax-get obj 'TextString) )
      (while (setq ent (ssname ss (setq i (1+ i))))
	(setq str (strcat str *connect (vlax-get (vlax-ename->vla-object ent) 'TextString)) )
	(entdel ent)	)
      (vla-put-alignment
	(setq tObj (vla-addText
		     (vla-get-modelspace (vla-get-activedocument(vlax-get-acad-object)))
		     str
		     (vlax-3d-point '(0 0 0)) 1)) acAlignmentMiddleCenter)
      (vla-put-TextAlignmentPoint tObj (vlax-3d-point center))
      (foreach pro (list "Height" "Layer" "Linetype" "Rotation" "Color")
	(vlax-put tObj pro (vlax-get obj pro)))
      (vla-erase obj)      )
    (princ "\nKhong chon duoc Text !"))
  (princ))

Tháng 9 22, 2016

em đã thử lisp bác gửi, kết quả vượt mức sự mong đợi ạ. cảm ơn bác rất nhiều.

Tháng 7 19, 2018

Vào lúc 27/8/2009 tại 15:40, gia_bach đã nói:

Bạn chạy thử Lisp này :

Do có lỗi trong Insert Code Box

Update : Aug 28 2009, 7:30 download here

cảm ơn lisp của bác. bác xem giúp e khi merg text lại với nhau thì text giữ nguyên căn lề, giãn text của text đầu tiên với. sau khi merge lại e có sử dụng text căn lề, giãn dòng của bác thái mà bị lỗi các text thành 0 hết. bác xem giúp. thanks

Đăng nhập

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

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

sukhoi47 2

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

Khonghedongian 5

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

phamthanhbinh 3.146

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

Khonghedongian 5

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

phamthanhbinh 3.146

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

Khonghedongian 5

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

phamthanhbinh 3.146

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

Khonghedongian 5

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

phamthanhbinh 3.146

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

Khonghedongian 5

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

tien2005 241

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

quocmanh04tt 634

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

Khonghedongian 5

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

nhoclangbac 4

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

quocmanh04tt 634

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

nhoclangbac 4

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

quocmanh04tt 634

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

nhoclangbac 4

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

quocmanh04tt 634

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

Khonghedongian 5