Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
hhhhgggg

Lisp ghi tọa độ rất hay mà bị lỗi!

Bởi hhhhgggg , trong AutoLisp

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

khaosat2009    11

khaosat2009
Đã đăng
Code của bạn đây. hi vọng nó đúng ý bạn.

(prompt"\n[cmd : TDN] - THONG KE TOA DO\n")
----------------------------------------------
(defun C:tdn () (prompt"\nTHONG KE TOA DO\n")
(setvar "cmdecho" 0 )
(command "Undo" "Begin")  
(setq om (getvar "osmode"))
(setq tapx '() tapy '() stt '()
     ten (getstring "\nTên Nút:"))
(if (not h) (setq h 1))
(if (not i) (setq i 1))
(setq i1  (getreal (strcat"\nSTT Nút Ðâu Tiên < " (rtos i 2 0) " >: "))
   caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >:")))
(if i1 (setq i i1))
(if caot1 (setq h caot1))
(setvar "osmode" 125)
(setq lacol (getvar "CEColor") k (- i 1))
;================================================
(While
(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))
(Progn
 (setvar "osmode" 0)
 (setq DX (getpoint (strcat"\nDiem dat text thu "(rtos (+ k 1) 2 0)"") D1)
       x   (rtos (car D1) 2 4)
       y   (rtos (cadr D1) 2 4)
TX (strcat "X:"(rtos (Car D1) 2 4))
TY (strcat "Y:"(rtos (Cadr D1) 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
 (if (>= (car DX) (car D1)) 
(progn
(setq D2 (list (+ (car DX) (* 0.5 h)) (cadr DX)))	   
   	(command "text" "BL" D2 h 0 tX)
 	(setq   TB  (textbox (entget(entlast)))
   		LC  (car TB)
  		RC  (cadr TB)
   		di  (distance LC RC)
	PT3 (polar D2 0 (+ di (* 0.6 h)))
	pt4 (list (car D2) (- (cadr D2) (* 1.35 h)))
	pt5 (list (+ (car D2) di) (- (cadr D2) (* 1.35 h)))		
	C   (polar PT3 0 (* 1.5 h))
 	);setq
 	(command "text" "F" PT4 PT5 h ty
          	 "pline" D1 DX PT3 ""
          	 "circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
          	 "circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)
          	 "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N 
          	 "CECOLOR" 8
	 "circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)
 	  );command
  (setvar "CECOLOR" lacol)
);progn
  );if
 (if (< (car DX) (car D1)) 
(progn
  (setq D2 (list (- (car DX) (* 0.5 h)) (cadr DX)))	   
 	  (command "text" "BR" D2 h 0 tx)
 	  (setq   TB  (textbox (entget(entlast)))
   		  LC  (car TB)
  		  RC  (cadr TB)
   		  di  (distance LC RC)
	  PT3 (polar D2 0 (- (+ di (* 0.6 h))))
	  pt4 (list (- (car D2) di) (- (cadr D2) (* 1.35 h)))
	  pt5 (list (car D2) (- (cadr D2) (* 1.35 h)))
	  PT6 (list (- (car PT3) (* 3 h)) (cadr PT3))
	  C   (polar PT3 0 (* 1.5 h))
 	  );setq
 	  (command "text" "F" PT4 PT5 h TY
          	   "pline" D1 DX PT3 ""
          	   "circle" (polar PT6 0 (* 1.5 h)) (* 1.5 h)
          	   "text" "m" (polar PT6 0 (* 1.5 h)) h 0 N 
          	   "CECOLOR" 8
	   "circle" (polar PT6 0 (* 1.5 h)) (* 1.35 h)
 	  );command
  (setvar "CECOLOR" lacol)
);progn
  );if
);progn
(setvar "osmode" 125)
);while
(setq i (+ k 1))
;=============================================
(setq bit (cond (bit) ("Yes")))
(initget "Yes No")
(setq	Tmp (strcat "\nXuât Bang Toa Ðô? [Yes/No] <" bit ">: ")
bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "Yes")
(progn
(setq	di (- di (* 1.7 h))
kc (* 2 di)
       PT (getpoint"\nVi tri dat bang")
   	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTCc (list (+ (* 1.5 kc) (car PTC)) (cadr PT))
     	p1 (list (car PT) (+ (cadr PT)(* 2 h)))
     	p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p2c (list (+ (* 1.5 kc) (car P2)) (cadr p2))
     	p3 (list (car p1) (+ (cadr p1)(* 2 h)))
     	p4 (list (car p2) (+ (cadr p2)(* 2 h)))
p4c (list (+ (* 1.5 kc) (car P4)) (cadr p4))
    	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))
p44 (list (+ (* kc 0.75) (car p4)) (cadr p22))
     	L1 (list (+ di (car p3))(cadr p3))
     	L2 (list (+ kc (car L1))(cadr L1))
L3 (list (+ (* 1.5 kc) (car p4)) (cadr p4))
PTB (list (+ (* 0.5 (+ (* 2 kc) (* 1.5 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))
    	n (length tapx)
    	k 0
);setq
(setvar "osmode" 0)
(command "CECOLOR" 3 "line" p1 p2c "" "line" p3 p4c "" "CECOLOR" 2
      	"text" "m" p11 h 0 "STT" 
      	"text" "m" p22 h 0 "Täa ®é X" 
      	"text" "m" p33 h 0 "Täa ®é Y"
"text" "m" p44 h 0 "Ghi chó"
      	"text" "m" pTB (* 1.3 h) 0 "%%UB¶ng thèng kª täa ®é nót")    
(while (< k n) 
(setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt))
(command "CECOLOR" 2
 "text" "m" PTD h 0 tstt 
        "text" "m" PTX h 0 xx 
        "text" "m" PTY h 0 yy
 "CECOLOR" 3 
        "line" PT PTCc "")    
(setq 	PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTCc (list (+ (* 1.5 kc) (car ptc)) (cadr ptc))
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))
L33 (list (+ (* 1.5 kc) (car PTC)) (cadr PTC)) 
);setq
);if
(command "CECOLOR" 3 
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 ""
"line" L3 L33 "")
);progn
);if
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(prompt"\n[TDN - THONG KE TOA DO] by Thaistreetz - huuthais@yahoo.com\n")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
);DONG toado

Cám ơn Bạn.

Qua Lisp bạn đã giúp mình thực hiện rất tốt trong công việc.

Xin nhờ bạn giúp cho thêm các cột của Lisp trên, như sau :

À, mục đích là thống kê các điểm cũa các đỉnh đường trong giao thông.

Xuất ra bảng thống kê giao thông, gồm :

----------------------------

stt - tên điểm - Tên đường - toạ độ X - Toạ độ Y - Cao độ Tự nhiên - Cao độ Thiết kế - Chiều dài Cạnh - Ghi chú.

----------------------------

Trên bảng tọa độ trên, thì khi thực hiện ta chọn lần lược theo cạnh, Điểm 1 và điểm 2 ( trong qúa trình chọn điểm này sẻ ghi tên điểm tùy ý ) , kết thúc việc đánh dấu điểm chọn 1 cạnh, yêu cầu nhập tên đường, CDTN,CDTK, xong ........>> xuất ra bảng theo các nội dung ở trên và kẻ khung kết thúc cạnh 1.

Và chọn tiếp cạnh 2, thực hiện như trước....> xuất kết qủa nối vào bảng trên.

Rất mong được Bạn giúp.

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

Thaistreetz    539

Thaistreetz
Đã đăng
Cám ơn Bạn.

Qua Lisp bạn đã giúp mình thực hiện rất tốt trong công việc.

Xin nhờ bạn giúp cho thêm các cột của Lisp trên, như sau :

À, mục đích là thống kê các điểm cũa các đỉnh đường trong giao thông.

Xuất ra bảng thống kê giao thông, gồm :

----------------------------

stt - tên điểm - Tên đường - toạ độ X - Toạ độ Y - Cao độ Tự nhiên - Cao độ Thiết kế - Chiều dài Cạnh - Ghi chú.

----------------------------

Trên bảng tọa độ trên, thì khi thực hiện ta chọn lần lược theo cạnh, Điểm 1 và điểm 2 ( trong qúa trình chọn điểm này sẻ ghi tên điểm tùy ý ) , kết thúc việc đánh dấu điểm chọn 1 cạnh, yêu cầu nhập tên đường, CDTN,CDTK, xong ........>> xuất ra bảng theo các nội dung ở trên và kẻ khung kết thúc cạnh 1.

Và chọn tiếp cạnh 2, thực hiện như trước....> xuất kết qủa nối vào bảng trên.

Rất mong được Bạn giúp.

Bạn up một bản vẽ của bạn lên cho mình xem đi. trong đó kẻ luôn định dạng bảng thống kê bạn muốn. Mình sẽ viết theo những gì bạn vẽ. đọc yêu cầu thế này mình khó hình dung quá :s_big:

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

khaosat2009    11

khaosat2009
Đã đăng
Bạn up một bản vẽ của bạn lên cho mình xem đi. trong đó kẻ luôn định dạng bảng thống kê bạn muốn. Mình sẽ viết theo những gì bạn vẽ. đọc yêu cầu thế này mình khó hình dung quá :s_big:

mình đang làm công việc về QH giao thông, cho nên việc thống kê các yếu tố về giao thông Rất cần các bảng như bạn xây dựng đã viết Lisp trên, Chủ yếu cạnh các đỉnh đường, toạ độ, ghi chú.... của các bảng,

http://www.cadviet.com/upfiles/2/thong_ke_..._giao_thong.rar

Mong được Bạn giúp

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

Thaistreetz    539

Thaistreetz
Đã đăng
Xuất ra bảng thống kê giao thông, gồm :

----------------------------

stt - tên điểm - Tên đường - toạ độ X - Toạ độ Y - Cao độ Tự nhiên - Cao độ Thiết kế - Chiều dài Cạnh - Ghi chú.

----------------------------

Trên bảng tọa độ trên, thì khi thực hiện ta chọn lần lược theo cạnh, Điểm 1 và điểm 2 ( trong qúa trình chọn điểm này sẻ ghi tên điểm tùy ý ) , kết thúc việc đánh dấu điểm chọn 1 cạnh, yêu cầu nhập tên đường, CDTN,CDTK, xong ........>> xuất ra bảng theo các nội dung ở trên và kẻ khung kết thúc cạnh 1.

Và chọn tiếp cạnh 2, thực hiện như trước....> xuất kết qủa nối vào bảng trên.

Yêu cầu trên của bạn và bản vẽ bạn up không giống nhau một chút nào. Mình chịu thua :s_big:

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

toai    1

toai
Đã đăng

Nhờ bạn Thaistreet và ACE trên CadViet viết bổ sung thêm chức năng sau khi ghi tọa độ ra bản vẽ, lisp sẽ xuất các số liệu tọa độ sang Excel hoặc Notepad thì những người được "hưởng lợi" như tôi sẽ không phải apload thêm 1 lisp nữa khi làm việc bằng sản phẩm này.(Cụ thể là thêm:"Xuất số liệu sang Excel", chọn "Y" hoặc "N"

http://www.cadviet.com/upfiles/3/21668_kiem_tra_toa_do_diemtdn.lsp.

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

Minh Kiên    0

Minh Kiên
Đã đăng

 

Code của bạn đây. hi vọng nó đúng ý bạn.

(prompt"\n[cmd : TDN] - THONG KE TOA DO\n")----------------------------------------------(defun C:tdn () (prompt"\nTHONG KE TOA DO\n")(setvar "cmdecho" 0 )(command "Undo" "Begin")  (setq om (getvar "osmode"))(setq tapx '() tapy '() stt '()      ten (getstring "\nTên Nút:"))(if (not h) (setq h 1))(if (not i) (setq i 1))(setq i1  (getreal (strcat"\nSTT Nút Ðâu Tiên < " (rtos i 2 0) " >: "))    caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >:")))(if i1 (setq i i1))(if caot1 (setq h caot1))(setvar "osmode" 125)(setq lacol (getvar "CEColor") k (- i 1));================================================(While(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))(Progn  (setvar "osmode" 0)  (setq DX (getpoint (strcat"\nDiem dat text thu "(rtos (+ k 1) 2 0)"") D1)        x   (rtos (car D1) 2 4)        y   (rtos (cadr D1) 2 4)	TX (strcat "X:"(rtos (Car D1) 2 4))	TY (strcat "Y:"(rtos (Cadr D1) 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  (if (>= (car DX) (car D1)) 	(progn	(setq D2 (list (+ (car DX) (* 0.5 h)) (cadr DX)))	       	(command "text" "BL" D2 h 0 tX)  	(setq   TB  (textbox (entget(entlast)))    		LC  (car TB)   		RC  (cadr TB)    		di  (distance LC RC)		PT3 (polar D2 0 (+ di (* 0.6 h)))		pt4 (list (car D2) (- (cadr D2) (* 1.35 h)))		pt5 (list (+ (car D2) di) (- (cadr D2) (* 1.35 h)))				C   (polar PT3 0 (* 1.5 h))  	);setq  	(command "text" "F" PT4 PT5 h ty           	 "pline" D1 DX PT3 ""           	 "circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)           	 "circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)           	 "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N            	 "CECOLOR" 8		 "circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)  	  );command	  (setvar "CECOLOR" lacol)	);progn   );if  (if (< (car DX) (car D1)) 	(progn	  (setq D2 (list (- (car DX) (* 0.5 h)) (cadr DX)))	     	  (command "text" "BR" D2 h 0 tx)  	  (setq   TB  (textbox (entget(entlast)))    		  LC  (car TB)   		  RC  (cadr TB)    		  di  (distance LC RC)		  PT3 (polar D2 0 (- (+ di (* 0.6 h))))		  pt4 (list (- (car D2) di) (- (cadr D2) (* 1.35 h)))		  pt5 (list (car D2) (- (cadr D2) (* 1.35 h)))		  PT6 (list (- (car PT3) (* 3 h)) (cadr PT3))		  C   (polar PT3 0 (* 1.5 h))  	  );setq  	  (command "text" "F" PT4 PT5 h TY           	   "pline" D1 DX PT3 ""           	   "circle" (polar PT6 0 (* 1.5 h)) (* 1.5 h)           	   "text" "m" (polar PT6 0 (* 1.5 h)) h 0 N            	   "CECOLOR" 8		   "circle" (polar PT6 0 (* 1.5 h)) (* 1.35 h)  	  );command	  (setvar "CECOLOR" lacol)	);progn   );if);progn(setvar "osmode" 125));while(setq i (+ k 1));=============================================(setq bit (cond (bit) ("Yes")))(initget "Yes No")(setq	Tmp (strcat "\nXuât Bang Toa Ðô? [Yes/No] <" bit ">: ")	bit (cond ((getkword Tmp)) (bit)))(if (eq bit "Yes")(progn(setq	di (- di (* 1.7 h))	kc (* 2 di)        PT (getpoint"\nVi tri dat bang")    	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))	PTCc (list (+ (* 1.5 kc) (car PTC)) (cadr PT))      	p1 (list (car PT) (+ (cadr PT)(* 2 h)))      	p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))	p2c (list (+ (* 1.5 kc) (car P2)) (cadr p2))      	p3 (list (car p1) (+ (cadr p1)(* 2 h)))      	p4 (list (car p2) (+ (cadr p2)(* 2 h)))	p4c (list (+ (* 1.5 kc) (car P4)) (cadr p4))     	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))	p44 (list (+ (* kc 0.75) (car p4)) (cadr p22))      	L1 (list (+ di (car p3))(cadr p3))      	L2 (list (+ kc (car L1))(cadr L1))	L3 (list (+ (* 1.5 kc) (car p4)) (cadr p4))	PTB (list (+ (* 0.5 (+ (* 2 kc) (* 1.5 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))     	n (length tapx)     	k 0);setq(setvar "osmode" 0)(command "CECOLOR" 3 "line" p1 p2c "" "line" p3 p4c "" "CECOLOR" 2       	"text" "m" p11 h 0 "STT"        	"text" "m" p22 h 0 "Täa ®é X"        	"text" "m" p33 h 0 "Täa ®é Y"	"text" "m" p44 h 0 "Ghi chó"       	"text" "m" pTB (* 1.3 h) 0 "%¶ng thèng kª täa ®é nót")    (while (< k n) (setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt))(command "CECOLOR" 2	 "text" "m" PTD h 0 tstt          "text" "m" PTX h 0 xx          "text" "m" PTY h 0 yy	 "CECOLOR" 3          "line" PT PTCc "")    (setq 	PT (list (car PT) (- (cadr PT)(* 2 h)))	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))	PTCc (list (+ (* 1.5 kc) (car ptc)) (cadr ptc))	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))	L33 (list (+ (* 1.5 kc) (car PTC)) (cadr PTC)) );setq);if(command "CECOLOR" 3 	"line" p3 PT ""	"line" p4 PTC ""	"line" L1 L11 ""	"line" L2 L22 ""	"line" L3 L33 ""));progn);if(setvar "CECOLOR" lacol)(setvar "osmode" om)(prompt"\n[TDN - THONG KE TOA DO] by Thaistreetz - huuthais@yahoo.com\n")(command "Undo" "End")(setvar "cmdecho" 1)(princ));DONG toado

Chào bạn,mình đã tìm kiếm trên diễn đàn mấy ngày nay và thấy cái lisp về toạ độ này gần với mong muốn của mình nhất nhưng vẫn còn một vài điểm vẫn chưa đúng lắm bạn có thể chỉnh giúp mình được không:

+Sau khi gõ lệnh: nó sẽ hỏi thêm chọn gốc toạ độ  /chiều cao text/tên nút tự động/số tt/

+Chọn điểm lấy toạ độ (nếu có thể chọn theo cung tròn hay đường tròn để lấy tâm và đường kính sau này xuất ra bảng thì tốt quá) /chọn điểm đặt mà không cần chọn góc nghiêng / tương tự các điểm khác.

+Xuất và đặt bảng toạ độ ra màn hình.OK

+Tại đầu của đường thẳng chỉ vào toạ độ đang lấy có mũi tên hoặc dấu chấm (bằng chiều cao chữ đã chọn) ; phần thập phân của x,y lấy tròn đến chữ số phần trăm (0.01)và x,y này có thể liên kết với điểm tâm (đối tượng chọn để lấy điểm) tránh trường hợp khi update điểm hoặc di chuyển vị trí mà toạ độ không đổi.

Mình rất mong sự phản hồi của bạn,cảm ơn bạn đã tạo ra lisp này.

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

namgiangduy89    19

namgiangduy89
Đã đăng

Hi vọng bạn đã hài lòng với code này.

- Cho phép lựa chọn ghi tên điểm tọa độ tự động (giống lisp trước) hay thủ công (Pick chuột vào text có sẵn - tên cọc trên tuyến chẳng hạn)

- Cho phép ghi text tọa độ theo một góc xiên bất kỳ

- Cho phép lựa chọn có xuất bảng tọa độ hay không.

 

(prompt"\n[cmd : TDN] - THONG KE TOA DO by Thaistreetz - huuthais@yahoo.com\n")
----------------------------------------------
(defun C:tdn ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 2) " >:")))
(if caot1 (setq h caot1))
(setq tapx '() tapy '() stt '())

(setq bit1 (cond (bit1) ("Yes")))
(initget "Yes No")
(setq Tmp1 (strcat "\nTu dong ghi ten nut? [Yes/No] <" bit1 ">: ")
bit1 (cond ((getkword Tmp1)) (bit1)))
(if (eq bit1 "Yes")
(progn
(setq ten (getstring "\nTen Nut:"))
(if (not i) (setq i 1))
(setq i1 (getreal (strcat"\nSTT cua nut bat dau < " (rtos i 2 0) " >: ")))
(if i1 (setq i i1))

(setvar "osmode" 125)
(setq lacol (getvar "CEColor") k (- i 1))
(While
(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))
(Progn
(setvar "osmode" 0)
(setq DX (getpoint (strcat"\nDiem dat text thu "(rtos (+ k 1) 2 0)"") D1)
DY (getpoint (strcat"\nHuong goc nghieng cua text "(rtos (+ k 1) 2 0)"") Dx)
angr (angle Dx Dy)
angd (/ (* 180 angr) pi)
x (rtos (car D1) 2 4)
y (rtos (cadr D1) 2 4)
TX (strcat "X:"(rtos (Car D1) 2 4))
TY (strcat "Y:"(rtos (Cadr D1) 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
(if (>= (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 h)))
(command "text" "BL" D2 h angd tX)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 angr (+ di (* 0.4 h)))
pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 h))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h ty
"pline" D1 DX PT3 ""
"circle" (polar PT3 angr (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT3 angr (* 1.5 h)) h angd N
"CECOLOR" 8
"circle" (polar PT3 angr (* 1.5 h)) (* 1.35 h)
);command
(setvar "CECOLOR" lacol)
);progn
);if
(if (< (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 h)))
(command "text" "BR" D2 h (+ angd 180) tx)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 angr (+ di (* 0.4 h)))
pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 h))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT5 PT4 h TY
"pline" D1 DX PT3 ""
"circle" (polar PT3 angr (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT3 angr (* 1.5 h)) h (+ angd 180) N
"CECOLOR" 8
"circle" (polar PT3 angr (* 1.5 h)) (* 1.35 h)
);command
(setvar "CECOLOR" lacol)
);progn
);if
);progn
(setvar "osmode" 125)
);while
(setq i (+ k 1))
);progn
);if
(if (eq bit1 "No")
(progn
(setvar "osmode" 125)
(setq lacol (getvar "CEColor") i 1 k (- i 1))
(While
(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))
(Progn
(setvar "osmode" om)
(progn
(setq LOOP T)
(while (= LOOP T)
(while (null (setq ten (nentsel "\nChon mot text lam ten nut: ")))
(princ "\nChua tim thay doi tuong la text, chon lai !"));while
(setq Source_text (entget (car ten)))
(if (or (= (cdr (assoc '0 Source_text)) "TEXT")
(= (cdr (assoc '0 Source_text)) "MTEXT")
(= (cdr (assoc '0 Source_text)) "ATTRIB"));or
(progn
(setq N (cdr (assoc 1 Source_text)))
(setq LOOP nil));progn
(progn
(princ "Phai chon mot text lam ten nut !")
(setq LOOP T));progn
)if
);while
);progn
(setvar "osmode" 0)
(setq DX (getpoint (strcat"\nDiem dat text cua nut "N"") D1)
DY (getpoint (strcat"\nHuong goc nghieng cua text") Dx)
angr (angle Dx Dy))
(setq angd (/ (* 180 angr) pi)
x (rtos (car D1) 2 4)
y (rtos (cadr D1) 2 4)
TX (strcat "X:"(rtos (Car D1) 2 4))
TY (strcat "Y:"(rtos (Cadr D1) 2 4))
tapx (append tapx (list x))
tapy (append tapy (list y))
k (+ 1 k)
stt (append stt (list N))
);setq
(if (>= (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 h)))
(command "text" "BL" D2 h angd tX)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 angr (+ di (* 0.4 h)))
pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 h))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h ty
"pline" D1 DX PT3 ""
"circle" (polar PT3 angr (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT3 angr (* 1.5 h)) h angd N
"CECOLOR" 8
"circle" (polar PT3 angr (* 1.5 h)) (* 1.35 h)
);command
(setvar "CECOLOR" lacol)
);progn
);if
(if (< (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 h)))
(command "text" "BR" D2 h (+ angd 180) tx)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 angr (+ di (* 0.4 h)))
pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 h))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT5 PT4 h TY
"pline" D1 DX PT3 ""
"circle" (polar PT3 angr (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT3 angr (* 1.5 h)) h (+ angd 180) N
"CECOLOR" 8
"circle" (polar PT3 angr (* 1.5 h)) (* 1.35 h)
);command
(setvar "CECOLOR" lacol)
);progn
);if
);progn
(setvar "osmode" 125)
);while
(setq i (+ k 1))
);progn
);if
(setq bit (cond (bit) ("Yes")))
(initget "Yes No")
(setq Tmp (strcat "\nXuât Bang Toa Ðô? [Yes/No] <" bit ">: ")
bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "Yes")
(progn
(setq di (- di (* 0.4 h))
kc (* 2 di)
PT (getpoint"\nVi tri dat bang")
PTC (list (+ (* 2 kc) (- di h h h h) (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) (- 0 h) (car PTD)) (cadr PTD))
PTY (list (+ kc (- h h h h) (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ (* 1.1 h) (cadr p1)))
p22 (list (+ di (/ di 2) (- 0 h) (car p11)) (- (cadr p11) (* 0.1 h)))
p33 (list (+ kc (- h h h h) (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (- 0 h h)(car L1))(cadr L1))
PTB (list (+ (- (* 2 h)) (* 0.5 (+ (* 2 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "CECOLOR" 3 "line" p1 p2 "" "line" p3 p4 "" "CECOLOR" 2
"text" "m" p11 h 0 "Tªn Nót"
"text" "m" p22 h 0 "Täa ®é X"
"text" "m" p33 h 0 "Täa ®é Y"
"text" "m" pTB (* 1.3 h) 0 "%¶ng thèng kª täa ®é nót")
(while (< k n)
(setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt))
(command "CECOLOR" 2
"text" "m" PTD h 0 tstt
"text" "m" PTX h 0 xx
"text" "m" PTY h 0 yy
"CECOLOR" 3
"line" PT PTC "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (- 0 h) (car PTD)) (cadr PTD))
PTY (list (+ kc (- h h h h) (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 h h h h) (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (- 0 h h) (car L11))(cadr L11))
);setq
);if
(command "CECOLOR" 3
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
);progn
);if
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(prompt"\n[TDN - THONG KE TOA DO] by Thaistreetz - huuthais@yahoo.com\n")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
);DONG toa do

 

Anh bổ sung dùm em vòng tròn hiện ra khi pick điểm với.thanks

  • Vote giảm 2

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
Đăng nhập để thực hiện theo  
Người theo dõi 0
Về Đầu Trang AutoLisp
×