Đến nội dung


Hình ảnh
- - - - -

Listp bảng tọa độ vn2000


  • Please log in to reply
86 replies to this topic

#1 ngochavn

ngochavn

    Chưa sử dụng CAD

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

Đã gửi 01 October 2014 - 10:27 AM

 Em có tìm trên diễn đàn mà toàn lisp không down được.

Ai có lisp bảng kê tọa độ làm ơn giúp em với.

Bảng giống hình này nè : http://d.data3.cadvi...104473_qqqq.jpg

Em cần lắm có ai ghé ngang qua biết giúp giùm em với em cám ơn nhiều lắm


  • 0

#2 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 01 October 2014 - 11:28 AM

- nhoc nhớ bữa trước nhoc có post 1 lsp bên chủ để xuất tọa độ ra bảng cho bạn rùi mà ta ^^.

- hình bạn đưa của nhoc chứ ai ^^


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#3 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 01 October 2014 - 12:24 PM

- lỡ giúp,  nhoc giúp cho trót  bạn đỡ đi tìm lại chủ đề trước ^^

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

)

-p/s: trường hợp tải ko đc, bạn copy toàn bộ nội dung trong code về past vào file txt rùi đổi đuôi thành file .lsp


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#4 M se

M se

    biết zoom

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

Đã gửi 01 October 2014 - 09:37 PM

Sao không sử dụng được anh nhoclangbat ơi....nó chạy tùm lum hết...hicc :rolleyes:  :rolleyes:


  • 0

#5 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 01 October 2014 - 10:01 PM

- bạn phải nói rõ nó lỗi từ bước nào, hay lỗi chỗ nào thì nhoc mới biết đường mò ^^


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#6 M se

M se

    biết zoom

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

Đã gửi 03 October 2014 - 02:32 PM

Lỗi kiểu này a nhoclangbat ơi. Mới chọn tới điểm thứ 2 thì lỗi.

https://www.mediafir...5vh95tbcd3tls6i


  • 0

#7 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 03 October 2014 - 02:48 PM

- ek cái lsp này ko phải dạng lsp pick từng điểm góc ranh để lấy tọa độ bạn ơi ^^, bạn cứ pick vào tâm vùng hay gọi theo địa chính là tâm thửa là nó tự lấy hết tọa độ các góc ranh, dòng nhắc tiếp theo là hỏi bạn đặt bảng tọa độ ở đâu, đơn giản vậy ah, còn vụ font chữ là do định dạng trong code khi up lên diễn đàn nó bị biến đổi vậy, cái này sửa tay đc mà ^^


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#8 M se

M se

    biết zoom

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

Đã gửi 03 October 2014 - 02:53 PM

Cái này có thể chỉnh lại theo ý mình là:  chọn điểm đỉnh bắt đầu ở vị trí mình mong muốn không a nhoc ơi


  • 0

#9 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 03 October 2014 - 03:26 PM

- hi trình độ bây giờ chưa cho phép nhoc làm điều đó, bạn thông cảm, lsp trên cũng là lsp nhoc lấy trong cơ quan thui ^^


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#10 M se

M se

    biết zoom

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

Đã gửi 03 October 2014 - 04:02 PM

Hic có anh nào đang ngang qua biết giúp em cái... :D  :D


  • 0

#11 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 04 October 2014 - 11:25 AM

- ek cái lsp này ko phải dạng lsp pick từng điểm góc ranh để lấy tọa độ bạn ơi ^^, bạn cứ pick vào tâm vùng hay gọi theo địa chính là tâm thửa là nó tự lấy hết tọa độ các góc ranh, dòng nhắc tiếp theo là hỏi bạn đặt bảng tọa độ ở đâu, đơn giản vậy ah, còn vụ font chữ là do định dạng trong code khi up lên diễn đàn nó bị biến đổi vậy, cái này sửa tay đc mà ^^

Bạn có Lisp tạo HSKT theo mau xin cho mình xin với

http://www.cadviet.c...114381_vtqp.rar


  • 0

#12 ngochavn

ngochavn

    Chưa sử dụng CAD

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

Đã gửi 08 October 2014 - 10:20 AM

Em cũng muốn xin Lisp giống bạn M se hỏi đó ai ghé ngang

qua làm ơn giúp em với.


  • 0

#13 M se

M se

    biết zoom

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

Đã gửi 08 October 2014 - 08:08 PM

A nhoc ơi sao giờ em load lsp lên rồi, nhập lệnh lên không được nữa anh, trong Command: hiện ra chữ nil. giúp em với. cảm ơn anh.


  • 0

#14 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 08 October 2014 - 11:10 PM

- bạn ráng chờ nhoc đang cố mò chỉnh lại theo y/c chọn điểm đầu tiên, nhoc sẽ cố sữa hết lỗi, chậm nhất là cuối ngày mai ^^

p/s: bạn thông cảm nhoc mới học lsp nên chậm hơn các anh khác :)


  • 1
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#15 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 09 October 2014 - 02:26 PM

- Như đã hứa, nhoc đã chỉnh xong theo y/c bạn Mse và bạn Ngochavn, điểm bắt đầu do người dùng quyết định, khi viết xong nhoc có test rùi thấy cũng tạm ổn, mặc dù cảm giác khả năng khắc phục lỗi của lsp chưa đc tốt ^^, khả năng nhoc tới mới đc vậy, nhoc mò cả tối qua với buổi sáng nay mới ra kaka , mong sao có a nào đi ngang hên xui thấy code nhoc viết ghê quá ngứa nghề sữa dùm nhoc cho nó hoàn thiện hơn  :P , nói vậy thui chứ chạy cũng ổn nếu người dùng thao tác chính xác từng bước sẽ ko có lỗi, cái dở của nhoc là nếu người dùng lỡ tay hay nhầm thì cad báo lỗi thoát lệnh lun ^^.

- nhoc nói sơ từng bước các bạn dễ nắm: nhoc đã sửa lại không cần tạo ranh_38 trước, bạn cứ việc pick vào giữa khu đất ko quan tâm nó nằm ở layer nào, miễn vùng kín là đc

+ tên lệnh là dkk => xác định tỉ lệ bản đồ mặc định enter là 500

+ bước tiếp theo sẽ hỏi bạn chọn điểm đầu tiên như bạn yêu cầu

+ tiếp theo sẽ nhắc bạn chọn tâm thửa, pick vào vào bên trong thửa, để tránh lỗi bạn nên kiểm tra trước thửa đó có kín chưa = lệnh bo

+ tiếp (phần này nhoc thêm cho zui ^^) sẽ hỏi bạn mún chạy thuận hay nghịch chiều kim đồng hồ, từ khóa là "T" vs "N" = thuận với nghịch, mặc định nhoc đặt ko nhập gì enter lun là chạy thuận chiều đồng hồ, lsp sẽ tự động vẽ lại 1 pline kín theo ranh đất nằm ở layer "Ranh_dat" màu tím cho nó nổi ^^.

+ tiếp đó hỏi bạn điểm đặt bảng tọa độ => xong chương trình

- Ah còn vụ font thì do post code lên 4rum nó lỗi , bạn chịu khó sữa tay lại hen ^^, chỉnh lun thì để nhoc up lên trang khác để các bạn tải về, giờ nhoc up trực tiếp cái đã, cho bạn dùng thử, nếu có lỗi gì, hoặc mún thêm gì thông báo để nhoc ngâm cứu ^^, hoàn chỉnh sẽ up nguồn khác ko bị lỗi font nữa :)

(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 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 removed(part lst / lst1 lst2)
  (setq lst1 (reverse(cdr(member part(reverse lst))))
lst2 (cdr(member part lst)))
  (append lst1 lst2)
  )
;;;;;;--------------------------------------------------------------------------------------------
(prompt "LSP XUAT BANG TOA DO CAC DINH THU DAT, LENH: DKK")
;;----------------------------------------------------------------------------------------------
(defun c:dkk (/ p tam i f k lst1 lst2 lst i kk m b luuxy pt old pt11)
(setq old (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
;-----------------------------------------------------
(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_toado" "")
	(if (null (tblsearch "layer" "Ranh_dat"))
		(command "_layer" "n" "Ranh_dat" ""))
	(command "_layer" "c" "6" "Ranh_dat" "")
	(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 "osmode" 33)
(setq pt11 (removed 0.0 (getpoint "\nchon diem bat dau:")))
(setvar "osmode" 0)
(initget 1)
(setq p (getpoint "\npick tam thua:"))
(command "-Boundary" p "")
(setq tam (entget (entlast)))
(setq kk (cdr (assoc 90 tam)))
(command ".erase" "last" "")
(setq m 1)
(setq lst nil)

(repeat kk

(setq f (pointpl tam 10 m))
(setq m (1+ m))
(if f (setq lst (cons f lst)))

)
(if lst
(progn
(if (= (member pt11 lst) nil)
(alert "ban chua chon dung dinh thua dat\nban chay lai lenh tu dau hen thong cam ^^!!"))
(if (/= pt11 nil)
(progn
;------------------------===============================--------------------------------------
(setq bit (cond (bit) ("T")))
(initget "T N")
(setq	Tmp (strcat "\nBan muon chay Thuan hay Ngich chieu dong ho [T/N] <" bit ">: ")
	    bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "T")
(progn
(setq lst1 (member pt11 lst))
(setq lst2 (reverse (cdr (member pt11 (reverse lst)))))
(setq lst (append lst1 lst2))
)
(progn
(setq lst1 (member pt11 (reverse lst)))
(setq lst2 (reverse (cdr (member pt11 lst))))
(setq lst (append lst1 lst2))
)
)
;---------------------------------==============================-----------------------------------
(setq b 1)
(command "-layer" "s" "Ranh_dat" "")
(command ".pline")
(command (car lst))
(repeat (- kk 1)
(command (nth b lst))
(setq b (1+ b))
)
(command "c")
)
)
)
)
;--------------------------------------------------------------------------------------------------------
(if lst
(progn
(setq luuxy (entget (entlast)))
(setvar "osmode" 0)
	(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)
)
(alert "chua lay dc danh sach toa do")
)
	(command "-layer" "s" "0" "")
	(setvar "osmode" old)
    (setvar "cmdecho" 1)
	(princ "\n")
	(princ)
)


P/s: mong nhận đc sự hài lòng từ người dùng  :P , mí a ghé ngang chém nhẹ tay hộ nhoc hen ^^


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#16 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 09 October 2014 - 04:04 PM

Làm thế này được không ta? ^^


  • 1



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







#17 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 09 October 2014 - 05:43 PM

- hi mục đích của 2 bạn kia là chạy tự động, còn của a Duan viết là trong tự động có thủ công, chia làm nhiều bước nhỏ, nhoc nghĩ dùng đễ kiểm tra nhỏ, hay tính nhanh thì tiện, nếu khu đất có trên 20 điểm thì pick hơi phê anh nhỉ ^^ chưa kể pick nhầm.

- anh Duan share nhoc lsp đó đc ko hen, nhoc mót để dành khi cần :P


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#18 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 09 October 2014 - 08:36 PM

Đây. ^^

(vl-load-com)
(defun C:TDKT (/ Olmode STT loop TD_Point Lts Pnt P_dat n i P1 P2 P3 P4 P_cuoi P_Text Pdat_KC  CDKC  Pnt_i P_i P_i_1  Pnt_KC Lts1);;;;;TOA DO KICH THUOC
(setvar "CMDECHO" 0)
(defun *error* ( msg )
(if Olmode (setvar 'osmode Olmode))
(if (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg))
)
(princ)
)
(setq Olmode (getvar "OSMODE"))
(or *h* (setq *h* 2))
(setq h (getreal (strcat "\nNh\U+1EADp chi\U+1EC1u cao Text <"
		  (rtos *h* 2 2)
		 "> :"
	  )
 )
)
(if (not h) (setq h *h*) (setq *h* h))
(setvar "OSMODE" 9)
(setq STT 1)
(setq loop T)
(setq TD_Point (list))
(setq Lts (list))
(_layer2  "Heaven2407" 2)
(while loop
	(setq Pnt (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m : "))
  	(cond
	  (T
		(if Pnt
		  (progn
		    	
;;;	    	  	(setq P_STT (Polar3 Pnt 0 (/ h 2.0)))
		    	(setq P_STT (Polar3 Pnt 0 0))
  			(wtxt (rtos STT 2 0) P_STT (* h 2.0) 0 "L" "Heaven2407")
		  	(setq TD_Point (list STT (list (car Pnt) (cadr Pnt))))
		    	(setq Lts (append Lts (list TD_Point)))
		    	
		  )
		  (setq loop nil)
		)
	  )
	)
  	(setq STT (1+ STT))
  	
)
(setq n (length Lts))
(setq P_dat (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n b\U+1EA3ng t\U+1ECDa \U+0111\U+1ED9 v\U+00E0 k\U+00EDch th\U+01B0\U+1EDBc: "))
(setq i 0)
(setq P1 (Polar3 P_dat (* 4.0 h) 0))
(setq P2 (Polar3 P1 (* h 8.0) 0))
(setq P3 (Polar3 P2 (* h 8.0) 0))
(setq P4 (Polar3 P3 (* h 6.0) 0))
(setq P_cuoi (Polar3 P_dat 0 (+ (* (* -2.0 h) (+ n 1)) 1)))
(entmake (list (cons 0 "LINE") (cons 10 P_dat) (cons 11 P4)))
(entmake (list (cons 0 "LINE") (cons 10 P_dat) (cons 11 P_cuoi)))
(entmake (list (cons 0 "LINE") (cons 10 P_cuoi) (cons 11 (list (car P4) (cadr P_cuoi)))))
(entmake (list (cons 0 "LINE") (cons 10 (list (car P4) (cadr P_cuoi))) (cons 11 P4)))
(entmake (list (cons 0 "LINE") (cons 10 P1) (cons 11 (list (car P1) (cadr P_cuoi)))))
(entmake (list (cons 0 "LINE") (cons 10 P2) (cons 11 (list (car P2) (cadr P_cuoi)))))
(entmake (list (cons 0 "LINE") (cons 10 P3) (cons 11 (list (car P3) (cadr P_cuoi)))))
(setq P_Text (Polar3 P_dat (* h 2.0) (* h -2.0)))
(setq Pdat_KC (Polar3 P_Text (* h 21.0) (* h -1.0)))
(setq PLine_ngangdau (Polar3 P_dat 0.0 (* h -2.25)))
(while (< i (- n 1))
  	(setq P1 (car (cdr (nth i Lts))))
  	(setq P2  (car (cdr (nth (+ i 1) Lts))))
  	(setq KCLT  (distance P1 P2))
  
  
  	;;;GHI SO THU TU
  	(setq Pnt_i (Polar3 P_Text 0.0 (* i (* h -2.0))))
  	(setq NDSTT (car (nth i Lts)))
	(wtxt (rtos NDSTT 2 0) Pnt_i h 0 "BC" nil)

  	;;;GHI TOA DO X
	(setq Pnt_i_X (Polar3 P_Text (* h 6.0) (* i (* -2.0 h))))
  	(setq TD_X (car P1))
	(wtxt (rtos TD_X 2 2) Pnt_i_X h 0 "BC" nil)

  	;;;GHI TOA DO Y
	(setq Pnt_i_Y (Polar3 P_Text (* h 14.0) (* i (* -2.0 h))))
  	(setq TD_Y (cadr P1))
	(wtxt (rtos TD_Y 2 2) Pnt_i_Y h 0 "BC" nil)

  	;;;GHI KHOANG CACH
	(setq Pnt_KC (Polar3 Pdat_KC 0.0 (* i (* -2.0 h))))
	(wtxt (rtos KCLT 2 2) Pnt_KC h 0 "BC" nil)


  	;;KE LINE NGANG
	(setq P_Line (Polar3 PLine_ngangdau 0 (* i (* h -2.0))))
  	(entmake (list (cons 0 "LINE") (cons 10 P_Line) (cons 11 (list (car P3) (cadr P_Line) ))))
	
(setq i (1+ i))
)
  	;;;GHI SO THU TU
  	(setq Pnt_i1 (Polar3 P_Text 0 (* (- n 1) (* -2.0 h))))
  	(setq NDSTT1 (car (nth 0 Lts)))
	(wtxt (rtos NDSTT1 2 0) Pnt_i1 h 0 "C" nil)

  	;;;GHI TOA DO X
	(setq Pnt_i_X1 (Polar3 P_Text (*  h 6.0) (* (- n 1) (* h -2.0))))
  	(setq TD_X1 (car (car (cdr (nth 0 Lts)))))
	(wtxt (rtos TD_X1 2 2) Pnt_i_X1 h 0 "C" nil)

  	;;;GHI TOA DO Y
	(setq Pnt_i_Y1 (Polar3 P_Text (* h 14.0) (* (- n 1) (* -2.0 h))))
  	(setq TD_Y1 (cadr (car (cdr (nth 0 Lts)))))
	(wtxt (rtos TD_Y1 2 2) Pnt_i_Y1 h 0 "C" nil)

  
(setvar "OSMODE" Olmode)
;;;(princ Lts1)
(princ)
)

(defun Polar3 (Pnt KC1 KC2 /  P1)
	(setq P1 (list (+ (car Pnt) KC1) (+ (cadr Pnt) KC2)))
)

(defun wtxt (string Point Height Ang justify Layer / Lst)
 (setq Lst (list '(0 . "TEXT")
   (cons 8 (if Layer Layer (getvar "Clayer")))
   (cons 62 (if Color Color 256))
   (cons 10 point)
   (cons 40 Height)
   (cons 1 string)
   (if Ang (cons 50 Ang))
   (cons 7 (if Style Style (getvar "Textstyle"))))
  justify (strcase justify))
 (cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
       		((= justify "L") (setq Lst (append Lst (list (cons 72 0)(cons 73 0) (cons 10 point)))))
        	((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
        	((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
        	((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))
        	((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))
        	((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))   
        	((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))
        	((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))
        	((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))
        	((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))
        	((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))
        	((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1))))))
 (entmake Lst)
)


(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)

  • 1



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







#19 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 10 October 2014 - 08:37 AM

- hi lsp đang có lỗi lớn :P , có 1 bạn test trước hộ nhoc, các bạn chờ xíu để nhoc ngâm nga lại sẽ cập nhật sớm nhất có thể :)


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#20 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 10 October 2014 - 01:29 PM

- mấy bạn chạy test hộ nhoc còn lsp còn lỗi ko nhé ^^

(defun *error* (msg)
  (princ "error: ")
  (princ msg)
  (princ)
)
;;;;;;;;;;;============================================================
(defun Makepline (listpoint closed Layer Linetype LTScale xdata / Lst)
	(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	'(100 . "AcDbPolyline")
	(cons 90 (length listpoint))
	(cons 70 (if closed 1 0))))
	(foreach PP listpoint	(setq Lst (append Lst (list (cons 10 PP)))))
	(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
	(entmakex Lst))
	;end;=================================
;;;;------------------------------------------
;;ham tao text 2
(defun mktext (point height string justify layer textstyle / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 point)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 8 layer)
							  (cons 7 textstyle)
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
				)
	(entmakex Lst)
  )	;end mktext
;;--------------------------------------
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
;;-----------------------------------
(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 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 removed(part lst / lst1 lst2)
  (setq lst1 (reverse(cdr(member part(reverse lst))))
lst2 (cdr(member part lst)))
  (append lst1 lst2)
  )
;hàm tạo textstyle
(defun emk_style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;;;;
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil)))))
;;;;;;--------------------------------------------------------------------------------------------
(prompt "LSP XUAT BANG TOA DO CAC DINH THU DAT, LENH: DKK")
;;----------------------------------------------------------------------------------------------
(defun c:dkk (/ p tam i f k lst1 lst2 lst pt11 lst_new i kk m luuxy pt old  canh p01 p02 p03 p04 p05 p06 p07 p08 p09 p10 p11 p12 p13 p14 x x1 y y1 toado toado0 toado1 pyy pxx psh pgc t0 t1 t2 t3 t4 y tsh txx tyy tgc)
(setq old (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
;-----------------------------------------------------
(if (null (tblsearch "style" "vaptimn"))
		(emk_style "vaptimn" "vavon.ttf"))
	(if (null (tblsearch "style" "vhelveb"))
		(emk_style "vhelveb" "vhelven.TTF"))
	(if (null (tblsearch "layer" "sohieu_diem"))
		(_layer2 "sohieu_diem" 2))
    (if (null (tblsearch "layer" "canh"))
		(_layer2 "canh" 3))
	(if (null (tblsearch "layer" "bang_toado"))
		(_layer2 "bang_toado" 7))
	(if (null (tblsearch "layer" "Ranh_dat"))
		(_layer2 "Ranh_dat" 6))
	(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 "osmode" 33)
(setq pt11 (getpoint "\nchon diem bat dau:"))
(setq pt11 (removed 0.0 pt11))
(setvar "osmode" 0)
(setq p (getpoint "\npick tam thua:"))
(command "-Boundary" p "")
(setq tam (entget (entlast)))
(setq kk (cdr (assoc 90 tam)))
(command ".erase" "last" "")
(setq m 1)
(setq lst nil)

(repeat kk
(setq f (pointpl tam 10 m))
(setq m (1+ m))
(if f (setq lst (cons f lst)))
)

;------------------------------------------==========================================---------------------------------
(if (= (type (member pt11 lst)) 'LIST)
;;====================-----------------------------======================================-----------------------
(progn
;--------------------====================================------------------------------------
(if lst
(progn
;------------------------===============================--------------------------------------
(setq bit (cond (bit) ("T")))
(initget "T N")
(setq	Tmp (strcat "\nBan muon chay Thuan hay Ngich chieu dong ho [T/N] <" bit ">: ")
	    bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "T")
(progn
(setq lst1 (member pt11 lst))
(setq lst2 (reverse (cdr (member pt11 (reverse lst)))))
(setq lst_new (append lst1 lst2))
)
(progn
(setq lst1 (member pt11 (reverse lst)))
(setq lst2 (reverse (cdr (member pt11 lst))))
(setq lst_new (append lst1 lst2))
)
)
;---------------------------------==============================-----------------------------------
(Makepline lst_new 1 "Ranh_dat" nil nil nil)
;----------------------------=========================================--------------------------
)
)
;--------------------------------------------------------------------------------------------------------
(setq luuxy (entget (entlast)))
(setvar "osmode" 0)
	(setq pt (getpoint "\n Diem dat bang toa do :"))
	(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))
				)
			)
			
			(makeline p01 p05 "bang_toado" nil nil nil)
			(makeline p01 p10 "bang_toado" nil nil nil)
			(makeline p02 p11 "bang_toado" nil nil nil)
			(makeline p03 p12 "bang_toado" nil nil nil)
			(makeline p04 p13 "bang_toado" nil nil nil)
			(makeline p05 p14 "bang_toado" nil nil nil)
			(makeline p07 p08 "bang_toado" nil nil nil)
			(makeline p06 p09 "bang_toado" nil nil nil)
			(makeline p10 p14 "bang_toado" nil nil nil)
;------------------------------------------------------------------------------------------------------------------
(mktext (mapcar '+ pt '(22.5 2.0 0.0)) 1.25 "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(5.0 -1.5 0.0)) 1.15 "Soá hieäu" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(5.0 -3.5 0.0)) 1.15 "ñieåm" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(22.5 -1.25 0.0)) 1.15 "Toïa ñoä" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(16.25 -3.75 0.0)) 1.15 "X(m)" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(28.75 -3.75 0.0)) 1.25 "Y(m)" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(40.0 -2.5 0.0)) 1.25 "Caïnh" "M" "bang_toado" "vhelveb")
;-------------------====================--------------------------------------------------------------------------
		)
	)
	(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))
			(setq doi (list (* 0.2 (/ TileBdHT 500)) (* 0.2 (/ TileBdHT 500)) 0.0))
			(mktext (mapcar '+ toado doi) (/ TileBdHT 500) (itoa i) "L" "sohieu_diem" "vaptimn")
            (command "-layer" "s" "sohieu_diem" "")			
			(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))
	(mktext pgc 1.2 (rtos canh 2 2) "M" "bang_toado" "vaptimn")
	(setvar "clayer" "canh")
	(wdis toado0 toado)
)
			)
			(mktext psh 1.2 (itoa i) "M" "bang_toado" "vaptimn")
			(mktext pxx 1.2 y "M" "bang_toado" "vaptimn")
			(mktext pyy 1.2 x "M" "bang_toado" "vaptimn")
			
			(setq toado0 toado)
			(setq i (+ i 1))
		)
	)
	(setvar "clayer" "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))
	(mktext pgc 1.2 (rtos canh 2 2) "M" "bang_toado" "vaptimn")
	(mktext psh 1.2 "1" "M" "bang_toado" "vaptimn")
	(mktext pxx 1.2 y1 "M" "bang_toado" "vaptimn")
	(mktext pyy 1.2 x1 "M" "bang_toado" "vaptimn")
	
)
(alert "ban chua chon dung dinh thua dat\nban chay lai lenh tu dau hen thong cam ^^!!")
)
	(setvar "clayer" "0")
	(setvar "osmode" old)
    (setvar "cmdecho" 1)
	(princ "\n")
	(princ)
)


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^