Listp bảng tọa độ vn2000

Tháng 10 1, 2014

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.cadviet.com/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

Tháng 10 1, 2014

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

Tháng 10 1, 2014

- 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

Tháng 10 1, 2014

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

Tháng 10 1, 2014

- 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ò ^^

Tháng 10 3, 2014

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

https://www.mediafire.com/?5vh95tbcd3tls6i

Tháng 10 3, 2014

- 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à ^^

Tháng 10 3, 2014

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

Tháng 10 3, 2014

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

Tháng 10 3, 2014

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

Tháng 10 4, 2014

- 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.com/upfiles/3/114381_vtqp.rar

Tháng 10 8, 2014

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.

Tháng 10 8, 2014

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.

Tháng 10 8, 2014

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

Tháng 10 9, 2014

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

Tháng 10 9, 2014

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

Tháng 10 9, 2014

- 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

Tháng 10 9, 2014

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

Tháng 10 10, 2014

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

Tháng 10 10, 2014

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

Tháng 10 10, 2014

Lỗi anh nhoc ơi, sau khi lsp yêu cầu chọn tâm thửa xong. không thực hiện lệnh tiếp theo nữa. hicc :P

Tháng 10 10, 2014

không phải lỗi đâu do ko tạo đc font đó, cái này liên quan đến win rùi hơi khó nói, bạn làm thử 1 bản nháp thủ công nhoc xem, bạn thich dùng mấy loại style, style đó có font là gì, text nào gắn với style nào, để nhoc lường trước

Tháng 10 10, 2014

@@- ek ý nhoc là file giống như sau khi lsp chạy rùi đó

- giờ vậy đi hen, text đánh số thứ tự điểm trên ranh đất bạn thik nó thuộc style tên gì, style đó có tên font là gì, chữ thường, đậm hay nghiêng

- tương tự, text trên bảng tọa độ mấy tiêu đề và text nội dung bên dưới như thế nào.

- hay đơn giản hơn bạn tạo trước các style bạn dùng, và các đối tượng text do lsp tạo ra bạn thik nó thuộc style nào, nhoc sẽ chỉnh riêng 1 lsp chỉ chạy trên máy bạn và có trước nhưng style đó, nếu ko có những style đó thì lsp ko chạy ^^, đem máy khác xài trước khi chạy lsp cũng phải tạo các style đó trước

Tháng 10 10, 2014

- Mấy bạn test hộ nhoc lần cuối, nhoc đã cố gắng mò mẫn, mót nhặt, chắp vá, đông tây y kết hợp ^^ để cố gắng ko lỗi nữa :)

- nhoc đổi lại thứ tự xíu là pick tâm thửa xong mới chọn điểm bắt đầu hen, để ý ko nhầm ^^

- nếu vấn đề chọn điểm bắt đầu rùi chạy tọa độ các bạn thấy ok, nhoc sẽ xử tiếp phần style font của text ^^

(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 dieukientimdiem (Pchon lstpoint / i kq tiep toadop)

	(setq tiep T)
  	(setq i 0)
  	(while (and tiep (< i (length lstpoint)))
	  (setq toadop (nth i lstpoint))	  
	  (if (equal Pchon toadop 0.001)
	    (progn
	      (setq tiep nil)	    
	      (setq kq "1")
	      )
	    )
	  (setq i (+ i 1))
	  )
kq  
)
;==============================================---------------------
;loai bo phan tu giong nhau va bat dau bat = phantu cho truoc ( du lieu kieu point) (thuan kim dong ho)
(defun khoi (start myList / lay newList)
    
  (setq
    lay nil
    newList nil
  )
  (foreach x myList
    (if (ssGanDung x start)
      (setq lay T)
    )
    (if lay
      (setq newList (append newList (list x)))
    )
  )
  (setq lay T)
  (foreach x (cdr myList)
    (if (ssGanDung x start)
      (setq lay nil)
    )
    (if lay
      (setq newList (append newList (list x)))
    )
  )
  (setq newList (append (list (car newList)) (reverse (cdr newList))))
)
(defun ssGanDung (x y)
  (if (equal x y 0.001)
    T
    nil
  )
)
;;-----------------------------------
(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 Rf_slstart  (start myList / lay newList)
  (setq
    lay nil
    newList nil
  )
  (foreach x myList
    (if (equal x start 0.001)
      (setq lay T)
    )
    (if lay
      (setq newList (append newList (list x)))
    )
  )
  (setq lay T)
  (foreach x (cdr myList)
    (if (equal x start 0.001)
      (setq lay nil)
    )
    (if lay
      (setq newList (append newList (list x)))
    )
  )
  newList
)
;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 lst dk lst1 lst2 lst_new pt11 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" 0)
(setq p (getpoint "\npick tam thua:"))
(command "-Boundary" p "")
(setq tam (entget (entlast)))
(setq kk (cdr (assoc 90 tam)))
(setq lst (acet-geom-vertex-list (cdr (assoc -1 tam))))
(setvar "osmode" 33)
(setq pt11 (getpoint "\nchon diem bat dau:"))
(setq dk (dieukientimdiem pt11 lst))
(if (and (/= dk nil) (eq dk "1"))
;------------------------------------------==========================================---------------------------------
(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")
(setq lst_new (khoi pt11 lst))
(setq lst_new (Rf_slstart pt11 lst))
)
;---------------------------------==============================-----------------------------------
(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")
	
);end progn
(alert "ban chua chon dung dinh thua dat\nban chay lai lenh tu dau hen thong cam ^^!!")
); end if
    (entdel (cdr (assoc -1 tam)))
	(setvar "clayer" "0")
	(setvar "osmode" old)
    (setvar "cmdecho" 1)
	(princ "\n")
	(princ)
)

P/s: thanks các anh đã nhiệt tình giúp đở nhoc ^^, giờ đi ăn cơm cái đói rùi ^^

Tháng 10 10, 2014

-ek bạn Mse mún làm y chang file hả @@, font TCVN3 không, đánh dấu điểm = block nữa @@

- hi hay là chạy ra như lsp thui hen, mí cái kia bạn chịu khó autotay hen ^^.

- có thời gian mới chỉnh y chang file bạn đưa nổi ^^, bạn thông cảm

Đăng nhập

Listp bảng tọa độ vn2000

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

ngochavn 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

nhoclangbat 392

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

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

M se 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

nhoclangbat 392

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

M se 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

nhoclangbat 392

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

M se 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

nhoclangbat 392

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

M se 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

tientracdia 16

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

ngochavn 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

M se 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

nhoclangbat 392

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

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 276

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

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 276

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

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