Chuyển đến nội dung
Diễn đàn CADViet
bachngoctung

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

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

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.

 

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

  • Like 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
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ũ.   

image.png

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

image.png

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

Mình sửa r nhé !

NT.lsp

  • Like 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

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

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

×