Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
vantin_pro

Xin Lisp xuat toa độ

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

phuongkq    0

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é

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
nttu    0

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

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
nttu    0

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

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

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
Doan Van Ha    2.676

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.

  • Vote tăng 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
nguyenbd1    13

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

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
thanhduan2407    226

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

 

https://www.youtube.com/watch?v=zepZQCqHd6c&list=UU9ql8psVbjOmUHEjuwI_ONg

 

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

http://www.cadviet.com/upfiles/3/36665_4.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
namvn007    0

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 đỡ ạ!

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
pphung183    425

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))

  • Vote tăng 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
namvn007    0

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 ạ

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
pphung183    425

Ẹ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

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
pphung183    425

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))
  • Vote tăng 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
namvn007    0

137168_20150129__ss1.jpgCảm ơn vì sự nhiệt tình của a rất nhiều.

A có thể cho đường line như điểm 119 được k ạ.

Đường line lisp trên hơi dài. Làm xong mình lại mất công trim

Mong sớm được sự hồi âm của a

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
pphung183    425

Lần cuố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 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 (polar diem (/ pi 1.8) (* 1.2 h))
		;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) C (polar diem (/ pi 1.8) (* 3 h)));setq
(command "erase" ss "" "pline" diem PT1 ""
		 "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))
  • Vote tăng 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
pphung183    425

- hihi nhoc nhiều chiện xíu, anh Phung chơi theo kiểu kéo tới đâu dài tới đó, kéo hướng nào đặt hướng đó, tuy hơi lâu xíu ^^

Thế thì phải thêm 1 điểm pick Nhoc ah :) , test 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 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 (getpoint diem "Nhap diem thu 2") 
		 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
(if (> (distance diem PT1) (* 1.8 h)) (setq PT2 (polar diem (angle diem PT1) (- (distance diem PT1) (* 1.8 h)))) (setq PT2 NIL))
  (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) C PT1);setq
(command "erase" ss "" "pline" diem pt2 ""
		 "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))
  • Vote tăng 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
namvn007    0

Cảm ơn a pphung183 và nhoclangbat rất nhiều. 

Có 1 vấn đề nhỏ nữa. ví dụ hôm nay mình list được 5 diểm. hôm sau mình list lại nhập tên điểm là 6. thay vì là 61 như lisp trên mà là 6, pick tiếp là 7,8....được không ạ  :)

Mong được 2 a 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
nhoclangbat    382

- sữa lại tí phụ anh P, bạn thử xem

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/12225-xin-lisp-xuat-toa-do/page-3
;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 tapx tapy obj ss
		   x y xx yy h n di kc ten k
		   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 '()
		h (getreal "\nNhap chieu cao chu:")
	ten (getstring "\nNhap ten diem:"))
	(initget 1)
	(setq k  (getint "\nNhap so thu tu diem:"))
(while
  (setq diem (getpoint "\nChon cac vi tri co toa do can ghi:"))
	(setq   PT1 (getpoint diem "Nhap diem thu 2") 
		 x (rtos(car diem) 2 4)
			 y (rtos (cadr diem) 2 4)
	   tapx (append tapx (list x))
	   tapy (append tapy (list y))
		 		 N (strcat ten (itoa k))
		stt (append stt (list N))	  );setq
(if (> (distance diem PT1) (* 1.8 h)) (setq PT2 (polar diem (angle diem PT1) (- (distance diem PT1) (* 1.8 h)))) (setq PT2 NIL))
  (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) C PT1);setq
(command "erase" ss "" "pline" diem pt2 ""
		 "circle" C (* 1.8 h))
		 (textM C h N) 
	(setvar "osmode" om)	
(setq k (1+ k))	
	);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))

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
pphung183    425

Cảm ơn a pphung183 và nhoclangbat rất nhiều. 

Có 1 vấn đề nhỏ nữa. ví dụ hôm nay mình list được 5 diểm. hôm sau mình list lại nhập tên điểm là 6. thay vì là 61 như lisp trên mà là 6, pick tiếp là 7,8....được không ạ  :)

Mong được 2 a giúp đỡ.

Hey :unsure: , nghe bạn hỏi mà tui thấy buồn :( :( :( vì kiến thức cơ bản về vòng lập While

Lisp gốc có biến k = 0, vào vòng lập là: k + 1 = 1, 2, 3, 4,5 ... tức là mỗi lần vòng lập While sẽ tăng 1 đơn vị. Suy ra nếu bạn muốn nhập tên điểm là 6 thì chỉ cần

thay k 0 thành k 5 là xong. Không thì bạn làm theo bạn Nhoc, mỗi lần chạy phải thêm dòng nhập "Nhap so thu tu diem". Vài lời chia sẻ mong bạn cập nhật kiến thức và đừng giận -_-

  • Vote tăng 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
naunong    0

 

Thế thì phải thêm 1 điểm pick Nhoc ah :) , test 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 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 (getpoint diem "Nhap diem thu 2") 
		 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
(if (> (distance diem PT1) (* 1.8 h)) (setq PT2 (polar diem (angle diem PT1) (- (distance diem PT1) (* 1.8 h)))) (setq PT2 NIL))
  (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) C PT1);setq
(command "erase" ss "" "pline" diem pt2 ""
		 "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

Bản lisp này mình thấy rất hay. Nhưng khi sử dụng mình cần đổi trục tọa đội (lệnh ucs) sang vị trí khác thì các điểm nút A1,A2... bay ra khỏi vị trí vòng tròn. Bạn phụng có thể giúp mình được không! Cảm ơn bạn nhiều!

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


×