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

Lisp ghi toạ độ điểm ra màn hình !!!

Bởi leejang , trong AutoLisp

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

ngochavn    0

ngochavn
Đã đăng

Ai giúp em cái list xuất ra cái bảng tọa độ với kích thước các cạnh ngay trong bản vẽ card được không ạ.Em tập vẽ cái bản vẽ sơ đồ nhà đất mà nó đòi có cái bảng liệt kê tọa độ VN 2000 mà em không biết làm list.Anh giúp em với.Em cám ơn nhiều 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

nhoclangbat    392

nhoclangbat
Đã đăng

hihi, có hứa với bạn ngochavn kiếm cho bạn nhưng hum nay nhoc đi đo từ sớm nên ko kịp giờ bù cho bạn hen kaka ^^

- lưu ý trước khi chạy bạn phải tạo rùi set ranh đất bạn muốn chạy tọa độ ở layer tên "ranh_38", lệnh là "toado"

(defun *error* (msg)
  (princ "error: ")
  (princ msg)
  (princ)
)

(defun Wdis (p1 p2 / dis ang point point1)
  (setq dis (distance p1 p2))
  (setq ang (angle p1 p2))
  (if (and (> ang (/ Pi 2)) (< ang (* Pi 1.5)) )
    (progn
      (setq ang (+ Ang Pi)) 
      (setq Point (polar p2 ang (/ dis 2.0)))
      (setq Point1 (polar point (+ (/ pi 2) ang) (* 0.25 (/ TileBdHT 500))))

    )
	(progn
    (setq Point (polar p1 ang (/ dis 2.0)))
    (setq Point1 (polar point (+ (/ pi 2) ang) (* 0.25 (/ TileBdHT 500))))
	)
  )
  (command "Text" "S" "vaptimn" "c" point1 (/ TileBdHT 500) (* (/ ang Pi) 180) (rtos dis 2 2) )
)
(defun ssgetLayer( La1 La2 / ss)
  (setq ss (ssget "X" (list
                         (cons -4  "<OR")  
                           (cons -4  "<AND")  
                             (cons 8 La1)  
                             (cons 0  "LWPOLYLINE")
                           (cons -4  "AND>")  
                           (cons -4  "<AND")  
                             (cons 8 La1)  
                             (cons 0  "LINE")
                           (cons -4  "AND>")  
                           (cons -4  "<AND")  
                             (cons 8 La2)  
                             (cons 0  "LWPOLYLINE")
                           (cons -4  "AND>")  
                           (cons -4  "<AND")  
                             (cons 8 La2)  
                             (cons 0  "LINE")
                           (cons -4  "AND>")  
                         (cons -4  "OR>")  
                       )
  ))
  ss
)
(defun pointpl (name t2 k / namem i bien t1 p1 diem)
	(setq namem name)
	(setq i 1)
	(while (<= i k)
	(progn
		(setq bien (assoc t2 namem))
		(setq t1 (member bien namem))
		(setq p1 (car t1))
		(setq namem (cdr t1))
		(setq diem (cdr p1))
		(setq i (+ 1 i))
	)
	)
	diem
)
(defun c:Toado( / i k luuxy st p xoa)
	(setvar "cmdecho" 0)
	(setq st (ssgetLayer "Ranh_toado" "Ranh_38") )
	(if (/= st  nil)
(progn
	(if (null (tblsearch "style" "vaptimn"))
		(command "style" "vaptimn" "vni-avo" "" "" "" "" ""))
	(if (null (tblsearch "style" "vhelveb"))
		(command "style" "vhelveb" "vni-helve" "" "" "" "" ""))
	(if (null (tblsearch "layer" "sohieu_diem"))
		(command "_layer" "n" "sohieu_diem" ""))
	(command "_layer" "c" "2" "sohieu_diem" "")
	(if (null (tblsearch "layer" "canh"))
		(command "_layer" "n" "canh" ""))
	(command "_layer" "c" "3" "canh" "")
	(if (null (tblsearch "layer" "bang_toado"))
		(command "_layer" "n" "bang_toado" ""))
	(command "_layer" "c" "7" "bang_toado" "")
	(command "_layer" "c" "6" "Ranh_38" "")
	(command "_layer" "c" "6" "Ranh_toado" "")
	(if (null (tblsearch "layer" "Polygon"))
		(command "_layer" "n" "Polygon" ""))
	(command "_layer" "c" "8" "Polygon" "")
	(if (not r1) (setq r1 500))
	(setq TileBdHT (getreal (strcat "\nMau So Ti Le Cua BDHT" "(" (rtos r1 2 0) "):")))
	(if (= TileBdHT nil)
		(setq TileBdHT r1))
	

	(setvar "blipmode" 0)
	(setq old (getvar "osmode"))
	(setvar "osmode" 0)
	(setq p (getpoint "\n Pick"))
	(command "_layer" "s" "Polygon" "")
	(if (/= p nil)
		(command "-Boundary" "a" "b" "n" st "" "" p "" )
	)
	(setq luuxy (entget (entlast)))
	(setq pt (getpoint "\n Diem dat bang toa do :"))
	;(entdel (entlast))
	(setq k (cdr (assoc 90 luuxy)))
	(if (/= pt nil)
		(progn
			(setq p01 pt)
			(setq p02 (mapcar '+ pt '(10.0  0.0 0.0)))
			(setq p03 (mapcar '+ pt '(22.5 -2.5 0.0)))
			(setq p04 (mapcar '+ pt '(35.0  0.0 0.0)))
			(setq p05 (mapcar '+ pt '(45.0  0.0 0.0)))
			(setq p06 (mapcar '+ pt '(0.0 -5.0 0.0)))
			(setq p07 (mapcar '+ pt '(10.0 -2.5 0.0)))
			(setq p08 (mapcar '+ pt '(35.0 -2.5 0.0)))
			(setq p09 (mapcar '+ pt '(45.0 -5.0 0.0)))
			(if (<= k 10)			
				(progn
					(setq p10 (mapcar '+ pt '(0.0 -40.0 0.0)))
					(setq p11 (mapcar '+ pt '(10.0 -40.0 0.0)))
					(setq p12 (mapcar '+ pt '(22.5 -40.0 0.0)))
					(setq p13 (mapcar '+ pt '(35.0 -40.0 0.0)))
					(setq p14 (mapcar '+ pt '(45.0 -40.0 0.0)))
				)
				(progn
					(setq ty (* -1 (+ 10.0 (* k 3))))
					(setq t0 (list 0.0 ty 0.0))
					(setq t1 (list 10.0 ty 0.0))
					(setq t2 (list 22.5 ty 0.0))
					(setq t3 (list 35.0 ty 0.0))
					(setq t4 (list 45.0 ty 0.0))
					(setq p10 (mapcar '+ pt t0))
					(setq p11 (mapcar '+ pt t1))
					(setq p12 (mapcar '+ pt t2))
					(setq p13 (mapcar '+ pt t3))
					(setq p14 (mapcar '+ pt t4))
				)
			)
			(command "layer" "s" "bang_toado" "")
			(command "Line" p01 p05 "")
			(command "Line" p01 p10 "")
			(command "Line" p02 p11 "")
			(command "Line" p03 p12 "")
			(command "Line" p04 p13 "")
			(command "Line" p05 p14 "")
			(command "Line" p07 p08 "")
			(command "Line" p06 p09 "")
			(command "Line" p10 p14 "")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ pt '(22.5 2.0 0.0)) 1.25 0 "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ pt '(5.0 -1.5 0.0)) 1.15 0 "Soá hieäu")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ pt '(5.0 -3.5 0.0)) 1.15 0 "ñieåm")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ pt '(22.5 -1.25 0.0)) 1.15 0 "Toïa ñoä")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ pt '(16.25 -3.75 0.0)) 1.15 0 "X(m)")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ pt '(28.75 -3.75 0.0)) 1.25 0 "Y(m)")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ pt '(40.0 -2.5 0.0)) 1.25 0 "Caïnh")
		)
	)
	(setq i 1)
	(while (<= i k)
		(progn
			(setq toado (pointpl luuxy 10 i))
			(setq x (rtos (car toado) 2 2))
			(setq y (rtos (cadr toado) 2 2))
			(command "layer" "s" "sohieu_diem" "")
			(setq doi (list (* 0.2 (/ TileBdHT 500)) (* 0.2 (/ TileBdHT 500)) 0.0))
			(command "Text" "S" "vaptimn" (mapcar '+ toado doi) (/ TileBdHT 500) 0 i)
			(command ".donut" 0 (* 0.25 (/ TileBdHT 500)) toado "")			
			(setq tsh (list 5.0 (- (* -3 i) 4.5) 0.0))
			(setq txx (list 16.25 (- (* -3 i) 4.5) 0.0))
			(setq tyy (list 28.75 (- (* -3 i) 4.5) 0.0))
			(setq tgc (list 40.0 (- (* -3 i) 3.0) 0.0))
			(setq psh (mapcar '+ pt tsh))
			(setq pxx (mapcar '+ pt txx))
			(setq pyy (mapcar '+ pt tyy))
			(setq pgc (mapcar '+ pt tgc))
			(if (= i 1)
				(progn
					(setq toado1 toado)
					(setq x1 (rtos (car toado1) 2 2))
					(setq y1 (rtos (cadr toado1) 2 2))
				)
			)
			(if (>= i 2)
(progn
	(setq canh (distance toado0 toado))
	(command "layer" "s" "bang_toado" "")
	(command "Text" "S" "vaptimn" "j" "M" pgc 1.2 0 (rtos canh 2 2) )
	(command "layer" "s" "canh" "")
	(wdis toado0 toado)
)
			)
			(command "layer" "s" "bang_toado" "")
			(command "Text" "S" "vaptimn" "j" "M" psh 1.2 0 i)
			(command "Text" "S" "vaptimn" "j" "M" pxx 1.2 0 y)
			(command "Text" "S" "vaptimn" "j" "M" pyy 1.2 0 x)
			(setq toado0 toado)
			(setq i (+ i 1))
		)
	)
	(command "layer" "s" "canh" "")
	(wdis toado toado1)
	(setq canh (distance toado toado1))
			(setq tsh (list 5.0 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq txx (list 16.25 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq tyy (list 28.75 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq tgc (list 40.0 (- (* -3 (+ k 1)) 3.0) 0.0))
			(setq psh (mapcar '+ pt tsh))
			(setq pxx (mapcar '+ pt txx))
			(setq pyy (mapcar '+ pt tyy))
			(setq pgc (mapcar '+ pt tgc))
	(command "layer" "s" "bang_toado" "")
	(command "Text" "S" "vaptimn" "j" "M" pgc 1.2 0 (rtos canh 2 2) )
	(command "Text" "S" "vaptimn" "j" "M" psh 1.2 0 "1")
	(command "Text" "S" "vaptimn" "j" "M" pxx 1.2 0 y1)
	(command "Text" "S" "vaptimn" "j" "M" pyy 1.2 0 x1)
	(setvar "osmode" old)
)	;(end progn)
)	;(end if)
	(if (= st nil)
	(progn
		(setvar "cmdecho" 1)
		(princ "Khong co layer Ranh_toado")
	)
	)
	(command "_layer" "s" "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

vumanhdung1987    0

vumanhdung1987
Đã đăng

Mình có 5 cái:

- Xuất ra màn hình

- Xuất ra bảng

- Xuất ra .txt

- Xuất ra excel (đang tìm vì lâu rồi ko dùng đến nên không biết tên lisp là gì nữa)

- Xuất ra word (đang tìm vì lâu rồi ko dùng đến nên không biết tên lisp là gì nữa)

114123_untitled_9.gif

Anh bạn gửi cho mình xin nữa, dowload không được. "vumanhdung1987@gmail.com" . Thanks

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

trinhhoanghieu090    29

trinhhoanghieu090
Đã đăng 

(defun C:cxy ()
(setvar "cmdecho" 0)
(setq h (getreal "\n Nhap chieu cao Text< 5 >: "))
(if (= h nil)  (Setq h 5 ))
(setq pt1 (getpoint "\n Pick diem can lay toa do: "))
(if pt1
(progn
(setq pt2 (getpoint pt1 "\n Pick diem ghi toa do: "))
(if pt2
(progn
(setq txtx (strcat "X = " (rtos (car pt1) 2 2) " m"))
(setq txty (strcat "Y= " (rtos (cadr pt1) 2 2)" m"))
(command "Mtext" pt2 "h" h pt2 txtx txty "")
)
)
)
)
(setvar "cmdecho" 1)
(princ)
)

Chào các cao thủ Lisper, sau một hồi mày mò và tìm hiểu trên diễn đàn em cũng cho ra lò được cái lisp ghi tọa độ như trên. Có thể nói là dùng cũng tạm được, nhưng em muốn các bác chỉ giáo cho em để hoàn thiện hơn. Trong đoạn code:

 

(setq h (getreal "\n Nhap chieu cao Text< 5 >: "))

(if (= h nil) (Setq h 5 )

 

thay vì nếu khi nhập chiều cao text để mặc định là 5 thì em muốn nó lấy giá trị mình vừa nhập vào lúc trước khi sử dụng lisp này. ví dụ như trong trường hợp mình dùng lệnh liên tục, gọi lisp lần đầu mình nhập vào là 100 hay bất kỳ giá trị nào khác lặp lại các lần sau nó gán cho bằng giá trị đó luôn chỉ phải bấm enter không phải gõ lại nữa. thanks

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    392

nhoclangbat
Đã đăng

- ah sr nhoc ko nói kỹ ^^, biến chính truyền tham số cho heighttext là h1 mới đúng ^^, tại nhoc giữ nguyên biến nhập là h của bạn ^^, bạn mún biến truyền chính là h thì chỉ cần đảo tên biến lại là đc, đó là cách sử dụng biến phụ, còn  cách khác ko cần sử dụng biến phụ nó như thế này nhưng hơi dài xíu ^^

(or h (setq h 5.0))
(setq h 
   (cond 
      ((getreal (strcat "\nBan nhap cao text (" (rtos h 2 0) ") :")))
	    (h)
	)
	)

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    272

thanhduan2407
Đã đăng 


(defun C:cxy ( / pt1 pt2 txtx txty)

(setvar "cmdecho" 0)

(or *chieucao* (setq *chieucao* 1))

(setq chieucao (getreal (strcat "\n Chieu cao text <"

			  (rtos *chieucao* 2 2)

			 "> :"

		  )

	 )

)

(if (not chieucao) (setq chieucao *chieucao*) (setq *chieucao* chieucao))

(setq pt1 (getpoint "\n Pick diem can lay toa do: "))

(if pt1

	(progn

		(setq pt2 (getpoint pt1 "\n Pick diem ghi toa do: "))

		(if pt2

			(progn

				(setq txtx (strcat "X = " (rtos (car pt1) 2 2) " m"))

				(setq txty (strcat "Y= " (rtos (cadr pt1) 2 2)" m"))

				(command "Mtext" pt2 "h" chieucao pt2 txtx txty "")

			)

		)

	)

)

(setvar "cmdecho" 1)

(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    428

pphung183
Đã đăng

Lisp này cũng chưa hoàn chỉnh nếu Text Style có Height <> 0, lúc đó nó sẽ lấy Chieu cao text = Height của Text Style hiện hành :D

  • 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

Doan Van Ha    3.191

Doan Van Ha
Đã đăng

Lisp này cũng chưa hoàn chỉnh nếu Text Style có Height <> 0, lúc đó nó sẽ lấy Chieu cao text = Height của Text Style hiện hành :D

Vì sao vậy 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

phamthe    1

phamthe
Đã đăng

 

Đây!

(defun c:pt (/ p lst fn pw)
 (while (setq p (getpoint "\nPick Point: "))
  (setq lst (cons p lst)))
 (setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 (setq pw (open fn "w"))
 (write-line "Y,X" pw)
 (foreach p (reverse lst)
  (write-line (strcat (rtos (cadr p) 2 2) "," (rtos (car p) 2 2)) pw))
 (close pw)
 (princ))

Nhờ các bác giúp thêm phần số thứ tự tăng dần khi pick để xuất sang Excel có thêm cột thứ tự 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

Doan Van Ha    3.191

Doan Van Ha
Đã đăng

Thêm STT đây!

 

(defun c:pt (/ p lst fn pw n)
 (while (setq p (getpoint "\nPick Point: "))
  (setq lst (cons p lst)))
 (setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 (setq pw (open fn "w"))
 (setq n 1)
 (write-line "STT,Y,X" pw)
 (foreach p (reverse lst)
  (write-line (strcat (itoa n) "," (rtos (cadr p) 2 2) "," (rtos (car p) 2 2)) pw)
  (setq n (1+ n)))
 (close pw)
 (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

hoangkimoanh    2

hoangkimoanh
Đã đăng

 

Thêm STT đây!

(defun c:pt (/ p lst fn pw n)
 (while (setq p (getpoint "\nPick Point: "))
  (setq lst (cons p lst)))
 (setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 (setq pw (open fn "w"))
 (setq n 1)
 (write-line "STT,Y,X" pw)
 (foreach p (reverse lst)
  (write-line (strcat (itoa n) "," (rtos (cadr p) 2 2) "," (rtos (car p) 2 2)) pw)
  (setq n (1+ n)))
 (close pw)
 (princ))

nhờ anh giúp sửa để sau khi pick xong các điểm cần xuất xong là pick vị trí cần đặt bảng tọa độ trong bản vẽ được không ạ!

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

tientracdia    16

tientracdia
Đã đăng

 

Thêm STT đây!

(defun c:pt (/ p lst fn pw n)
 (while (setq p (getpoint "\nPick Point: "))
  (setq lst (cons p lst)))
 (setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 (setq pw (open fn "w"))
 (setq n 1)
 (write-line "STT,Y,X" pw)
 (foreach p (reverse lst)
  (write-line (strcat (itoa n) "," (rtos (cadr p) 2 2) "," (rtos (car p) 2 2)) pw)
  (setq n (1+ n)))
 (close pw)
 (princ))

Nhờ anh chỉnh thêm kí hiệu nút tại điểm chọn, ghi số Thứ tự, xuất ra bảng trên cad va excel. Cám ơn

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

thinh1988bd14    0

thinh1988bd14
Đã đăng (Đă chỉnh sửa)
bạn gửi lisp nay cho mình được k vậy. mình coppy về không dùng được. mail mình: tranthinh0807@gmail.com. thank

 

Chỉnh sửa theo thinh1988bd14

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

ths    1

ths
Đã đăng 
(defun C:cxy ( / pt1 pt2 txtx txty)
(setvar "cmdecho" 0)
(or *chieucao* (setq *chieucao* 1))
(setq chieucao (getreal (strcat "\n Chieu cao text <"
			  (rtos *chieucao* 2 2)
			 "> :"
		  )
	 )
)
(if (not chieucao) (setq chieucao *chieucao*) (setq *chieucao* chieucao))
(setq pt1 (getpoint "\n Pick diem can lay toa do: "))
(if pt1
	(progn
		(setq pt2 (getpoint pt1 "\n Pick diem ghi toa do: "))
		(if pt2
			(progn
				(setq txtx (strcat "X = " (rtos (car pt1) 2 2) " m"))
				(setq txty (strcat "Y= " (rtos (cadr pt1) 2 2)" m"))
				(command "Mtext" pt2 "h" chieucao pt2 txtx txty "")
			)
		)
	)
)
(setvar "cmdecho" 1)
(princ)
)

bạn ơi, làm sao để khi xuất ra màn hình, thì số hiện ra là 3 chữ số sau dấu phẩy bạn nhỉ?

  • Vote giảm 3

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
Về Đầu Trang AutoLisp
×