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ị

Ketxu chỉnh 1 tí code của bác Hạ cho dễ nhìn.

Khi dùng rtos đặc biệt chú ý tác dụng của biến DIMZIN

(vl-load-com)
(defun C:test (/ e1 e2 e3 h1 h2 h3 pt ss1 ss2 val blk ssgetT prf addmtext) ;ketxu changed
(initget "y Y n N")
(setq  prf (getkword "\nDoi dau :[Y/N]")
  nm (getint "\nSo le :")
  blk (vla-get-block (vla-get-activelayout(vla-get-activedocument (vlax-get-acad-object))))
  oDZ (getvar 'DiMZIN)
)
(defun addmtext (blk str pt)(vla-addmtext  blk (vlax-3d-point pt) 1 str))
(defun ssgetT (p h rg)
 (ssname
  (ssget "c" (polar p (* 1.25 pi) rg) (polar p (* 0.25 pi) rg) (list (cons 0 "TEXT") (cons 40 h) (cons 1 "~*[~0-9]*"))) 0)
)
(defun val (d e)(cdr (assoc d (entget e))))
(setvar 'DIMZIN 0)
(mapcar '(lambda(x y)(set x (val 40 y)))
 '(h1 h2 h3)
 (mapcar '(lambda(x y)(set x (car (entsel y)))) '(e1 e2 e3) '("\nText lon mau :" "\nText be:" "\nText cham"))
)

(princ "\nChon tap hop cac Text dau cham...")
(foreach en (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "TEXT") (cons 40 h3) (cons 1 "."))))))
 (vla-put-color
 (addmtext blk
  (rtos
(distof (setq str (strcat (if (= (strcase prf) "Y") "-")(val  1 (ssgetT (setq p (val 10 en)) h3 h3)) "." (val  1 (ssgetT p h2 h3))))) ;Muon alignment point thi doi so 10 thanh 11
2 nm)
  (list (car p)(cadr p)(distof str))
 )
 1) ;So 1 la mau cua doi tuong
)
(setvar 'DIMZIN oDZ)
)

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

lisp at2t của bác gia_bach rất hay, liệu bác có thể thêm phần quét chọn nhiều text 1 lúc được k? e thấy pic từng text 1 mất time quá. thanks bác

Trong topic này có mấy lisp at2t mà bác Gia_bach sửa đi sửa lại cho phù hợp nhu cầu từng người.

Vậy bạn muốn sửa lisp ở bài nào (# nào)? Hoặc post cái lisp đó lê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

Em có 1 file tọa độ bị hư.

Đáng lẽ nếu đúng là:

1.43

0.80

Nhưng bây giờ nó hiển thị là

1 43

0 80

Mất dấu chấm và có khoảng cách giữa 2 số.

 

Vậy bác nào có thể viết giùm e cái lisp chuyển lại nó như ban đầu dc ko (Nối 2 text theo thứ tự trước sau và thêm dấu chấm ở giữa)

Chứ mấy lisp trên gi mà số lớn, số nhỏ đứng trước nó phức tạp quá :)

 

Cảm ơn mấy bác đã giú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

Em có 1 file tọa độ bị hư.

Đáng lẽ nếu đúng là:

1.43

0.80

Nhưng bây giờ nó hiển thị là

1 43

0 80

Mất dấu chấm và có khoảng cách giữa 2 số.

Vậy bác nào có thể viết giùm e cái lisp chuyển lại nó như ban đầu dc ko (Nối 2 text theo thứ tự trước sau và thêm dấu chấm ở giữa)

Chứ mấy lisp trên gi mà số lớn, số nhỏ đứng trước nó phức tạp quá :)

Cảm ơn mấy bác đã giúp đỡ.

Gởi file tọa độ đó lên để thấy mặt mũi mới mần lisp chính xác bạ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

Lisp ghép từng cặp 2 text rời (dạng số) có khoảng cách 2 điểm chèn 1 hằng số, thành 1 text, thêm dấu chấm thập phân.

;Doan Van Ha - CADViet.com - Ngay 11-6-2012
;Muc dich: Noi tung cap text kieu num gan nhau nhat, bang dau ".". VD: noi "5" va "32" thanh "5.32".
;Doi tuong chon va phan nhom theo tung cap co khoang cach giua 2 diem chen text la hang so.
(defun C:HA(/ ent1 ent2 lay1 lay2 kc ss lst x1 x2)
(while (not (setq ent1 (car (entsel "\nChon text so lon lam mau: ")))))
(while (not (setq ent2 (car (entsel "\nChon text so nho lam mau: ")))))
(princ "\nChon tap hop cac Text can noi...")
(setq lay1 (cdr (assoc 8 (entget ent1))) lay2 (cdr (assoc 8 (entget ent2))))
(setq kc (- (car (cdr (assoc 10 (entget ent1)))) (car (cdr (assoc 10 (entget ent2))))))
(setq ss (ssget (list (cons -4 "<AND") (cons 0 "TEXT") (cons -4 "<OR") (cons 8 lay1) (cons 8 lay2) (cons -4 "OR>") (cons -4 "AND>"))))
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(if (/= (rem (length lst) 2) 0)
 (alert "Yeu cau so luong 2 nhom Text phai bang nhau!")
 (foreach ent1 lst
  (setq x1 (car (cdr (assoc 10 (entget ent1)))))
  (foreach ent2 lst
(setq x2 (car (cdr (assoc 10 (entget ent2)))))
(if (equal (- x1 x2) kc 1E-8)
(progn
 	(entmod (subst (cons 1 (strcat (cdr (assoc 1 (entget ent1))) "." (cdr (assoc 1 (entget ent2))))) (assoc 1 (entget ent1)) (entget ent1)))
 	(entdel ent2)
 	(setq lst (vl-remove ent1 (vl-remove ent2 lst))))))))
(princ))

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

 

mình đính kèm đó. cảm ơn ban nhiều.http://www.cadviet.c...3/103045_hg.rar

Hề hề hề,

Cứ theo cái ngu ý của mình thì file của bạn vốn dĩ không có dấu chấm giữa các text mà chỉ có dấu point giữa các text mà thôi. Vị trí của point này chính là điểm giữa của khoảng cách giữa hai đểm đặt của hai text thể hiện cao độ.

Nay nếu bạn muốn ghép nó thành một text thì e rằng cái điểm point này sẽ bị trật tọa độ so với điểm gốc ban đầu. Và như vậy nó sẽ cho bạn một bản vẽ không được chuẩn xác nữa.

Vì thế nều bạn thấy nhận xét của mình đúng, mình có thể giúp bạn tạo lại cái dấu point đó và ghép hai text làm một nhưng hình ảnh text sẽ lệch về bên phải của point chứ không phải là ngay chính point đó.

bạn có đồng ý không???

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

Hoặc dùng 1 lisp ketxu viết lâu lâu rồi xem có còn hợp với bạn không ^^

Link gốc : http://www.google.com.vn/url?sa=t&rct=j&q=n%E1%BB%91i%20text%20chu%E1%BB%97i%20ketxu%20lisp&source=web&cd=1&ved=0CFUQrAIoAjAA&url=http%3A%2F%2Fwww.cadviet.com%2Fforum%2Findex.php%3Fshowtopic%3D53491&ei=_3rVT9eCF6u4iAeFubiMAw&usg=AFQjCNFtmVh6HMhSFUdbqmbaQeLEK4AYYQ&cad=rja

(defun c:gt (/)
(defun ST:Ss->ListEnt (ss / n e l)
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
(setq l (cons e l))
 )
)
(defun ST:List-Split (old n / a lsttmp new)
(setq i 0 a (length old))
  (while (< i a)
 (repeat n (setq lsttmp (append lsttmp (list (car old))) old (cdr old)))
(setq new (append new  (list (vl-remove nil lsttmp)))
 i (+ i n)
 lsttmp '())
 )
 new)
(defun dxf (code en)(cdr(assoc code (entget en))))
(defun chdxf (code val en) (entmod (subst (cons code val) (assoc code (entget en)) (entget en))))
(Setq  ss (ST:Ss->ListEnt (ssget (list (cons 0 "TEXT,MTEXT"))))
 lstEname (vl-sort  lstEname '(lambda (x y)(< (car (dxf 10 x))(car (dxf 10 y)))(> (cadr (dxf 10 x))(cadr (dxf 10 y)))))
 lstEname (ST:List-Split lstEname 2)
)
(foreach lst lstEname
(setq lst (vl-sort lst '(lambda (x y)(< (car (dxf 10 x))(car (dxf 10 y))))))
(vla-put-alignment (setq 1st (vlax-ename->vla-object (car lst))) 0)
(chdxf 1 (strcat (dxf 1 (car lst)) "." (dxf 1 (last lst))) (car lst))
(entdel (last lst))
)
)

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

 

mình đính kèm đó. cảm ơn ban nhiều.http://www.cadviet.c...3/103045_hg.rar

Hề hề hề,

Chả biết có đúng ý chủ thớt không nhưng đây là cái mình đã nghĩ và mần theo suy nghĩ ở bài post trước,

Nếu không đúng ý xin chủ thớt và các bác khác đừng mắng nhé.


(defun c:stcd (/ oldos sst elst p0 txt0 p1 sst1 p00 txt1 str )
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(setq sst (acet-ss-to-list (ssget (list (cons 0 "text") (cons 72 0) (cons 8 "TEXTCAODOMIA")))))
(foreach txt sst
       (setq elst (entget txt)
                 p0 (cdr (assoc 10 elst))
                 txt0 (cdr (assoc 1 elst))
                 p1 (list (- (car p0) 0.4) (cadr p0) (caddr p0))
                 sst1 (acet-ss-to-list (ssget "c" (list (1- (car p0)) (- (cadr p0) 0.5) (caddr p0)) (list (1+ (car p0)) (+ (cadr p0) 0.5) (caddr p0))
                                                                    (list (cons 0 "text") (cons 72 2) (cons 8 "TEXTCAODOMIA"))))
       )
       (foreach text sst1
                (setq p00 (cdr (assoc 11 (entget text))))
                (if (equal (- (car p0) (car p00)) 0.8 0.0001)
                    (progn
                          (setq txt1 (cdr (assoc 1 (entget text))))
                          (command "erase" text "")    )
                )
       )
       (if txt1 (progn
                (setq str (strcat txt1 "." txt0)
                          elst (subst (cons 1 str) (assoc 1 elst) elst)
                )
                (entmod elst)
                (command "point" p1)  )
       )
)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)


Hy vọng đúng ý 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

Nhờ các bác xem dùm em file này với. Em dùng thử tất cả các lisp các bác viết nhưng mà kết quả chưa được tốt lắm. Em muốn hồi phục lại các cao độ đã bị phân mảnh để lưu lại tệp dùng san nền. Mong các bác chỉ giáo. http://www.cadviet.c...673_binh_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

Nhờ các bác xem dùm em file này với. Em dùng thử tất cả các lisp các bác viết nhưng mà kết quả chưa được tốt lắm. Em muốn hồi phục lại các cao độ đã bị phân mảnh để lưu lại tệp dùng san nền. Mong các bác chỉ giáo. http://www.cadviet.c...673_binh_do.dwg

Hề hề hề,

Chưa được tốt lắm ở chỗ nào???

Thế nào thì sẽ là tốt???

Bạn cần có bản vẽ thể kiện cái kết quả bạn cần thì mới làm được bạ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

em có file đo dạng như thế này http://www.mediafire.com/?vwglvrispcsp5f8 em muốn lấy X,Y,Z ra tâm điểm ở giữa của text,

và cso thể quét một lần hết các điểm luôn

mong các anh giúp đỡ

Nói rõ hơn đi bạn, chẳng hiểu gì cả, Text nào, text như trong file hay text ghep hai phần nguyên-thập phân(có dấu chấm (.) ) nếu đã biết về lisp thì bạn chỉ cần xem lại topic này http://www.cadviet.com/forum/topic/51925-yeu-cau-lisp-xac-dinh-tam-cua-1-hinh-bat-ky/ cộng với hiểu biết của mình là sẽ làm đượ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

Nhờ các bác xem dùm em file này với. Em dùng thử tất cả các lisp các bác viết nhưng mà kết quả chưa được tốt lắm. Em muốn hồi phục lại các cao độ đã bị phân mảnh để lưu lại tệp dùng san nền. Mong các bác chỉ giáo. http://www.cadviet.c...673_binh_do.dwg

Cái này không cần lisp. Từ cad 2008 trở lên bạn có thể dùng lệnh dataextraction.Bạn sẽ lấy được thuộc tính của điểm nằm ở tâm đường tròn thập phân.

Chúc bạn thành công!

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

 

Lisp ghép từng cặp 2 text rời (dạng số) có khoảng cách 2 điểm chèn 1 hằng số, thành 1 text, thêm dấu chấm thập phân.

;Doan Van Ha - CADViet.com - Ngay 11-6-2012
;Muc dich: Noi tung cap text kieu num gan nhau nhat, bang dau ".". VD: noi "5" va "32" thanh "5.32".
;Doi tuong chon va phan nhom theo tung cap co khoang cach giua 2 diem chen text la hang so.
(defun C:HA(/ ent1 ent2 lay1 lay2 kc ss lst x1 x2)
(while (not (setq ent1 (car (entsel "\nChon text so lon lam mau: ")))))
(while (not (setq ent2 (car (entsel "\nChon text so nho lam mau: ")))))
(princ "\nChon tap hop cac Text can noi...")
(setq lay1 (cdr (assoc 8 (entget ent1))) lay2 (cdr (assoc 8 (entget ent2))))
(setq kc (- (car (cdr (assoc 10 (entget ent1)))) (car (cdr (assoc 10 (entget ent2))))))
(setq ss (ssget (list (cons -4 "<AND") (cons 0 "TEXT") (cons -4 "<OR") (cons 8 lay1) (cons 8 lay2) (cons -4 "OR>") (cons -4 "AND>"))))
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(if (/= (rem (length lst) 2) 0)
  (alert "Yeu cau so luong 2 nhom Text phai bang nhau!")
  (foreach ent1 lst
   (setq x1 (car (cdr (assoc 10 (entget ent1)))))
   (foreach ent2 lst
	(setq x2 (car (cdr (assoc 10 (entget ent2)))))
	(if (equal (- x1 x2) kc 1E-8)
	(progn
  	(entmod (subst (cons 1 (strcat (cdr (assoc 1 (entget ent1))) "." (cdr (assoc 1 (entget ent2))))) (assoc 1 (entget ent1)) (entget ent1)))
  	(entdel ent2)
  	(setq lst (vl-remove ent1 (vl-remove ent2 lst))))))))
(princ))

Cái này bị lỗi bác ạ. Nó chỉ được 1 đôi đầu tiên trong tập hợp thôi, bác fix lại giúp em được ko?

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

 

Lisp ghép từng cặp 2 text rời (dạng số) có khoảng cách 2 điểm chèn 1 hằng số, thành 1 text, thêm dấu chấm thập phân.

;Doan Van Ha - CADViet.com - Ngay 11-6-2012
;Muc dich: Noi tung cap text kieu num gan nhau nhat, bang dau ".". VD: noi "5" va "32" thanh "5.32".
;Doi tuong chon va phan nhom theo tung cap co khoang cach giua 2 diem chen text la hang so.
(defun C:HA(/ ent1 ent2 lay1 lay2 kc ss lst x1 x2)
(while (not (setq ent1 (car (entsel "\nChon text so lon lam mau: ")))))
(while (not (setq ent2 (car (entsel "\nChon text so nho lam mau: ")))))
(princ "\nChon tap hop cac Text can noi...")
(setq lay1 (cdr (assoc 8 (entget ent1))) lay2 (cdr (assoc 8 (entget ent2))))
(setq kc (- (car (cdr (assoc 10 (entget ent1)))) (car (cdr (assoc 10 (entget ent2))))))
(setq ss (ssget (list (cons -4 "<AND") (cons 0 "TEXT") (cons -4 "<OR") (cons 8 lay1) (cons 8 lay2) (cons -4 "OR>") (cons -4 "AND>"))))
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(if (/= (rem (length lst) 2) 0)
  (alert "Yeu cau so luong 2 nhom Text phai bang nhau!")
  (foreach ent1 lst
   (setq x1 (car (cdr (assoc 10 (entget ent1)))))
   (foreach ent2 lst
	(setq x2 (car (cdr (assoc 10 (entget ent2)))))
	(if (equal (- x1 x2) kc 1E-8)
	(progn
  	(entmod (subst (cons 1 (strcat (cdr (assoc 1 (entget ent1))) "." (cdr (assoc 1 (entget ent2))))) (assoc 1 (entget ent1)) (entget ent1)))
  	(entdel ent2)
  	(setq lst (vl-remove ent1 (vl-remove ent2 lst))))))))
(princ))

Chân thành cám ơn bác :D. Nhờ lisp của bác mà em làm được việ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

Lisp ghép từng cặp 2 text rời (dạng số) có khoảng cách 2 điểm chèn 1 hằng số, thành 1 text, thêm dấu chấm thập phân.

;Doan Van Ha - CADViet.com - Ngay 11-6-2012
;Muc dich: Noi tung cap text kieu num gan nhau nhat, bang dau ".". VD: noi "5" va "32" thanh "5.32".
;Doi tuong chon va phan nhom theo tung cap co khoang cach giua 2 diem chen text la hang so.
(defun C:HA(/ ent1 ent2 lay1 lay2 kc ss lst x1 x2)
(while (not (setq ent1 (car (entsel "\nChon text so lon lam mau: ")))))
(while (not (setq ent2 (car (entsel "\nChon text so nho lam mau: ")))))
(princ "\nChon tap hop cac Text can noi...")
(setq lay1 (cdr (assoc 8 (entget ent1))) lay2 (cdr (assoc 8 (entget ent2))))
(setq kc (- (car (cdr (assoc 10 (entget ent1)))) (car (cdr (assoc 10 (entget ent2))))))
(setq ss (ssget (list (cons -4 "<AND") (cons 0 "TEXT") (cons -4 "<OR") (cons 8 lay1) (cons 8 lay2) (cons -4 "OR>") (cons -4 "AND>"))))
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(if (/= (rem (length lst) 2) 0)
  (alert "Yeu cau so luong 2 nhom Text phai bang nhau!")
  (foreach ent1 lst
   (setq x1 (car (cdr (assoc 10 (entget ent1)))))
   (foreach ent2 lst
	(setq x2 (car (cdr (assoc 10 (entget ent2)))))
	(if (equal (- x1 x2) kc 1E-8)
	(progn
  	(entmod (subst (cons 1 (strcat (cdr (assoc 1 (entget ent1))) "." (cdr (assoc 1 (entget ent2))))) (assoc 1 (entget ent1)) (entget ent1)))
  	(entdel ent2)
  	(setq lst (vl-remove ent1 (vl-remove ent2 lst))))))))
(princ))

bac co the giup em sua lisp này theo chức năng chọn lần luot các đối tượng mtext hoặc text roi ghep chung lai theo thu tu voi dau ; o giua cac text. em xin chan thanh cam on, em la dan ga mo, khong hieu sao may em ko danh duoc tieng viet. mong bac thong cam

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

 

Lisp ghép từng cặp 2 text rời (dạng số) có khoảng cách 2 điểm chèn 1 hằng số, thành 1 text, thêm dấu chấm thập phân.

;Doan Van Ha - CADViet.com - Ngay 11-6-2012
;Muc dich: Noi tung cap text kieu num gan nhau nhat, bang dau ".". VD: noi "5" va "32" thanh "5.32".
;Doi tuong chon va phan nhom theo tung cap co khoang cach giua 2 diem chen text la hang so.
(defun C:HA(/ ent1 ent2 lay1 lay2 kc ss lst x1 x2)
(while (not (setq ent1 (car (entsel "\nChon text so lon lam mau: ")))))
(while (not (setq ent2 (car (entsel "\nChon text so nho lam mau: ")))))
(princ "\nChon tap hop cac Text can noi...")
(setq lay1 (cdr (assoc 8 (entget ent1))) lay2 (cdr (assoc 8 (entget ent2))))
(setq kc (- (car (cdr (assoc 10 (entget ent1)))) (car (cdr (assoc 10 (entget ent2))))))
(setq ss (ssget (list (cons -4 "<AND") (cons 0 "TEXT") (cons -4 "<OR") (cons 8 lay1) (cons 8 lay2) (cons -4 "OR>") (cons -4 "AND>"))))
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(if (/= (rem (length lst) 2) 0)
  (alert "Yeu cau so luong 2 nhom Text phai bang nhau!")
  (foreach ent1 lst
   (setq x1 (car (cdr (assoc 10 (entget ent1)))))
   (foreach ent2 lst
	(setq x2 (car (cdr (assoc 10 (entget ent2)))))
	(if (equal (- x1 x2) kc 1E-8)
	(progn
  	(entmod (subst (cons 1 (strcat (cdr (assoc 1 (entget ent1))) "." (cdr (assoc 1 (entget ent2))))) (assoc 1 (entget ent1)) (entget ent1)))
  	(entdel ent2)
  	(setq lst (vl-remove ent1 (vl-remove ent2 lst))))))))
(princ))

bac co the giup em sua lisp này theo chức năng chọn lần luot các đối tượng mtext hoặc text roi ghep chung lai theo thu tu voi dau ; o giua cac text. em xin chan thanh cam on, em la dan ga mo, khong hieu sao may em ko danh duoc tieng viet. mong bac thong cam

 

Hề hề hề,

hãy gửi bản vẽ thể hiện sự mong muốn của bạn lên nhé.

  • 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

http://www.cadviet.com/upfiles/5/127068_btc_hg_v1.dwgHề hề hề,

hãy gửi bản vẽ thể hiện sự mong muốn của bạn lên nhé

 

đây là file của em ạ, ý em muốn là mình có thể quét được 1 lúc nhiều text hoặc mtext rồi nối chúng lại với nhau thành 1 text với dấu ; giữa các text. em cảm ơn bác nhiều

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



bác có thể giúp em sửa lại lisp này thêm chức nặng tự động thêm dấu ; giữa các text không ạ, chân thành cảm ơn  bác

  • Vote giảm 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

bác có thể giúp em sửa lại lisp này thêm chức nặng tự động thêm dấu ; giữa các text không ạ, chân thành cảm ơn  bác

Tìm dòng : (strcat str " " (dxf 1 edata))

thay bằng dòng : (strcat str "; " (dxf 1 edata))

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ác có thể giúp em sửa lại lisp này thêm chức nặng tự động thêm dấu ; giữa các text không ạ, chân thành cảm ơn  bác

Quá sức lười biếng

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

Quá sức lười biếng

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.

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

×