Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
bachngoctung

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

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

sukhoi47    2

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.

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

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

  • 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
phamthanhbinh    3.123

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

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

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

  • 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
phamthanhbinh    3.123

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

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

 

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 ạ

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

 

 

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.

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

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

  • 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
phamthanhbinh    3.123

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.

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

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

....

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    97

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

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    385

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))
  • Vote tăng 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

 

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 ạ 

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    385

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

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    3

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

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    385

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.

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
txquychk51    2

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

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
gia_bach    1.442

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))
  • Vote tăng 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


×