Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
123 replies to this topic

#81 autocad2012

autocad2012

    biết zoom

  • Members
  • Pip
  • 11 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 11 June 2012 - 08:28 AM

Gởi file tọa độ đó lên để thấy mặt mũi mới mần lisp chính xác bạn ạ!


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

#82 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5453 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 11 June 2012 - 10:49 AM

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

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#83 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 11 June 2012 - 11:46 AM


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???
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#84 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5683 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 11 June 2012 - 01:30 PM

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.co...EK4AYYQ&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))
)
)

  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#85 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 12 June 2012 - 09:41 AM


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.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#86 kekegt1

kekegt1

    biết zoom

  • Members
  • Pip
  • 15 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 13 December 2012 - 11:45 PM

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

#87 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 14 December 2012 - 10:07 AM

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 ạ.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#88 kysirong1987

kysirong1987

    Chưa sử dụng CAD

  • Members
  • Pip
  • 2 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 18 April 2013 - 05:54 AM

em có file đo dạng như thế này http://www.mediafire...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 đỡ


  • 0

#89 quansla

quansla

    biết lệnh xclip

  • Members
  • PipPipPipPipPipPipPip
  • 643 Bài viết
Điểm đánh giá: 224 (khá)

Đã gửi 18 April 2013 - 07:26 AM

em có file đo dạng như thế này http://www.mediafire...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.c...-1-hinh-bat-ky/ cộng với hiểu biết của mình là sẽ làm được


  • 0

#90 2hproduction

2hproduction

    biết vẽ circle

  • Members
  • PipPip
  • 39 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 18 April 2013 - 08:19 AM

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!


  • 0

#91 pohan

pohan

    biết zoom

  • Members
  • Pip
  • 11 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 27 March 2014 - 11:07 AM

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?


  • 0

#92 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5453 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 27 March 2014 - 12:12 PM

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?

Bản vẽ?


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#93 manhtruong2111

manhtruong2111

    Chưa sử dụng CAD

  • Members
  • Pip
  • 1 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 01 July 2014 - 06:06 PM

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


  • 0

#94 sukhoi47

sukhoi47

    biết pan

  • Members
  • Pip
  • 5 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 02 July 2015 - 11:07 AM

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

  • 0

#95 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 02 July 2015 - 03:06 PM

 

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


  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#96 sukhoi47

sukhoi47

    biết pan

  • Members
  • Pip
  • 5 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 03 July 2015 - 01:57 PM

http://www.cadviet.c...8_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


  • 0

#97 sukhoi47

sukhoi47

    biết pan

  • Members
  • Pip
  • 5 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 14 July 2015 - 03:46 PM

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


  • -2

#98 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 14 July 2015 - 04:12 PM

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


  • 0

#99 anti lazy

anti lazy

    biết lệnh erase

  • Members
  • PipPipPip
  • 107 Bài viết
Điểm đánh giá: 27 (tàm tạm)

Đã gửi 14 July 2015 - 05:09 PM

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


  • 0

#100 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5453 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 14 July 2015 - 05:15 PM

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.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.