Học AutoLisp

[Nguyen Hoanh 4670]

Nhờ các anh giúp chu lisp về giao hội cạnh.

Mình có 2 điểm trên đoạn thẳng cần xác định điểm thứ 3

Lisp yêu cầu nhập điểm 1, bán kính. điểm 2 bán kính.

2 điểm trên vẽ ra 2 vòng tròn cắt nhau 2 điểm ở 2 phía. chọn phí cần xác định điểm 3.

Chèn vào kí hiệu vòng tròn nhỏ , xoá 2 đường tròn

Mình viết được tới đây, không biết thế nào tiếp nửa, mong được giúp đở.

;;-----------------

(defun c:giaohoi()

(setq pt1 (getpoint "\nPick diem 1 tren man hinh ")

          r1 (getdist "\nNhap ban kinh duong tron: "))

    (command ".circle" pt1 r1)

(setq pt2 (getpoint "\nPick diem 2 tren man hinh ")

          r2 (getdist "\nNhap ban kinh duong tron: "))

    (command ".circle" pt2 r2)

  (princ)

)

 

Đoạn lisp dưới đây hoàn tất chương trình theo ý tưởng của bạn. Phần màu xanh là phần viết thêm.

 

(defun c:giaohoi ()

(setq pt1 (getpoint "\nPick diem 1 tren man hinh ")

r1 (getdist pt1 "\nNhap ban kinh duong tron: ")

)

(command ".circle" pt1 r1)

(setq c1 (entlast))

(setq pt2 (getpoint "\nPick diem 2 tren man hinh ")

r2 (getdist pt2 "\nNhap ban kinh duong tron: ")

)

(command ".circle" pt2 r2)

(setq c2 (entlast)

pt3 (getpoint "\nVao phia: ")

giaodiem (giaodt c1 c2)

)

(command ".erase" c1 c2 "")

(if (cungphia pt1 pt2 pt3 (car giaodiem))

(command ".circle" (car giaodiem) (/ r2 5.0))

(command ".circle" (cadr giaodiem) (/ r2 5.0))

)

(princ)

)

 

;-------------------------------

(defun cungphia(p1 p2 p3 ptest)

(setq

giao (inters p1 p2 p3 ptest nil)

)

(not (equal (distance p3 ptest) (+ (distance p3 giao)(distance ptest giao)) 0.0001) )

)

 

(defun GiaoDT (ent1 ent2)

(setq ob1 (vlax-ename->vla-object ent1)

ob2 (vlax-ename->vla-object ent2)

)

(setq g (vlax-variant-value

(vla-IntersectWith ob1 ob2 acExtendNone)

)

)

(if (/= (vlax-safearray-get-u-bound g 1) -1)

(setq g (vlax-safearray->list g))

(setq g nil)

)

(if g

(progn

(setq kq nil

sd (fix (/ (length g) 3))

)

(repeat sd

(setq kq (append kq (list (list (car g) (cadr g) (caddr g))))

g (cdddr g)

)

)

kq

)

nil

)

)

[khaosat2009 11]

Công nhận Bác Hoành là chuyên gia về Lisp. Khâm phục, khâm phục, khâm phục.

Nhờ Bác giúp em về giao hội tiếp nha:

Ví dụ Em có một đoạn thẳng A-B là 50 m muốn tìm điểm giao hội vuông góc với 1 điểm nằm trên cạnh A-B với chiều dài cho trước, như sau :

A-1 là 27 m ( hỏi khoảng cách ), Hỏi giao hội vuông góc ra 2 ( điểm cần xác định ) ( hỏi khoảng cách ),

từ đó xác định điểm 2 vẽ kí hiệu.

Lisp hỏi :

- Chọn cạnh:

- Điểm gốc đâu

- Chiều dài bao nhiêu

- Vuông góc ra bao nhiêu:

- Về phía nào;

- Ghi chú là số nào : ( Ví dụ GH-01)

Thể hiện điểm point và ghi chú

Rất mong được Bác giúp

[ngdanghuy 1]

bác nào làm ơn chỉ cho mình công dụng và cách sử dụng chi tiết lệnh filter, xref với nhé. nếu gửi vào mail giùm mình thì càng tốt. mail của mình là

ngdanghuy.07k@gmail.com. thanks mọi người nhìu nha

[conlaiday 0]

- Tôi xin thử nghiệm một chuỗi bài viết về đào tạo AutoLisp thông qua các dự án thực tế.

Xin mọi người đóng góp ý kiến.

Bạn tạo phần diễn đàn học lisp hay đấy. nhưng vẫn là khó khăn đôi với những người mới nghe qua như mình. bạn có thể nói rõ hơn về chương trình tạo lisp này dc không

[nguyentranthang 0]

xin các bác sửa lisp xác định chiều dài đối tượng

 

(defun c:tcd( / sel ent chieudai)

(setq sel (entsel "\nHay chon doi tuong: "))

(setq ent (car sel))

(command "lengthen" ent)

(setq chieudai (getvar "lengthen"))

(princ "\nChieu dai doi tuong vua roi la: ")

(princ chieudai)

(princ "\nm")

 

(princ)

)

[gia_bach 1558]

xin các bác sửa lisp xác định chiều dài đối tượng

...........

Sử dụng AutoLisp :

Bạn phải tìm vị trí của điểm đầu và điểm cuối, sau đó gọi hàm DISTANCE để tính khoảng cách giữa 2 điểm.

(defun c:tcd1(/ chieudai data ent p1 p2 sel)
 (setq sel (entsel "\nHay chon 1 line: "))
 (setq ent (car sel))
 (setq	data (entget ent))
 (setq p1 (cdr (assoc 10 data)))
 (setq p2 (cdr (assoc 11 data)))
 (setq chieudai (distance p1 p2))
 (princ "\nChieu dai la: ")
 (princ (rtos chieudai))
 (princ)
 )

 

Sử dụng VisualLisp :

Với VisualLisp, Cad cung cấp sẵn thuộc tính Length (chiều dài), chỉ cần gọi hàm vla-get-Length để lấy thuộc tính chiều dài của đối tuợng.

Tương tự, để lấy điểm đầu và điểm cuối, gọi hàm vla-get-StartPoint và vla-get-EndPoint

(defun c:tcd2(/ chieudai ent obj sel)
 (vl-load-com)
 (setq sel (entsel "\nHay chon 1 line : "))
 (setq ent (car sel))
 (setq	obj (vlax-ename->vla-object ent))
 (setq chieudai (vla-get-Length obj))
 (princ "\nChieu dai la: ")
 (princ (rtos chieudai))
 (princ)
 )

[Tue_NV 3915]

xin các bác sửa lisp xác định chiều dài đối tượng

 

(defun c:tcd( / sel ent chieudai)

(setq sel (entsel "\nHay chon doi tuong: "))

(setq ent (car sel))

(command "lengthen" ent)

(setq chieudai (getvar "lengthen"))

(princ "\nChieu dai doi tuong vua roi la: ")

(princ chieudai)

(princ "\nm")

 

(princ)

)

Sửa lại cho bạn đây :

(defun c:tcd( / sel ent chieudai)
(setq sel (entsel "\nHay chon doi tuong: "))
(setq ent (car sel))
(command "lengthen" ent "")
(setq chieudai (getvar "perimeter"))
(princ "\nChieu dai doi tuong vua roi la: ")
(princ chieudai)
(princ "\nm")

(princ)
)

[nguyentranthang 0]

"perimeter" là gì hả a Tue_NV

[nguyentranthang 0]

Các bác viết giúp em cái lisp với yêu cầu như sau với:

move 1 số đối tượng được chọn theo chiều thẳng đứng một khoảng cách cho trước là 0.08 đơn vị

[jick 82]

Các bác viết giúp em cái lisp với yêu cầu như sau với:

move 1 số đối tượng được chọn theo chiều thẳng đứng một khoảng cách cho trước là 0.08 đơn vị

 

ủa cái này cũng cần dùng lisp hay sao???? :(

[nguyentranthang 0]

ủa cái này cũng cần dùng lisp hay sao???? :(

làm nhiều mà

mỗi lần ấn lệnh move lại phải nhập số 0.08 lâu phết

thôi không cần nữa đâu

tôi tự viết được rồi

cũng không khó lắm

[minhbk07 0]

thank bác Hoành rất nhiều,bài viết rất hay và hữu dụng

[V.I.P 0]

Phần 2:

 

Trong phần 1, chúng ta đã xây dựng được 1 chương trình lisp có thể nói là thô sơ nhất thế giới. Và nó có 1 nhược điểm: mỗi lần load thì viết ra lệnh. Muốn viết lại phải appload thêm 1 lần nữa.

 

Để điều khiển được thời điểm viết, và viết được nhiều lần, chúng ta phải định nghĩa một hàm AutoCAD, để mỗi khi gọi hàm này, chương trình sẽ viết ra màn hình text mà không cần phải appload lại file lisp.

 

Trên file hoclisp.lsp, chúng ta thêm mã lệnh để trở thành như sau:

(defun c:chao()

(princ "\nChao cadviet")

(princ)

)

 

Như vậy chúng ta đã định nghĩa được một lệnh của AutoCAD mang tên chao, mỗi lần gọi lệnh chao tại dòng nhắc Command, chương trình sẽ viết ra trên màn hình text dòng chữ: Chao cadviet.

 

Trong 2 dòng vừa thêm, hàm defun là hàm định nghĩa lệnh AutoCAD. Có cấu trúc:

(defun tenham() noidungham) trong đó:

- tenham là tên hàm cần định nghĩa, nếu muốn định nghĩa một lệnh trong AutoCAD thì thêm 'C:' vào trước tên hàm.

- noidungham là tập các lệnh mà hàm vừa định nghĩa sẽ thực thi.

Hix! Mình thấy môn học này rất hay, rất bổ ích nên cũng muốn tìm hiểu thêm. Mình làm theo các bước như trên mà khi gõ lệnh "chao" tại dòng command thì ko thấy hiện lên gì cả.Các bước mình làm như sau:

-B1: Copy đoạn code:

(defun c:chao()

(princ "\nChao cadviet")

(princ)

)

sau đó paste vào phần Notepad => Save as với tên hoclisp.lsp

-B2: Vào Cad2007 => Tool\ Load Application load file hoclisp (và mình nhìn thấy dòng chữ : "hoclisp.lsp successfully loaded" ) =>Close.

-B3: Tại dòng command gõ "chao".

Mình đã thử rất nhiều lần nhưng vẫn không hiện lên chữ "Chao cadviet".Không biết có phải mình làm sai gì ko,hay là do lỗi gì đó.Mong các bạn giúp đỡ!!

[Tue_NV 3915]

Hix! Mình thấy môn học này rất hay, rất bổ ích nên cũng muốn tìm hiểu thêm. Mình làm theo các bước như trên mà khi gõ lệnh "chao" tại dòng command thì ko thấy hiện lên gì cả.Các bước mình làm như sau:

-B1: Copy đoạn code:

(defun c:chao()

(princ "\nChao cadviet")

(princ)

)

sau đó paste vào phần Notepad => Save as với tên hoclisp.lsp

-B2: Vào Cad2007 => Tool\ Load Application load file hoclisp (và mình nhìn thấy dòng chữ : "hoclisp.lsp successfully loaded" ) =>Close.

-B3: Tại dòng command gõ "chao".

Mình đã thử rất nhiều lần nhưng vẫn không hiện lên chữ "Chao cadviet".Không biết có phải mình làm sai gì ko,hay là do lỗi gì đó.Mong các bạn giúp đỡ!!

Sau khi chạy xong code -> bạn bấm phím F2 lên và nhìn dòng Command để quan sát kết quả

Hoặc là bạn chạy thu code này :

(defun c:chao()

(princ "\nChao cadviet")

(textscr)

(princ)

)

 

-> (textscr) : là hàm trả về cửa sổ AutoCAD Text Window

-> Ngược với nó là hàm (graphscr) là hàm trả về màn hình đồ họa

Về hiển thị thông báo bạn có thể dùng hàm (alert "chuổi")

ví dụ :

(defun c:chao()

(alert "\nChao cadviet")

(princ)

)

"perimeter" là gì hả a Tue_NV

"perimeter" là chu vi của đối tượng

[phamthanhbinh 3147]

Hix! Mình thấy môn học này rất hay, rất bổ ích nên cũng muốn tìm hiểu thêm. Mình làm theo các bước như trên mà khi gõ lệnh "chao" tại dòng command thì ko thấy hiện lên gì cả.Các bước mình làm như sau:

-B1: Copy đoạn code:

(defun c:chao()

(princ "\nChao cadviet")

(princ)

)

sau đó paste vào phần Notepad => Save as với tên hoclisp.lsp

-B2: Vào Cad2007 => Tool\ Load Application load file hoclisp (và mình nhìn thấy dòng chữ : "hoclisp.lsp successfully loaded" ) =>Close.

-B3: Tại dòng command gõ "chao".

Mình đã thử rất nhiều lần nhưng vẫn không hiện lên chữ "Chao cadviet".Không biết có phải mình làm sai gì ko,hay là do lỗi gì đó.Mong các bạn giúp đỡ!!

Nó có hiện đấy, nhưng là hiện trên dòng command chứ không phải trên màn hình đồ họa và sau khi gõ chữ chào, bạn phải nhấn enter nữa. Hề hề hề...

[nha_itst 0]

Kính mong A.Hoanh và mọi người có thể giải thích rõ hơn về lệnh if,While và progn và kèm theo một vài ví dụ được không?

[phamhoang158 1]

hi! thật tuyệt vời.

cảm ơn bác Hoành rất nhiều, em đang cần lập líp mà chưa biết lam thế nào cả.Nay đọc được bài của bác như cá gặp nước vậy.

Xin cảm ơn và mong bác Hoành cũng như các thành viên cadviet có sức khoẻ dồi dào và ngày càng có thêm bài viết hay chia sẻ cùng cộng đồng

[Chiron 94]

- Tôi xin thử nghiệm một chuỗi bài viết về đào tạo AutoLisp thông qua các dự án thực tế.

Xin mọi người đóng góp ý kiến.

Nhờ bác Nguyen Hoanh mà Chiron đã mót được 1 ít code lisp. Topic này và cách trình bay của bác Nguyen Hoanh quá hay, nhưng phần sau bị loãng quá và kết thúc thật đáng tiếc. Rất mong các bác tiếp tục topic này để mọi người có thêm nhiều thứ để "mót".

 

Chiron muốn hoàn thiện đoạn code này nhưng loay hoay mãi, không biết giải quyết ra sao. Đành nhờ các bác giúp vậy.

 

Lệnh Area của CAD trong vòng lặp: Nếu click chọn không có đối tượng nào CAD sẽ thông báo "Select Object:" cho đến khi nào bạn chọn 1 đối tượng.

(while (= sel nul)
  (setq sel (entsel "\nSelect object: "))
)
(setq ent (car sel))

 

Khi chọn được 1 đối tượng rồi, CAD sẽ phân loại tiếp. Nếu đối tượng có diện tích thì hiện kết quả lên màn hình, nếu đối tượng không có diện tích thì sẽ thông báo "Selected object does not have an area"

(setq ent (car (nentsel)))
 (while
(or
 	(= ent nul)
 	(not
 (member (cdr (assoc 0 (entget ent)))
'("POLYLINE" "LWPOLYLINE" "SPLINE" "CIRCLE" "HATCH")
 )
 	)
)
(prompt "\nSelected object does not have an area")
(setq ent (car (nentsel)))
 )

 

Tuy nhiên, Chiron gặp khó khăn ở chỗ không kết hợp 2 vòng lặp này giống lệnh gốc của autoCAD. Mong mọi người chỉ giúp. Cảm ơn.

[ketxu 3000]

Vòng lặp while luôn kiểm tra điều kiện sau mỗi vòng chạy. Vậy việc bạn cần làm chỉ là tạo các biến tạm làm điều kiện để điều khiển quyết định có cho while chạy nữa hay không

Mình đưa ra ví dụ khung như thế này,dđã chú thích trong code, bạn hãy thử áp dụng :

(ghi chú : code trong 1 đoạn khác với code trong cả lệnh, vì lúc đó các biến dt,sel bạn có thể đặt làm biến local, luôn bị set về nil sau khi chạy lệnh => có thể bỏ dòng (1) (2) )

 

;Khoi dong voi gia tri dt nil, neu dat trong main thi bo di (1)
(setq dt nil)
;Vong while 1 : chay cho den khi nao bien DT khac nil
(while (not dt) ;Dieu kien 1
;Vong while 2 : Ep user chon doi tuong neu chua co bien Sel
(while  (not sel) (setq sel (entsel "\nSelect object: ")))
;Sau khi co doi tuong thi lay entget cua no de kiem tra xem doi tuong co dien tich khong
(if (member (cdr (assoc 0 (entget (car sel)))) '("POLYLINE" "LWPOLYLINE" "SPLINE" "CIRCLE" "HATCH"))
 ;Neu doi tuong co dien tich thi in ra man hinh, dong thoi gan bien kiem tra DT = T, de dieu kien 1 khong thoa man => thoat vong while 1
 (progn
  (princ "Co dien tich") ;va dien tich la....
  (setq dt T)
 )
 ;Neu doi tuong khong co dien tich, in ra man hinh cau thong bao, dong thoi gan sel = Nil de vong while 2 tiep tuc chay
 (progn
  (princ "Doi tuong vua chon khong co dien tich")
  (setq sel nil)
 )
) ;End if
;Tra lai gia tri nil cho bien sel, de lan sau chay lai lenh thi vong lap 2 van chay. Neu de trong main thi bo di (2)
(setq sel nil)
) ;end while

[ngxuanphu_saigon 3]

tks bác Hoanh nhiu., e mới bắt đầu lọ mọ thôi!

mà e load thì cad báo successfully nhưng k thấy j trên màn hình hết là sao ah?

[Doan Van Ha 3209]

Nhờ bác Nguyen Hoanh mà Chiron đã mót được 1 ít code lisp. Topic này và cách trình bay của bác Nguyen Hoanh quá hay, nhưng phần sau bị loãng quá và kết thúc thật đáng tiếc. Rất mong các bác tiếp tục topic này để mọi người có thêm nhiều thứ để "mót".

Chiron muốn hoàn thiện đoạn code này nhưng loay hoay mãi, không biết giải quyết ra sao. Đành nhờ các bác giúp vậy.

Lệnh Area của CAD trong vòng lặp: Nếu click chọn không có đối tượng nào CAD sẽ thông báo "Select Object:" cho đến khi nào bạn chọn 1 đối tượng.

Khi chọn được 1 đối tượng rồi, CAD sẽ phân loại tiếp. Nếu đối tượng có diện tích thì hiện kết quả lên màn hình, nếu đối tượng không có diện tích thì sẽ thông báo "Selected object does not have an area"

Tuy nhiên, Chiron gặp khó khăn ở chỗ không kết hợp 2 vòng lặp này giống lệnh gốc của autoCAD. Mong mọi người chỉ giúp. Cảm ơn.

Hoặc cái này:

(defun C:HA()
(while (not (progn (princ "\rSelect object...") (setq ss (ssget ":S")))))
(if
 (vlax-property-available-p (vlax-ename->vla-object (ssname ss 0)) 'area)
 (princ (strcat "\nArea = " (rtos (vlax-get (vlax-ename->vla-object (ssname ss 0)) 'Area) 2 2)))
 (princ "\nSelected object does not have an area."))
(princ))

[ketxu 3000]

Bác Hà hơi thiếu 1 chút vòng lặp nữa là nếu k có diện tích thì vẫn phải chọn tiếp ^^

Bài trên ketxu viết theo mạch của Chiron, ngoài ra còn có nhiều cách viết khác như :

Ketxu hay viết :

 

(while (not (and (setq sel (entsel "\nSelect object: "))
  		     (vl-position (cdr (assoc 0 (entget (car sel)))) '("POLYLINE" "LWPOLYLINE" "SPLINE" "CIRCLE" "HATCH"))
  	     )
       )
(princ "\nNot select or Object not have area")
(setq sel (entsel "\nSelect object: "))
)

 

 

hay như LeeMac hay viết :

 

 (while
(progn (setvar 'ERRNO 0)(setq sel (entsel "\nSelect object :"))
 	(cond
   	( (= 7 (getvar 'ERRNO))
     	(princ "\nMissed, Try again.")
   	)
   	( (eq 'STR (type sel))
     	nil
   	)
   	( (vl-consp sel)
     	(if (not (member (cdr (assoc 0 (entget (car sel)))) '("POLYLINE" "LWPOLYLINE" "SPLINE" "CIRCLE" "HATCH")))
       	(princ "\nInvalid Object Selected. It hasn't area !")
     	)
   	)
 	)
)
 )

 

Hoặc code của bác ĐVH bên trên nhưng thêm (ssget ":S") thành (ssget ":S" (list (cons 0 "POLYLINE,LWPOLYLINE,SPLINE,CIRCLE,HATCH")))

 

Nói chung tùy cách thức mình muốn thể hiện với người dùng, Chiron có thể tìm cách nào dễ nhớ và thích

[Doan Van Ha 3209]

Bác Hà hơi thiếu 1 chút vòng lặp nữa là nếu k có diện tích thì vẫn phải chọn tiếp ^^

Bài trên ketxu viết theo mạch của Chiron, ngoài ra còn có nhiều cách viết khác như :

Ketxu hay viết :

...

hay như LeeMac hay viết :

...

Hoặc code của bác ĐVH bên trên nhưng thêm (ssget ":S") thành (ssget ":S" (list (cons 0 "POLYLINE,LWPOLYLINE,SPLINE,CIRCLE,HATCH")))

Nói chung tùy cách thức mình muốn thể hiện với người dùng, Chiron có thể tìm cách nào dễ nhớ và thích

1). Nói chung là OK. Đọc 2 dòng trên của Chiron thì thấy chỉ lặp khi chưa chọn được obj, còn khi có obj rồi thì in area hoặc báo not area. Tuy nhiên lại còn thêm 1 dòng cuối nữa là kết hợp 2 lặp, thành ra sót. Đáng lẽ Chiron có thể y/c ngắn hơn nhưng vẫn dễ hiểu: chọn obj chừng nào có area thì in ra.

2). Bổ sung elip và region nữa chứ hè!

[Chiron 94]

Hoặc cái này:

 

Bác Hà hơi thiếu 1 chút vòng lặp nữa là nếu k có diện tích thì vẫn phải chọn tiếp ^^

Bài trên ketxu viết theo mạch của Chiron, ngoài ra còn có nhiều cách viết khác như :

Ketxu hay viết :

...

hay như LeeMac hay viết :

...

Hoặc code của bác ĐVH bên trên nhưng thêm (ssget ":S") thành (ssget ":S" (list (cons 0 "POLYLINE,LWPOLYLINE,SPLINE,CIRCLE,HATCH")))

 

Nói chung tùy cách thức mình muốn thể hiện với người dùng, Chiron có thể tìm cách nào dễ nhớ và thích

Cám ơn các bác, Chiron đang chập chững bước đi nên vẫn đang "gặm nhấm" từng dòng code.

[Chiron 94]

1). Nói chung là OK. Đọc 2 dòng trên của Chiron thì thấy chỉ lặp khi chưa chọn được obj, còn khi có obj rồi thì in area hoặc báo not area. Tuy nhiên lại còn thêm 1 dòng cuối nữa là kết hợp 2 lặp, thành ra sót. Đáng lẽ Chiron có thể y/c ngắn hơn nhưng vẫn dễ hiểu: chọn obj chừng nào có area thì in ra.

2). Bổ sung elip và region nữa chứ hè!

Thực ra Chiron đã viết và chạy ngon lành rồi, chữa cháy bằng đoạn code thứ 2 (không cần biết chọn trúng đối tượng hay không hoặc đối tượng không có diện tích là ra cùng thông báo cả), nhưng vì muốn hoàn thiện hơn và muốn học hỏi nên tiếp tục... mò :). Đây là lisp Chiron đã viết:

;;;Error Trapping Function
(defun ErrTrap (errmsg)   ; If an error (such as ESC) occurs while this command is active...
 (cond
((= errmsg "Quit / Exit abort") (princ))
((/= errmsg "Function cancelled")
(princ (strcat "\nError: " errmsg))
)
 )
 (setvar "cmdecho" oldecho)  ; Restore saved modes
 (setq *error* OldErr)   ; Restore old *error* handler
 (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:tdt (/ oldecho ent txtpnt txtht dientich)
 (setq OldErr *error*)   ;store *error*
 (setq *error* ErrTrap)  ;re-assign *error*
 (setq oldecho (getvar "cmdecho")) ;store variables
 (setvar "cmdecho" 0)   ;set variables
 (setq ent (car (nentsel)))
 (while
(or
 	(= ent nul)
 	(not
 (member (cdr (assoc 0 (entget ent)))
'("POLYLINE" "LWPOLYLINE" "SPLINE" "CIRCLE" "HATCH")
 )
 	)
)
(prompt "\nSelected object does not have an area")
(setq ent (car (nentsel)))
 )
 (command ".area" "o" ent)
 (setq dientich (getvar "area"))
 (if (= dientich nil) (exit))
 (setq txtpnt (getpoint "\nSpecify middle point of text:"))
 (setq txtht
(getdist (strcat "\nSpecify height <" (rtos (getvar "textsize") 2 2) ">: "))
 )
 (if (null txtht) (setq txtht (getvar "textsize")) )
 (command "text" "m" txtpnt txtht 0 (strcat (rtos(/ dientich 1000000) 2 2) "m2")) ;end code
 (setvar "cmdecho" oldecho)	;reset variables
 (setq *error* OldErr) 	;restore *error*
 (princ)
)