Chuyển đến nội dung
Diễn đàn CADViet
vantin_pro

Xin Lisp xuat toa độ

Các bài được khuyến nghị

Vào lúc 16/11/2009 tại 12:38, fbh81 đã nói:

Bác Thaistreetz ơi, lisp của bác rất hay nhưng hình như bị lỗi ở đâu đó ( kết quả thừa 1 số 1 ở đầu, ví dụ lúc nhập tên điểm định vị là 1 thì kết quả lại ra 11, 2 thì ra 12...) bác tranh thủ xem lại hộ anh em nhé.

cái đấy em nghĩ cái đó giống tiền tố đấy bá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
Vào lúc 22/7/2009 tại 19:46, Thaistreetz đã nói:

 

 


;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ä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
 

 

 

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 độ

mong anh có thể viết cho lisp này bố sung chon số chữ số thập phân  để tọa độ nó phù hợp và chọn được mũi tên tọa độ thì hay quá ạ! em cám ơn anh

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
2 giờ trước, ducnv37 đã nói:

mong anh có thể viết cho lisp này bố sung chon số chữ số thập phân  để tọa độ nó phù hợp và chọn được mũi tên tọa độ thì hay quá ạ! em cám ơn anh

x (rtos (car diem)   2 4)

y (rtos (cadr diem) 2 4)

+ Số 4 là số chữ số sau dấu phẩy. Bạn tự thay thế cho phù hợp!  kiểu dáng mũi tên hiện tại không thể thay thế. Hết!

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

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

×