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

[pdhuyxn2 8]

Vào lúc 29/7/2010 tại 10:02, gia_bach đã nói:

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

 

 

Nhờ các bác trên diễn đàn chỉnh sửa Lisp này Nối text theo thứ tự các text được chọn thành chuỗi têxt mới sang Vị trí chọn. Các text cũ vẫn giữ nguyên.

 

[Duong Nhat Duy 302]

Vào lúc 25/10/2020 tại 09:19, pdhuyxn2 đã nói:

Nhờ các bác trên diễn đàn chỉnh sửa Lisp này Nối text theo thứ tự các text được chọn thành chuỗi têxt mới sang Vị trí chọn. Các text cũ vẫn giữ nguyên.

 

Của bạn đây !

NT.lsp

[pdhuyxn2 8]

Vào lúc 26/10/2020 tại 09:54, Duong Nhat Duy đã nói:

Của bạn đây !

NT.lsp

ThanK Bác.Em muốn chuỗi text được ghép được chuyển sang vị trí mới mà mình lựa chọn. Các text dời dạc vẫn giữ nguyên vị trí cũ.   

[Duong Nhat Duy 302]

18 giờ trước, pdhuyxn2 đã nói:

ThanK Bác.Em muốn chuỗi text được ghép được chuyển sang vị trí mới mà mình lựa chọn. Các text dời dạc vẫn giữ nguyên vị trí cũ.   

Bạn phải nói rõ là tạo text mới chứ

Mình sửa r nhé !

NT.lsp

[pdhuyxn2 8]

Cám ơn Bác A.

 

[pdhuyxn2 8]

Nhờ Bác Chỉnh giúp:

 

 

 

(defun C:nt ( / ELST ENT PT STR1 STR2)
  (defun get_str (default promp / str)
  (if (= (setq str (getstring t (strcat "\n" promp " <" default "> "))) "")
    default
    str
    )
  )
  (setq str1 "-") 
  (setq elst (acet-ss-to-list (ssget (list (cons 0 "*TEXT")))))
  (setq str2 (apply 'strcat (mapcar '(lambda (ent) (strcat (cdr (assoc 1 (entget ent))) str1)) elst)))
  (setq str2 (substr str2 1 (1- (strlen str2))))
  (setq pt (getpoint "\nChon diem chen Text: "))
  (vla-Copy (vlax-ename->vla-object (car elst)))
  (setq ent (entlast))
  (vla-Move (vlax-ename->vla-object ent) (vlax-3d-point (cdr (assoc 10 (entget ent)))) (vlax-3d-point pt))
  (entmod (subst (cons 1 str2) (assoc 1 (entget ent)) (entget ent)))
  (print)
  )

Can giup do.dwg

[pdhuyxn2 8]

Nhờ các Bác Chỉnh sửa giúp:

Tex 1 nối Text 2 bằng dầu "-" Thay từ text 3 trở đi nối "-" bằng "S="

 

 

[Duong Nhat Duy 302]

4 giờ trước, pdhuyxn2 đã nói:

Nhờ các Bác Chỉnh sửa giúp:

Tex 1 nối Text 2 bằng dầu "-" Thay từ text 3 trở đi nối "-" bằng "S="

 

 

 

NT (1).lsp

[pdhuyxn2 8]

42 phút trước, Duong Nhat Duy đã nói:

 

NT (1).lsp

Cám ơn Bắc Nhiều !Chúc Bác luôn Mạnh khỏe và Hạnh Phúc!