Đến nội dung


Hình ảnh
* * * * * 1 Bình chọn

Xin Lisp xuat toa độ


  • Please log in to reply
49 replies to this topic

#21 congthangqc

congthangqc

    Chưa sử dụng CAD

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

Đã gửi 03 February 2010 - 05:39 PM

Cho mình hỏi là nếu mình muốn có mũi tên để chỉ vào điểm cần ghi toạ độ thi làm như thế nào, làm sao có thể thay đổi kích thước của mũi tên, và mình muốn là khi di chuyển tọa độ đến 1 vị trí khác thì mũi tên cũng di chuyển theo. Xin giúp đỡ, mình chân thành cám ơn!
  • 0

#22 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 23 March 2011 - 06:15 PM

Khuyên bạn: Trước khi đặt câu hỏi bạn nên thử tự tìm câu trả lời cho mình trước đã. ok?
Font sử dụng khi điền tọa độ cũng như khi thống kê bảng chính là font của textstyle đang hiện hành lúc bạn chạy lisp. không khó để nhận ra điều đó. Nếu bạn không hiển thị tốt tiếng việt trong bảng thống kê thì chuyển sang 1 textstyle khác dùng các font thuộc bảng mã TCVN3.
Về yêu cầu của bạn: mình hiểu là khi chạy lisp bạn sẽ tiến hành các bước: nhập cao text -> nhập tên mốc -> nhập chiều dài các cạnh của bảng rồi mới bắt đầu thực hiện pick truy vấn tọa độ mốc đúng không?
=> 1. quá rườm rà
=> 2. Bạn có chắc chiều dài cạnh bạn nhập không quá rộng hoặc không quá hẹp so với cao text? lisp trên đã được tính toán để text được bố trí vào bảng một cách hợp lý nhất. vì thế mình không sửa lại theo yêu cầu nhập chiều dài các cạnh của bảng nữa.
Riêng phần xuất ra file text, mình chưa bg fải làm việc với những file text chứa tọa độ điểm nên không hiểu nội dung của nó sẽ được bố trí như thế nào vì đây không fải chuyên ngành của mình. thế nên mình bó tay khoản này.

đây là lisp bạn có thể nhập tên mốc theo ý muốn của mình

;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:td (/ diem PT1 PT2 PT3 tapx tapy
x y xx yy h n di kc ten
C PT PTX PTY PTD PTC N
p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tapx '()
tapy '()
stt '()
k 0
h (getreal "\nnhap chieu cao chu:")
ten (getstring "\nNhap ten diem:"))


(while
(setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
(progn
(setq PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
x (rtos(car diem) 2 4)
y (rtos (cadr diem) 2 4)
tapx (append tapx (list x))
tapy (append tapy (list y))
k (+ 1 k)
N (strcat ten (rtos k 2 0))
stt (append stt (list N))
);setq
(setvar "osmode" 0)
(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar PT1 0 (+ di h))
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" PT2 h 0 y
"pline" diem PT1 PT3 ""
"circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )

(setvar "osmode" om)
);progn
);dong while

;tao bang thong ke
(setq kc (* 2 di)
PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ h (cadr p1)))
p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
p33 (list (+ kc (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (car L1))(cadr L1))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "line" p1 p2 ""
"text" "j" "m" p11 h 0 "STT"
"text" "j" "m" p22 h 0 "Täa ®é X"
"text" "j" "m" p33 h 0 "Täa ®é Y"
"line" p3 p4 "")

(while (< k n)
(setq xx (nth k tapx)
yy (nth k tapy)
tstt(nth k stt))
(command "text" "j" "m" PTD h 0 tstt
"text" "j" "m" PTX h 0 xx
"text" "j" "m" PTY h 0 yy
"line" PT PTC "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (car L11))(cadr L11))
);setq
);if
(command "line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado

PS: mọi người trong diễn đàn thường chỉ cần cảm ơn nhau bằng nút Thank dưới mỗi bài post bạn ạ. thế là đủ :s_dead:

Phải nói rằng lisp này rất hay. Nhưng mình nghĩ nếu cải tiến thêm: "Lisp chọn hướng(góc) nghiêng của text theo đwờng chuẩn là oke"
  • 0

#23 nguyentienthanhddksct

nguyentienthanhddksct

    biết vẽ polygon

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

Đã gửi 23 March 2011 - 10:52 PM

Cám ơn Bạn nha. khi số điểm lên đến hàng trăm thì số cấn vào vòng tròn.
Mong được bạn giúp


cho mình hỏi ben bạn ks địa chính vậy khi tính diện tích và đưa ký hiệu loại đất stt lên bằng cách nào vậy. mình thì chuyên ks về gt nhưng thỉnh thoảng có một số công trình đo địa chính nên mình cũng không giành về nó lắm. xin bạn chỉ bảo.
  • 0

Các bạn mới học LISP vào đây học và cho ý kiến nhé:

http://www.vlisp.blo...-loi-mo-au.html


#24 pgt

pgt

    biết zoom

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

Đã gửi 28 March 2011 - 11:01 AM

mình làm bên trắc địa đo đạc
mình có lisp xuất tọa độ theo tiêu chuẩn tọa độ VN2000
ai cần thì liên hệ : nguyenhaiha288@gmail.com
mình chẳng biết diễn giải ntn cho anh em hiểu ...........
  • 0

Khi chúng ta cùng nhau - Không gì là không thể
http://ytuonglamgiau.vn 14.png


#25 daubaduc

daubaduc

    Chưa sử dụng CAD

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

Đã gửi 27 April 2011 - 11:03 AM

hehe thanhs ban nhìu nhé
  • 0

#26 phuongkq

phuongkq

    biết vẽ line

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

Đã gửi 09 December 2011 - 04:54 PM

Thực ra để lấy tọa độ trên CAD xuất ra như máy đo mình cũng mày mò tự sửa được rồi. Cám ơn mọi người nhé
  • 0

#27 nttu

nttu

    biết zoom

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

Đã gửi 06 February 2012 - 11:30 AM

Command:
TD
nhap chieu cao chu:1

Nhap ten diem:q1

chon cac vi tri co toa do can ghi:Unknown command "441692.7207". Press F1 for
help.
Unknown command "1120084.7534". Press F1 for help.
Unknown command "Q11". Press F1 for help.

chon cac vi tri co toa do can ghi:Unknown command "441911.3076". Press F1 for
help.
Unknown command "1120071.2679". Press F1 for help.
Unknown command "Q12". Press F1 for help.

chon cac vi tri co toa do can ghi:

vi tri dat bang :Unknown command "STT". Press F1 for help.
Unknown command "TäA ®é X". Press F1 for help.
Unknown command "TäA ®é Y". Press F1 for help.
Unknown command "Q11". Press F1 for help.
Unknown command "441692.7207". Press F1 for help.
Unknown command "1120084.7534". Press F1 for help.
Unknown command "Q12". Press F1 for help.
Unknown command "441911.3076". Press F1 for help.
Unknown command "1120071.2679". Press F1 for help.

xong
Undo Current settings: Auto = On, Control = All, Combine = Yes, Layer = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: End



các bác xem giup em nó vị sao, hay do dùng Cad2010
  • 0

#28 nttu

nttu

    biết zoom

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

Đã gửi 06 February 2012 - 11:33 AM

;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:td (/ diem PT1 PT2 PT3 tapx tapy
x y xx yy h n di kc
C PT PTX PTY PTD PTC N
p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tapx '()
tapy '()
stt '()
k 0
h (getreal "\nnhap chieu cao chu:"))

(while
(setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
(progn
(setq PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
x (rtos(car diem) 2 4)
y (rtos (cadr diem) 2 4)
tapx (append tapx (list x))
tapy (append tapy (list y))
k (+ 1 k)
N (strcat "N" (rtos k 2 0))
stt (append stt (list N))
);setq
(setvar "osmode" 0)
(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar PT1 0 (+ di h))
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" PT2 h 0 y
"pline" diem PT1 PT3 ""
"circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )

(setvar "osmode" om)
);progn
);dong while

;tao bang thong ke
(setq kc (* 2 di)
PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ h (cadr p1)))
p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
p33 (list (+ kc (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (car L1))(cadr L1))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "line" p1 p2 ""
"text" "j" "m" p11 h 0 "STT"
"text" "j" "m" p22 h 0 "T&#228;a &#174;&#233; X"
"text" "j" "m" p33 h 0 "T&#228;a &#174;&#233; Y"
"line" p3 p4 "")

(while (< k n)
(setq xx (nth k tapx)
yy (nth k tapy)
tstt(nth k stt))
(command "text" "j" "m" PTD h 0 tstt
"text" "j" "m" PTX h 0 xx
"text" "j" "m" PTY h 0 yy
"line" PT PTC "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (car L11))(cadr L11))
);setq
);if
(command "line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado

lisp này ghi tọa độ vào mỗi điểm bạn cần kiểm tra và xuất bảng thống kê tọa độ trực tiếp ra màn hình.
Nếu bạn muốn xuất ra file excel thì mình nghĩ có nhiều cách để làm việc đó khi đã có bảng tọa độ

Command:
TD
nhap chieu cao chu:1

Nhap ten diem:q1

chon cac vi tri co toa do can ghi:Unknown command "441692.7207". Press F1 for
help.
Unknown command "1120084.7534". Press F1 for help.
Unknown command "Q11". Press F1 for help.

chon cac vi tri co toa do can ghi:Unknown command "441911.3076". Press F1 for
help.
Unknown command "1120071.2679". Press F1 for help.
Unknown command "Q12". Press F1 for help.

chon cac vi tri co toa do can ghi:

vi tri dat bang :Unknown command "STT". Press F1 for help.
Unknown command "TäA ®é X". Press F1 for help.
Unknown command "TäA ®é Y". Press F1 for help.
Unknown command "Q11". Press F1 for help.
Unknown command "441692.7207". Press F1 for help.
Unknown command "1120084.7534". Press F1 for help.
Unknown command "Q12". Press F1 for help.
Unknown command "441911.3076". Press F1 for help.
Unknown command "1120071.2679". Press F1 for help.

xong
Undo Current settings: Auto = On, Control = All, Combine = Yes, Layer = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: End




xem giúp tôi với sao không ghi ra số liệu mà toàn là giá trị 0. Tôi đang dùng AutoCad2010
  • 0

#29 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 06 February 2012 - 12:24 PM

Command:
TD
nhap chieu cao chu:1
Nhap ten diem:q1
chon cac vi tri co toa do can ghi:Unknown command "441692.7207". Press F1 for help.
...
xem giúp tôi với sao không ghi ra số liệu mà toàn là giá trị 0. Tôi đang dùng AutoCad2010

Lỗi ở đây không liên quan tới phiên bản cad, mà do các hàm (command "text"...) ở trong lisp. Lisp này đúng khi text style hiện hành có height = 0, còn lỗi khi text style hiện hành có height /= 0. Có 2 cách khắc phục:
1). Sửa lisp: cách này thì height của text có thể nhập vào hoặc được đặt trước trong text style hiện hành tuỳ theo text style hiện hành như thế nào.
2). Không sửa lisp nhưng cần chú ý trước khi dùng lệnh TD: bạn phải chọn style hiện hành có height = 0 trước khi dùng TD.
  • 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.


#30 tanphuoc1985

tanphuoc1985

    Chưa sử dụng CAD

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

Đã gửi 03 July 2014 - 02:18 PM

nhờ các anh giúp dùm e muốn xuất toạ độ điểm ra màng hình e đã dơload líp td.lsp nhưng e chay ko dược, mình phải gõ lệnh gì.


  • 0

#31 nguyenbd1

nguyenbd1

    biết lệnh text

  • Members
  • PipPipPipPip
  • 276 Bài viết
Điểm đánh giá: 13 (tàm tạm)

Đã gửi 23 August 2014 - 07:12 PM

chào anh em cadviet. tớ nhờ anh em viết dùm 1 cái lisp yêu cầu ghi tex ra destop như trên màn hình... cụ thể như sau: 

yêu cầu 1:khi gõ lisp, lisp đòi chon các kich thước như trên màn hình trên, lần lượt là 230,200,20. 

yêu câu2 : theo líp đòi nhập số lượng "1pcs" như trên màn hình

yeu cầu 3: đó là dòng thứ 3 trên màn hình, vớ 7.22 tính theo công thức m=(230*200*20*7.85)*1000000=7.22,

cối cùng chọn điểm để đặt text. chiều cao chữ là 5mm, font, và các cái khác không quan trong... rất mong sự giúp đỡ của anh em

122369_untitled_5.jpg


  • 0

#32 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 August 2014 - 07:22 PM

Nếu các bạn cần LISP dạng như này mình sẽ gửi cho.

 

https://www.youtube....bjOmUHEjuwI_ONg

 

Còn đây là 1 số LISP xuất nhập một số đối tượng.

http://www.cadviet.c...s/3/36665_4.lsp


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#33 nguyenbd1

nguyenbd1

    biết lệnh text

  • Members
  • PipPipPipPip
  • 276 Bài viết
Điểm đánh giá: 13 (tàm tạm)

Đã gửi 23 August 2014 - 08:36 PM

không phải yêu cầu vậy ban ạ. nhờ bạn xem dùm yêu cầu rõ như trên


  • 0

#34 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 23 August 2014 - 08:55 PM

Bạn nhầm Topic rồi nhé. Mình trả lời theo Topic


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#35 namvn007

namvn007

    biết vẽ line

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

Đã gửi 29 January 2015 - 12:00 AM

Chào a e diễn đàn cadviet.com

Hiện e đang cần gấp lisp td.lisp như trên nhưng có sửa chút ít.

Em muốn khi pick diểm chỉ hiện tên điểm chứ không hiện tọa độ và đường line.

Rất mong được mọi người giúp đỡ ạ!


  • 0

#36 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 29 January 2015 - 07:38 AM

Chào a e diễn đàn cadviet.com

Hiện e đang cần gấp lisp td.lisp như trên nhưng có sửa chút ít.

Em muốn khi pick diểm chỉ hiện tên điểm chứ không hiện tọa độ và đường line.

Rất mong được mọi người giúp đỡ ạ!

Xem có đúng ý bạn ko :)

(defun C:td (/ om k h ten diem N)
(command "Undo" "Be") (setvar "cmdecho" 0) (setq om (getvar "osmode"))
(setq k 0 h (getreal "\nnhap chieu cao chu:")    
ten (getstring "\nNhap ten diem:")) (while  
(setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))  
(progn (setq k (+ 1 k) N (strcat ten (rtos k 2 0))) 
(setvar "osmode" 0) 
(command "circle" diem (* 1.8 h)) 
(entmake (list (cons 0 "TEXT") (cons 40 h) (cons 50 0) (cons 10 diem) (cons 1 N) (cons 72 4) (cons 11 diem) (cons 7 (getvar "Textstyle"))))
(setvar "osmode" om)	)) ;while  
(setvar "osmode" om ) (setvar "cmdecho" 1) (command "Undo" "E")  (princ))


  • 2

#37 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 29 January 2015 - 07:40 AM

Chúc một ngày mới vui vẽ :P !


  • 0

#38 namvn007

namvn007

    biết vẽ line

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

Đã gửi 29 January 2015 - 06:01 PM

Cảm ơn anh pphung183 a chỉnh lại giúp e tý nữa không ạ. E muốn có thêm đường line chỉ dẫn ra hình tròn tên điểm. Đặt luôn tên điểm vòa chỗ pick lúc in ra hơi khó nhìn. 

Với lại khi mình pick xong hiện luôn bảng tọa độ nữa. 

Mong a giúp e với ạ


  • 0

#39 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 29 January 2015 - 08:52 PM

Ẹccc :unsure: , tức là bạn chỉ muốn bỏ tọa độ ghi trên đường dẫn thôi chứ gì :mellow: , đơn giản thôi mà đợi xí tôi chỉnh lại cho đúng với cả trường hợp có thiết lập Text height = 0 or /= 0


  • 0

#40 pphung183

pphung183

    biết dimstyle

  • Members
  • PipPipPipPipPip
  • 384 Bài viết
Điểm đánh giá: 425 (tốt)

Đã gửi 29 January 2015 - 08:56 PM

Thử lại nhé :) !

;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun textM (pt height string / lst) 
(setq lst (list '(0 . "TEXT") (cons 10 pt) (cons 40 height) (cons 1 string) (cons 50 0) (cons 72 4) (cons 11 pt) (cons 7 (getvar "Textstyle"))))
(entmakeX Lst)  )
(defun C:td (/ diem PT1 PT2 PT3 tapx tapy obj ss
		   x y xx yy h n di kc ten
		   C PT PTX PTY PTD PTC N
		   p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")  
  (setq om (getvar "osmode"))
  (setq tapx '()
	tapy '()
	stt '()
	k 0
	h (getreal "\nnhap chieu cao chu:")
	ten (getstring "\nNhap ten diem:"))
(while
  (setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
	(setq   PT1 (list (+ (* 3 h) (car diem)) (+ (* 3 h) (cadr diem)))
		PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
		 x (rtos(car diem) 2 4)
			 y (rtos (cadr diem) 2 4)
	   tapx (append tapx (list x))
	   tapy (append tapy (list y))
		 k (+ 1 k)
		 N (strcat ten (rtos k 2 0))
		stt (append stt (list N))
	  );setq
  (setvar "osmode" 0)
(setq obj (textM pt1 h x)) (setq ss (entlast)) 
;(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget ss)) 
LC (car TB) RC (cadr TB) di (distance LC RC) PT3 (polar PT1 0 (+ di h)) C (polar PT3 0 (* 1.8 h)));setq
(command "erase" ss "" "pline" diem PT1 PT3 ""
		 "circle" C (* 1.8 h))
		 (textM C h N) 
	(setvar "osmode" om)	);dong while
;tao bang thong ke
(setq	kc (* 2 di)
	PT (getpoint"\nvi tri dat bang :")
	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
	p1 (list (car PT) (+ (cadr PT)(* 2 h)))
	p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
	p3 (list (car p1) (+ (cadr p1)(* 2 h)))
	p4 (list (car p2) (+ (cadr p2)(* 2 h)))
	PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
	PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
	PTY (list (+ kc (car PTX)) (cadr PTX))
	  p11 (list (+ (/ di 2) (car p1))  (+ h (cadr p1)))
	  p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
	  p33 (list (+ kc (car p22)) (cadr p22))
	  L1 (list (+ di (car p3))(cadr p3))
	  L2 (list (+ kc (car L1))(cadr L1))
	 n (length tapx)
	 k 0);setq
(setvar "osmode" 0)
  (command "line" p1 p2 "" "line" p3 p4 "")
	   (textM p11 h "STT") ;"text" "j" "m" p11 h 0 "STT" 
	   (textM p22 h "T\U+1ECDa \U+0111\U+1ED9 X") ;"text" "j" "m" p22 h 0 "Täa ®é X"
	   (textM p33 h "T\U+1ECDa \U+0111\U+1ED9 Y") ;"text" "j" "m" p33 h 0 "Täa ®é Y"
  (while (< k n) 
	(setq xx (nth k tapx)
	  yy (nth k tapy)
	 tstt(nth k stt))
		 (textM PTD h tstt) ;"text" "j" "m" PTD h 0 tstt 
		 (textM PTX h xx) ;"text" "j" "m" PTX h 0 xx 
		 (textM PTY h yy) ;"text" "j" "m" PTY h 0 yy 
		(command "line" PT PTC "")	
	(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
		 PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
	 PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
	 PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
	 PTY (list (+ kc (car PTX)) (cadr PTX))
	  k (+ 1 k))	);while
  (if (= k n)
	(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
	  PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
	  L11 (list (+ di (car PT))(cadr PT))
	  L22 (list (+ kc (car L11))(cadr L11)))	);if
(command "line" p3 PT ""
	  "line" p4 PTC ""
	  "line" L1 L11 ""
	  "line" L2 L22 "")
(setvar "osmode" om ) (setvar "cmdecho" 1)
  (command "Undo" "End")  (princ))

  • 2