Viết Lisp theo yêu cầu

[smilingman82 2]

link file đây các bác ạ>>>

http://www.cadviet.com/upfiles/ddddddddddddddd.bmp

bác nào bít júp m cái, vẫn đang cần ợ ....thank các pác

[Nguyen Hoanh 4.664]

trong bản vẽ của e có các tỷ lệ 1-1;1-2;góc

lisp e yc cụ thể là thế này

đặt tỷ lệ 1-1 là phím tắt 11 trên bàn phím

đặt tỷ lệ 1-2 là phím tắt 12 trên bàn phím

đặt tỷ lệ góc là phím tắt 22 trên bàn phím

 

Để khi em đang làm việc ở tỷ lệ 1-1,muốn chuyển sang tỷ lệ 1-2 thì em x\chỉ cần gõ phím 12 là tự động bản vẽ đc vẽ ở tỷ lệ 1-2;hoặc với góc cũng vậy

(bản vẽ e đang làm theo tỷ lệ tiêu chuẩn iso 25 trong hệ metric)

Chưa hiểu cấu trúc bản vẽ và cách vẽ của bạn.

- khi nhấn 11 thì lisp sẽ làm gì? không đơn giản như bạn nói vì 'đặt tỷ 1-1' có vô vàn ý nghĩa và thao tác khác nhau phụ thuộc vào cách vẽ của bạn.

- tỷ lệ góc? không hiểu thuật ngữ này của bạn.

- Bạn có thể upload 1 bản vẽ lên diễn được không?

[cadviet244 157]

Các bác ơi! e có 1 ý tưởng về lip, các bác có thể viết lip dùm e được hông, ý tưởng là : khi mình tạo một block thi muốn trim, exten block thì phải vô block rồi mình mới chọn đối tượng cần trim hay exten thì lúc đó mình mới thực hiện lệnh được vậy có bác có thể viết lip là không cần phải vô block mà mình vẫn trim hay exten những đối tượng ở trong block được hông, giống như lệnh NCOPY.E xin cảm ơn các bác nhiều lắm

[Nguyen Hoanh 4.664]

Các bác ơi! e có 1 ý tưởng về lip, các bác có thể viết lip dùm e được hông, ý tưởng là : khi mình tạo một block thi muốn trim, exten block thì phải vô block rồi mình mới chọn đối tượng cần trim hay exten thì lúc đó mình mới thực hiện lệnh được vậy có bác có thể viết lip là không cần phải vô block mà mình vẫn trim hay exten những đối tượng ở trong block được hông, giống như lệnh NCOPY.E xin cảm ơn các bác nhiều lắm

bạn hãy sử dụng lệnh refedit có sẵn của AutoCAD trước khi trim hay extend là được.

[ph168xd 313]

Các Bác viết giúp em lish sau với.

Em làm ý công trình. Vẽ bằng Pline với width =220 or =110.

Sau đó em muốn chuyển toàn bộ Pl vừa vẽ về 2 line có khoảng cách 220 or 110

http://www.cadviet.com/upfiles/Drawing2_5.dwg

 

Em đã post yêu cầu 1 lần, nhưng ko thấy ai trả lời, chắc vì đợt đó có quá nhìu iu cầu.

Nay em xin post lại mong các bác giúp

[trinhks 2]

Chưa hiểu cấu trúc bản vẽ và cách vẽ của bạn.

- khi nhấn 11 thì lisp sẽ làm gì? không đơn giản như bạn nói vì 'đặt tỷ 1-1' có vô vàn ý nghĩa và thao tác khác nhau phụ thuộc vào cách vẽ của bạn.

- tỷ lệ góc? không hiểu thuật ngữ này của bạn.

- Bạn có thể upload 1 bản vẽ lên diễn được không?

em post 1 bài mẫu của em lên,bác Hoành xem thử.Trong đó có cả lisp chuyển nhanh layer em đang dùng,bác ap vào bản vẽ thử xem rồi bác sẽ hiểu yc của em.

http://www.cadviet.com/upfiles/banve_1.zip

[traitimsat034 15]

em post 1 bài mẫu của em lên,bác Hoành xem thử.Trong đó có cả lisp chuyển nhanh layer em đang dùng,bác ap vào bản vẽ thử xem rồi bác sẽ hiểu yc của em.

http://www.cadviet.com/upfiles/banve_1.zip

ko hiểu ông này viết gì nữa, em hiểu nôm na hình như ông ta muốn lệnh thay đổi dimstyle hiện hành thì phải...?????????

[trinhks 2]

ko hiểu ông này viết gì nữa, em hiểu nôm na hình như ông ta muốn lệnh thay đổi dimstyle hiện hành thì phải...?????????

ông hiểu đúng ý tôi rồi đó.chắc là do cách diễn đạt của mình còn kém nên mọi ng ko hiểu yc của mình.ông bạn giúp tôi vụ này nhé.cám ơn ông bạn và mọi ng nhiều!!!!

[vanduong 536]

ông hiểu đúng ý tôi rồi đó.chắc là do cách diễn đạt của mình còn kém nên mọi ng ko hiểu yc của mình.ông bạn giúp tôi vụ này nhé.cám ơn ông bạn và mọi ng nhiều!!!!

Lần sau các bạn cần nguời ta giúp gì thì phải nói rõ ra - thật ngắn gọn và súc tích điều mình muốn hỏi.

Các bạn hỏi - nhưng nguời ta chưa trả lời đuợc ngay là vì có nhiều lý do chẳng hạn như họ còn có công việc của họ, không online thuờng xuyên, trả lời rùi mà vẫn hỏi, ...

Đã yêu cầu nguời ta giúp thì phải biết chấp nhận và đợi chờ ....

[traitimsat034 15]

ông hiểu đúng ý tôi rồi đó.chắc là do cách diễn đạt của mình còn kém nên mọi ng ko hiểu yc của mình.ông bạn giúp tôi vụ này nhé.cám ơn ông bạn và mọi ng nhiều!!!!

bạn dùng thử hai lệnh này xem

 

(defun c:dh1() (command ".dimstyle" "r" "1000")) ; "1000 la ten dimstyle vi du"

(defun c:dh() (command ".dimstyle" "r" "" ))

[trinhks 2]

bạn dùng thử hai lệnh này xem

 

(defun c:dh1() (command ".dimstyle" "r" "1000")) ; "1000 la ten dimstyle vi du"

(defun c:dh() (command ".dimstyle" "r" "" ))

Trời,ông bạn có biết tôi tìm kiếm cái lisp này của ông cả tháng trời nay rồi ko?cấu trúc của nó thật đơn giản mà lại có ích rất nhiều.Cám ơn ông nhiều nhé .ko biết nhiều về líp thật là thiệt đủ thứ.he.chắc m phải học cách viết lisp thôi.ông bạn có cách nào học dễ hiểu để có thể viết đc,có thể hướng dẫn cho tôi ko?một lần nữa cám ơn ông rất nhiều về tất cả!!!!

[nguyenkhoadung98 2]

thanks snowmen rất nhiều !!! các bạn cho hỏi thêm là : bây h công việc của mình cần dùng nhiều đến2 lệnh offset (O) và ME và thường phải dùng cùng nhau. Ví dụ như khi mình OFFSET 1 đường thằng thì sau đó là phải ME 1 block lên trên đường vừa OFFSET xong, vậy liệu có lisp nào cho phép kết hợp 2 lệnh trên trong 1 lệnh kô ( tạm gọi là lệnh OM).vừa OFFSET và ME 1 block lên đường vừa OFFSET, rất cảm ơn các bạn

lâu rồi kô thấy ai trả lời,mình post lại cái.mong các bạn quan tâm giúp đỡ

[AssassiN 0]

lâu rồi kô thấy ai trả lời,mình post lại cái.mong các bạn quan tâm giúp đỡ

mình cũng muốn biết cách viết lisp, ai biết chỉ dùm nhé

thanks nhiều .

[phamthanhbinh 3.146]

mình cũng muốn biết cách viết lisp, ai biết chỉ dùm nhé

thanks nhiều .

Chào bạn Assassin,

Học viết lisp không khó, cái khó là ứng dụng nó vào công việc cụ thể của mình.

Bạn hãy vào đây để học những vấn đề cơ bản về cách viết lisp, còn ứng dụng thì bạn phải tự cày thôi, chả ai thay bạn được.

http://www.cadviet.com/forum/index.php?showtopic=2480

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

[Snowman 92]

lâu rồi kô thấy ai trả lời,mình post lại cái.mong các bạn quan tâm giúp đỡ

Mọi ng ko "quan tâm" đến vấn đề của bạn vì nhiều lý do. Thứ nhất: việc gộp lệnh trên ko làm giảm tg thao tác là bao nhiêu. Thứ 2: lệnh OM như bạn nói ko được dùng phổ biến cho lắm. Thứ 3: Yêu cầu này ko "hấp dẫn" lắm đối với những ng yêu thích lisp - vì yêu cầu của bạn chỉ là thay 2 thao tác nhàm chán bằng 1 thao tác ít nhàm chán hơn mà thôi (cái này có thể chỉ là ý kiến chủ quan của tôi -_- ).

Đây là đoạn code bạn cần, (post lên để bạn thấy rằng để viết gộp 2 lệnh thành 1 thôi, nhưng để nó "dễ dùng" và "thân thiện" cũng phải...dài dòng văn tự thế nào)

(defun c:OM ( / Osmode obj Me_obj)
   (command "undo" "begin")
 (setvar "cmdecho" 0)
 (setq osmode (getvar "OSMODE"))

 (command "Ucs" "w")
 (princ "\nChon doi tuong offset")
 (setq obj (car (entsel))
)
 (if	dist
     (if (setq	dist1 (getreal (strcat "\nKhoang cach offset <"
			       (rtos dist 2)
			       "> : "
		       )
	      )
  )
(setq dist dist1)
     )
     (setq dist (getreal "\nKhoang cach offset : ")
     )
   )
 (setq
Poff (getpoint "\nChon phia offset")
)
 (if	Me_dist
     (if (setq	dist1 (getreal (strcat "\nKhoang cach rai block <"
			       (rtos Me_dist 2)
			       "> : "
		       )
	      )
  )
(setq Me_dist dist1)
     )
     (setq Me_dist (getreal "\nKhoang cach rai block : ")
     )
   )
  (if	Block
     (if (setq	Block1 (getstring (strcat "\nTen block can rai <"
			       Block
			       "> : "
		       )
	      )
  )
(setq Block Block1)
     )
     (setq Block (getstring "\nTen block can rai: ")
     )
   )

 (command "offset" dist obj Poff "")
 (setq Me_obj (entlast))
 (command "measure" Me_obj "b"  Block "Y" Me_dist)
 (command "Ucs" "P")
   (setvar "OSMODE" osmode)
 (command "undo" "end")
 (setvar "cmdecho" 1)
 (princ)

 )

[ph168xd 313]

Các Bác viết giúp em lish sau với.

Em làm ý công trình. Vẽ bằng Pline với width =220 or =110.

Sau đó em muốn chuyển toàn bộ Pl vừa vẽ về 2 line có khoảng cách 220 or 110

http://www.cadviet.com/upfiles/Drawing2_5.dwg

 

Em đã post yêu cầu 1 lần, nhưng ko thấy ai trả lời, chắc vì đợt đó có quá nhìu iu cầu.

Nay em xin post lại mong các bác giúp

 

Có ng đã post câu trả lời. nhung đó không phải là những gì câu hỏi của mình đưa ra.

Mong nbhững bậc tiền bỗi giúp đỡ. bởi vì em đang rất cần

[tuanlongtl 5]

Lệnh P2T:

 

(defun c:P2T (/ sst lstent pp p soht strht)
 (defun ss2ent	(ss / sodt index lstent)
   (setq
     sodt  (cond
      (ss (sslength ss))
      (t 0)
    )
     index 0
   )
   (repeat sodt
     (setq ent	   (ssname ss index)
    index  (1+ index)
    lstent (cons ent lstent)
     )
   )
   (reverse lstent)
 )
 (defun getp (ent)
   (cdr (assoc 10 (entget ent)))
 )
 (defun sosanh	(ent1 ent2 / p1 p2 x1 y1 x2 y2)
   (setq
     p1 (getp ent1)
     x1 (car p1)
     y1 (cadr p1)
     p2 (getp ent2)
     x2 (car p2)
     y2 (cadr p2)
   )
   (or	(< x1 x2)
(and (= x1 x2) (< y1 y2))
   )
 )

 ;;------------- Main -------------------------------
 (princ "\nPoint to Text © 2007 CADViet.com")
 (setq
   sst	   (ssget '((0 . "POINT")))
   caochu (getdist "\nVao chieu cao text: ")
   soht   (1- (getint "\nVao so bat dau danh: "))
   lstent (vl-sort (ss2ent sst) 'sosanh)
 )
 (foreach pp lstent
   (setq
     soht  (1+ soht)
     strht (itoa soht)
     p	    (getp pp)
   )
   (entmake
     (list
(cons 0 "TEXT")
(cons 10 P)
(cons 40 caochu)
(cons 1 strht)
     )
   )
 )
 (princ)
)
(princ "\nSu dung lenh P2T bat dau")

CÓ cách nào mà không cần phải chọn các point không bác Nguyenhoanh? Giống như lệnh array ấy?Ví dụ có 1 đối tượng là số 1. Bây giờ muốn tạo n hàng và m cột thì dùng lệnh array nó sẽ tạo ra n hàng và m cột số 1. Làm thế nào để vưà array vừa tăng theo chiều x và chiều y?

[Sony2007 86]

Vừa rồi tôi có lấy 1 file lisp ở diễn đàn để căn biên cho text. Khi dùng ở bản vẽ mới thì được, với bản vẽ đã có của tôi khi áp dụng lisp này thì text biến đâu mất. Cả file cad, và lisp tôi upload lên đây. Bác nào biết giúp tôi với nhé. http://www.cadviet.com/upfiles/Can_le.rar, Dùng các lệnh rt, lft,...

[Nguyen Hoanh 4.664]

Vừa rồi tôi có lấy 1 file lisp ở diễn đàn để căn biên cho text. Khi dùng ở bản vẽ mới thì được, với bản vẽ đã có của tôi khi áp dụng lisp này thì text biến đâu mất. Cả file cad, và lisp tôi upload lên đây. Bác nào biết giúp tôi với nhé. http://www.cadviet.com/upfiles/Can_le.rar, Dùng các lệnh rt, lft,...

Với bản vẽ đã có, bạn thử dùng lệnh UCS > W để chuyển ucs hiện hành về World xem sao?

[Sony2007 86]

Với bản vẽ đã có, bạn thử dùng lệnh UCS > W để chuyển ucs hiện hành về World xem sao?

Tôi đã dùng như a Hoành nói, nhưng mà không được. Không biết lý do là sao nhỉ. File tôi đã up lên gồm file cad và file lisp. Có ai biết chỉ giáo giúp

[duy782006 1.554]

Các Bác viết giúp em lish sau với.

Em làm ý công trình. Vẽ bằng Pline với width =220 or =110.

Sau đó em muốn chuyển toàn bộ Pl vừa vẽ về 2 line có khoảng cách 220 or 110

 

Vấn đề của bạn mình cũng nghĩ và có 2 hướng giải quyết nhưng hướng nào mình cũng bị vướng hết nên mình nêu lên coi có ai giải quyết được không.

1/Đọc độ rộng của pline. Đọc các đỉnh pline, vẽ Mline với độ rộng đo được qua các đỉnh đọc được. Explode cái mline ra. Cách này sẽ sai khi pline có chứa cung tròn. Vấn đề mình vướng là không biết cách lấy tọa độ của pline được chọn (cái này bác ssg làm được nhưng mình đọc hoài không hiểu).

2/Đọc độ rộng của pline. Ofset ra hai phía. Explode ra. cái này thì đúng với cả pline có cung tròn. Vấn đề mình vướng là không biết cách nào dùng lệnh ofset trong líp.

[ph168xd 313]

Vấn đề của bạn mình cũng nghĩ và có 2 hướng giải quyết nhưng hướng nào mình cũng bị vướng hết nên mình nêu lên coi có ai giải quyết được không.

1/Đọc độ rộng của pline. Đọc các đỉnh pline, vẽ Mline với độ rộng đo được qua các đỉnh đọc được. Explode cái mline ra. Cách này sẽ sai khi pline có chứa cung tròn. Vấn đề mình vướng là không biết cách lấy tọa độ của pline được chọn (cái này bác ssg làm được nhưng mình đọc hoài không hiểu).

2/Đọc độ rộng của pline. Ofset ra hai phía. Explode ra. cái này thì đúng với cả pline có cung tròn. Vấn đề mình vướng là không biết cách nào dùng lệnh ofset trong líp.

 

Cám ơn Duy nhiều, để mình thử hỏi Bác ấy xem sao?

Bác SSG có thể giúp em đc không?

[Nguyen Hoanh 4.664]

Tôi đã dùng như a Hoành nói, nhưng mà không được. Không biết lý do là sao nhỉ. File tôi đã up lên gồm file cad và file lisp. Có ai biết chỉ giáo giúp

Vì lisp bị sai.

 

Tôi chạy với bản vẽ mới, tất cả đều mặc định, vậy mà dùng lệnh rt,lft text đều văng sang chỗ khác. Bạn thử nhờ tác giả chỉnh lại lisp xem sao.

[Nguyen Hoanh 4.664]

Các Bác viết giúp em lish sau với.

Em làm ý công trình. Vẽ bằng Pline với width =220 or =110.

Sau đó em muốn chuyển toàn bộ Pl vừa vẽ về 2 line có khoảng cách 220 or 110

http://www.cadviet.com/upfiles/Drawing2_5.dwg

 

Em đã post yêu cầu 1 lần, nhưng ko thấy ai trả lời, chắc vì đợt đó có quá nhìu iu cầu.

Nay em xin post lại mong các bác giúp

Bạn xem lisp CVT ở ngay chính trong chủ đề này: Viết lisp theo yêu cầu

 

Mục này quá nhiều bài viết rồi, nên nhiều người trong chúng ta khó theo dõi. Sắp tới đây có lẽ phải chia nhỏ topic này thành các topic con theo chủ đề cho dễ theo dõi. Nhớ ngày trước, có thành viên hiến 'tối kiến' là nên gộp các lệnh của autocad vào một topic cho dễ đọc, dễ tìm. May mà quản trị đủ thông mình, chứ không thì ốm đòn vì nếu làm theo thì toàn các topic 'khủng' và khó theo dõi như topic này.

[Snowman 92]

Vừa rồi tôi có lấy 1 file lisp ở diễn đàn để căn biên cho text. Khi dùng ở bản vẽ mới thì được, với bản vẽ đã có của tôi khi áp dụng lisp này thì text biến đâu mất. Cả file cad, và lisp tôi upload lên đây. Bác nào biết giúp tôi với nhé. http://www.cadviet.com/upfiles/Can_le.rar, Dùng các lệnh rt, lft,...

Vì lisp bị sai.

 

Tôi chạy với bản vẽ mới, tất cả đều mặc định, vậy mà dùng lệnh rt,lft text đều văng sang chỗ khác. Bạn thử nhờ tác giả chỉnh lại lisp xem sao.

Bác Hoành trách oan em rồi -_- Lisp của em ko sai, chỉ "bỏ lọt" đối tượng thôi mà. Trước đây viết cũng ko để ý kỹ, dùng cũng chẳng thấy vấn đề j. Hôm nay mới giở help ra xem lại thì thấy đoạn này:

11 Second alignment point (in OCS) (optional)

 

DXF: X value; APP: 3D point

 

This value is meaningful only if the value of a 72 or 73 group is nonzero (if the justification is anything other

than baseline/left)

Đoạn lisp bỏ sót trường hợp text ở dạng mặc định (như các bác đã test) (left : mã 72 và 73 = 0)

Đây là lisp đã sửa lại.

(defun myerror (s)
 (cond
   ((= s "quit / exit abort") (princ))
   ((/= s "Function cancelled") (princ (strcat "\nError: " s)))
 )
 (setvar "cmdecho" CMD)		; Restore saved modes
 (setvar "osmode" OSM)
 (setq *error* OLDERR)			; Restore old *error* handler
 (princ)
)




;;;==============================================================
;;; Can le fai text
;;;==============================================================
(defun c:rt (/ P1)
 (setq	olderr	*error*
*error*	myerror
 )
 (setvar "cmdecho" 0)

 (command "UCS" "W" )

 (setq	sstxt (ssget '((-4 . "		       (-4 . "		       (0 . "text")
	       (0 . "Mtext")
	       (-4 . "OR>")
	       (50 . 0)
	       (-4 . "and>")
	      )
      )				;chon text
P1    (getpoint "\nChon diem canh le phai cho text")
XRtxt (car P1)
 )

 (if (not (null sstxt))
   (progn
     (setq sslen (sslength sstxt)	;dem so doi tuong chon
    ctr	  0			;Dat bien dem = 0
     )
     (command ".undo" "begin")
     (while (< ctr sslen)		;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
      altxt  (cdr (assoc 72 object))
      altxt1  (cdr (assoc 73 object))
)
(if (and (= 0 altxt)
	 (= 0 altxt1)
	 )
  (setq Ptxt   (cdr (assoc 10 object)))
  (setq Ptxt   (cdr (assoc 11 object)))
      )

(setq object (subst (cons 72 2) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 1) (assoc 73 object) object))
(setq object (entmod object))
(setq NPtxt  (list XRtxt (cadr Ptxt) ) ;(cadr Ptxt)
      object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))



(setq ctr (1+ ctr))
     )

     (command ".undo" "end")

   )
 )

 (setq *error* olderr)

 (setvar "cmdecho" 1)
 (princ)
)

;;;=====================================================
;;; Can le trai text
(defun c:lft (/ P1)
 (setq	olderr	*error*
*error*	myerror
 )
 (setvar "cmdecho" 0)
 (command "UCS" "W")
 (setq	sstxt (ssget '((-4 . "		       (-4 . "		       (0 . "text")
	       (0 . "Mtext")
	       (-4 . "OR>")
	       (50 . 0)
	       (-4 . "and>")
	      )
      )				;chon text
P1    (getpoint "\nChon diem canh le trai cho text")
XRtxt (car P1)
 )

 (if (not (null sstxt))
   (progn
     (setq sslen (sslength sstxt)	;dem so doi tuong chon
    ctr	  0			;Dat bien dem = 0
     )
     (command ".undo" "begin")
     (while (< ctr sslen)		;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
      altxt  (cdr (assoc 72 object))
      altxt1  (cdr (assoc 73 object))
)
(if (and (= 0 altxt)
	 (= 0 altxt1)
	 )
  (setq Ptxt   (cdr (assoc 10 object)))
  (setq Ptxt   (cdr (assoc 11 object)))
      )

(setq object (subst (cons 72 0) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 1) (assoc 73 object) object))
(setq object (entmod object))
(setq NPtxt  (list XRtxt (cadr Ptxt) ) ;(cadr Ptxt)
      object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))



(setq ctr (1+ ctr))
     )
     (command ".undo" "end")

   )
 )

 (setq *error* olderr)

 (setvar "cmdecho" 1)
 (princ)
)
;;;=====================================================
;;; Can giua cot text
(defun c:cct (/ P1)
 (setq	olderr	*error*
*error*	myerror
 )
 (setvar "cmdecho" 0)
 (command "UCS" "W")
 (setq	sstxt (ssget '((-4 . "		       (-4 . "		       (0 . "text")
	       (0 . "Mtext")
	       (-4 . "OR>")
	       (50 . 0)
	       (-4 . "and>")
	      )
      )				;chon text
P1    (getpoint "\nChon diem canh le giua cho cot text")
XRtxt (car P1)
 )

 (if (not (null sstxt))
   (progn
     (setq sslen (sslength sstxt)	;dem so doi tuong chon
    ctr	  0			;Dat bien dem = 0
     )
     (command ".undo" "begin")
     (while (< ctr sslen)		;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
      altxt  (cdr (assoc 72 object))
      altxt1  (cdr (assoc 73 object))
)
(if (and (= 0 altxt)
	 (= 0 altxt1)
	 )
  (setq Ptxt   (cdr (assoc 10 object)))
  (setq Ptxt   (cdr (assoc 11 object)))
      )

(setq object (subst (cons 72 1) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 2) (assoc 73 object) object))
(setq object (entmod object))
(setq NPtxt  (list XRtxt (cadr Ptxt) ) ;(cadr Ptxt)
      object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))



(setq ctr (1+ ctr))
     )
     (command ".undo" "end")

   )
 )

 (setq *error* olderr)

 (setvar "cmdecho" 1)
 (princ)
)

;;;=====================================================
;;; Can giua hang text
(defun c:crt (/ P1)
 (setq	olderr	*error*
*error*	myerror
 )
 (setvar "cmdecho" 0)
 (command "UCS" "W")
 (setq	sstxt (ssget '((-4 . "		       (-4 . "		       (0 . "text")
	       (0 . "Mtext")
	       (-4 . "OR>")
	       (50 . 0)
	       (-4 . "and>")
	      )
      )				;chon text
P1    (getpoint "\nChon diem can giua cho hang text")
XRtxt (car P1)
YRtxt (cadr P1)
 )

 (if (not (null sstxt))
   (progn
     (setq sslen (sslength sstxt)	;dem so doi tuong chon
    ctr	  0			;Dat bien dem = 0
     )
     (command ".undo" "begin")
     (while (< ctr sslen)		;Neu bien dem < so doi tuong
(setq object (entget (ssname sstxt ctr))
      altxt  (cdr (assoc 72 object))
      altxt1  (cdr (assoc 73 object))
)
(if (and (= 0 altxt)
	 (= 0 altxt1)
	 )
  (setq Ptxt   (cdr (assoc 10 object)))
  (setq Ptxt   (cdr (assoc 11 object)))
      )

(setq object (subst (cons 72 1) (assoc 72 object) object))
(setq object (entmod object))
(setq object (subst (cons 73 2) (assoc 73 object) object))
(setq object (entmod object))

(setq
      NPtxt  (list (car Ptxt) YRtxt  ) ;(cadr Ptxt)
      object (subst (cons 11 NPtxt) (assoc 11 object) object)
)
(setq object (entmod object))



(setq ctr (1+ ctr))
     )
     (command ".undo" "end")

   )
 )

 (setq *error* olderr)

 (setvar "cmdecho" 1)
 (princ)
)