Đến nội dung


Hình ảnh
- - - - -

Lisp đánh số thửa cho thửa đất


  • Please log in to reply
36 replies to this topic

#1 elleHCSC

elleHCSC

    biết lệnh copy

  • Members
  • PipPipPip
  • 119 Bài viết
Điểm đánh giá: 98 (tàm tạm)

Đã gửi 10 December 2008 - 09:53 AM

1. Các thửa đất là các Closed_polyline, user làm bằng cách nào thì tuỳ, có thể dùng cadmap tạo topology để sau đó tạo Closed_polyline hoặc tự tạo bằng cách dùng lệnh Bounary...

2. Các điểm tâm thửa (Centroid) là các Point nằm trên layer "Centroid" cũng vậy hoặc tạo bằng Cadmap cho nhanh hoặc user tự tạo. Mục này elle sẽ cố gắng hoàn thiện tiếp trong nay mai vì đã có Closed_polyline thì việc xác định centroid và diện tích để gán cùng với số thửa chắc chắn sẽ làm được.

Lệnh là DST

;;;*****************************************************************;;;


;;; Tks to Ssg & all Cadviet members who make lisp impressed me much;;;
;;;*****************************************************************;;;

;;;*****************************************************
;;; Danh so thua tu dong cho thua dat (Closed_Polyline)
(defun c:dst ( / ent tongsothua)
(command "Undo" "Begin")
(command "osnap" "none")
(setq ent (ssget "X" (list (cons 8 "centroid")(cons 0 "POINT"))))
(if(= ent nil)(progn (alert "Ch­a ®¸nh dÊu t©m thöa, h·y t¹o t©m thöa d¹ng POINT trªn layer CentroID ! "))
(progn
(setq ent (ssget "X" (list (cons 8 "centroid" )(cons 0 "POINT"))))
(if (/= nil ent) (setq tongsothua(sslength ent) ))
(danhsothua tongsothua)
(alert (strcat "Cã tæng sè " (itoa tongsothua) " thöa ®Êt ®· ®­îc ®¸nh sè !" ))
);prog
);if
(command "Undo" "End")
)
;;;*****************************************************
(defun danhsothua (tongsothua / ent tbl List_cen List_sort List_ok e es i j x y e1 e2)
(vl-load-com)
(setq ent (ssget "X" (list (cons 8 "centroid")(cons 0 "POINT"))))
(setq tbl (TBLSEARCH "LAYER" "sothua" ))
(if (= tbl nil)(command "layer" "n" "sothua" "c" "Yellow" "sothua" ""))
(command "layer" "s" "sothua" "")
(setq tbl (TBLSEARCH "style" "sothua" ))
(if (= tbl nil)(command "style" "sothua" "romans.shx" "1.2" "0.8" "" "" "" ""))

(setq j 0)
(while (< j tongsothua)
(setq e (ssname ent j))
(setq es(entget e))
(setq x (car (cdr (assoc 10 es))) )
(setq y (car (cdr (cdr (assoc 10 es)))))
(setq List_cen(append List_cen(list (list x y))))
(setq j (1+ j))
) ;while

; Buoc 1 - sort kieu descending cho point CentroID.Y (X trac dia)
(setq list_sort (vl-sort list_cen (function (lambda (e1 e2)(> (cadr e1)(cadr e2))))) )

; Buoc 2 - sort kieu ascending point CentroID tu trai sang phai truc X (Y trac dia)
(sort_trai_phai tongsothua list_sort)
;;

; Ve so thua ra ban ve;
(setq i 0)
(while (< i tongsothua)
(wtxt2 (itoa (1+ i)) (nth i List_ok) "sothua" "sothua" 1 "C" "B" )
(setq i (1+ i))
)
)
;;;*****************************************************
(defun sort_trai_phai (tongsothua list_sort / list_tmp step sp ep m k p last_point)
(setq
step 20 ; Do rong cua giai danh so thua la 20m, sua them chut de cho user nhap gia tri nay tu ban phim moi lan chay
m (- tongsothua 1)
sp (+ (cadr(nth 0 list_sort)) (* step 0.5)) ; sp.Y + step*0.5
ep (cadr (nth m list_sort)) ; ep.Y
;num_down (+ (fix(/(- sp ep)step)) 1)
last_point (list (car(nth m list_sort)) (cadr(nth m list_sort)) )
)
(while (> sp ep)
(setq k 0)
(setq list_tmp nil)
(while (< k m)
(if (and (<=(cadr(nth k list_sort)) sp) (>(cadr(nth k list_sort)) (- sp step)) )
(progn
(setq p (list (car(nth k list_sort)) (cadr(nth k list_sort))))
(setq List_tmp (append List_tmp (list p) ) )
)
)
(setq k (1+ k))
);while k
(setq list_tmp (vl-sort list_tmp (function (lambda (e1 e2)(< (car e1)(car e2))))) )
(setq List_ok (append List_ok list_tmp))
(setq sp (- sp step))
);while sp;
(setq List_ok (append List_ok (list last_point) ) )
)
;;;*****************************************************
(defun wtxt2 (txt p lay sty k hj vj / d h) ;;;Write txt on graphic screen (from Ssg - Cadviet forum)
;;;Specify txt, point, layer, style, scale factor, hor justify, ver justify
(setq
d (tblsearch "style" sty)
h (cdr (assoc 40 d))
LH (list "L" "C" "R") ;;;Left, Center, Right
LV (list "" "B" "M" "T") ;;;Bottom, Middle, Top
hcode (vl-position hj LH)
vcode (vl-position vj LV)
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
(list (cons 0 "TEXT") (cons 8 lay) (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 40 (* k h)) (assoc 41 d) (cons 72 hcode) (cons 73 vcode))
)
)
;;;*****************************************************


file vd mẫu:
http://www.cadviet.com/upfiles/Out.dwg
  • 1
Share for all, all will share !

--------------------
HTTP://WWW.HCSC.VN
HTTP://WWW.HCSC.COM.VN

#2 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 10 December 2008 - 10:24 AM

Chúc mừng bác, thế mà bác khiêm tốn cho rằng không rành lisp.
Góp ý một chút: Chương trình tự tìm và báo cáo có bao nhiêu thửa sẽ được gán số thửa, hay!
Qui luật đánh số không theo đường ziczac (đổi hướng), còn "tự do".
Cố gắng đi bác, nếu xong cái vụ này, coi như bác đã "trả nợ " thay cho SSg đó
  • 0

#3 elleHCSC

elleHCSC

    biết lệnh copy

  • Members
  • PipPipPip
  • 119 Bài viết
Điểm đánh giá: 98 (tàm tạm)

Đã gửi 10 December 2008 - 10:44 AM

Qui luật đánh số không theo đường ziczac (đổi hướng), còn "tự do".


Đâu có, đánh có quy luật đó chớ, từ trên xuống dưới-từ trái sang phải với độ rộng của "giải" đánh là 20m (độ rộng này có thể thay đổi được) bác bật layer temp trong file vẽ vd đi kèm lên sẽ thấy cách elle đánh số thửa mà !
  • 0
Share for all, all will share !

--------------------
HTTP://WWW.HCSC.VN
HTTP://WWW.HCSC.COM.VN

#4 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 10 December 2008 - 10:57 AM

Đâu có, đánh có quy luật đó chớ, từ trên xuống dưới-từ trái sang phải với độ rộng của "giải" đánh là 20m (độ rộng này có thể thay đổi được) bác bật layer temp trong file vẽ vd đi kèm lên sẽ thấy cách elle đánh số thửa mà !

Nhưng mình Ko thấy tùy chọn thay đổi độ rộng ? Với lại mình muốn thế này: sau khi đánh giải trên xong theo hướng trái-phải, tiếp tục giải dưới theo hướng ngược lai phải-trái, để số thứ tự thửa liền kề nó được "liên tục" ở hai đầu biên phải và trái
  • 0

#5 elleHCSC

elleHCSC

    biết lệnh copy

  • Members
  • PipPipPip
  • 119 Bài viết
Điểm đánh giá: 98 (tàm tạm)

Đã gửi 10 December 2008 - 02:06 PM

Nhưng mình Ko thấy tùy chọn thay đổi độ rộng ? Với lại mình muốn thế này: sau khi đánh giải trên xong theo hướng trái-phải, tiếp tục giải dưới theo hướng ngược lai phải-trái, để số thứ tự thửa liền kề nó được "liên tục" ở hai đầu biên phải và trái


Độ rộng thì bác tìm đoạn
  (setq     
step 20 ; Do rong cua giai danh so thua la 20m, sua them chut de cho user nhap gia tri nay tu ban phim moi lan chay
m (- tongsothua 1)
sp (+ (cadr(nth 0 list_sort)) (* step 0.5)) ; sp.Y + step*0.5
ep (cadr (nth m list_sort)) ; ep.Y
;num_down (+ (fix(/(- sp ep)step)) 1)
last_point (list (car(nth m list_sort)) (cadr(nth m list_sort)) )
chan 0 ; neu chan danh tu Trai sang phai, neu le danh tu Phai sang trai
dn 0
)


sửa cái dòng
step 20 ; Do rong cua giai danh so thua la 20m, sua them chut de cho user nhap gia tri nay tu ban phim moi lan chay

elle đã fix đánh số thửa ziczac theo ý bác đây:

;;;*****************************************************************;;;

;;; Tks to Ssg & all Cadviet members who make lisp impressed me much;;;
;;;*****************************************************************;;;

;;;*****************************************************
;;; Danh so thua tu dong cho thua dat (Closed_Polyline)
(defun c:dst ( / ent tongsothua)
(command "Undo" "Begin")
(command "osnap" "none")
(setq ent (ssget "X" (list (cons 8 "centroid")(cons 0 "POINT"))))
(if(= ent nil)(progn (alert "Ch­a ®¸nh dÊu t©m thöa, h·y t¹o t©m thöa d¹ng POINT trªn layer CentroID ! "))
(progn
(setq ent (ssget "X" (list (cons 8 "centroid" )(cons 0 "POINT"))))
(if (/= nil ent) (setq tongsothua(sslength ent) ))
(danhsothua tongsothua)
(alert (strcat "Cã tæng sè " (itoa tongsothua) " thöa ®Êt ®· ®­îc ®¸nh sè !" ))
);prog
);if
(command "Undo" "End")
)
;;;*****************************************************
(defun danhsothua (tongsothua / ent tbl List_cen List_sort List_ok e es i j x y e1 e2)
(vl-load-com)
(setq ent (ssget "X" (list (cons 8 "centroid")(cons 0 "POINT"))))
(setq tbl (TBLSEARCH "LAYER" "sothua" ))
(if (= tbl nil)(command "layer" "n" "sothua" "c" "Yellow" "sothua" ""))
(command "layer" "s" "sothua" "")
(setq tbl (TBLSEARCH "style" "sothua" ))
(if (= tbl nil)(command "style" "sothua" "romans.shx" "1.2" "0.8" "" "" "" ""))

(setq j 0)
(while (< j tongsothua)
(setq e (ssname ent j))
(setq es(entget e))
(setq x (car (cdr (assoc 10 es))) )
(setq y (car (cdr (cdr (assoc 10 es)))))
(setq List_cen(append List_cen(list (list x y))))
(setq j (1+ j))
) ;while

; Buoc 1 - sort kieu descending cho point CentroID.Y (X trac dia)
(setq list_sort (vl-sort list_cen (function (lambda (e1 e2)(> (cadr e1)(cadr e2))))) )

; Buoc 2 - sort kieu ascending point CentroID tu trai sang phai truc X (Y trac dia)
(sort_trai_phai tongsothua list_sort)
;;

; Ve so thua ra ban ve;
(setq i 0)
(while (< i tongsothua)
(wtxt2 (itoa (1+ i)) (nth i List_ok) "sothua" "sothua" 1 "C" "B" )
(setq i (1+ i))
)
)
;;;*****************************************************
(defun sort_trai_phai (tongsothua list_sort / list_tmp step sp ep m k p last_point le dn)
(setq
step 20 ; Do rong cua giai danh so thua la 20m, sua them chut de cho user nhap gia tri nay tu ban phim moi lan chay
m (- tongsothua 1)
sp (+ (cadr(nth 0 list_sort)) (* step 0.5)) ; sp.Y + step*0.5
ep (cadr (nth m list_sort)) ; ep.Y
;num_down (+ (fix(/(- sp ep)step)) 1)
last_point (list (car(nth m list_sort)) (cadr(nth m list_sort)) )
chan 0 ; neu chan danh tu Trai sang phai, neu le danh tu Phai sang trai
dn 0
)
(while (> sp ep)
(setq k 0)
(setq list_tmp nil)
(while (< k m)
(if (and (<=(cadr(nth k list_sort)) sp) (>(cadr(nth k list_sort)) (- sp step)) )
(progn
(setq p (list (car(nth k list_sort)) (cadr(nth k list_sort))))
(setq List_tmp (append List_tmp (list p) ) )
)
)
(setq k (1+ k))
);while k
(setq dn (1+ dn))
(setq chan(rem dn 2))
(if (= chan 0)
(setq list_tmp (vl-sort list_tmp (function (lambda (e1 e2)(> (car e1)(car e2))))) ) ; chan
(setq list_tmp (vl-sort list_tmp (function (lambda (e1 e2)(< (car e1)(car e2))))) ) ; le
);if chan
(setq List_ok (append List_ok list_tmp))
(setq sp (- sp step))
);while sp;
(setq List_ok (append List_ok (list last_point) ) )
)
;;;*****************************************************
(defun wtxt2 (txt p lay sty k hj vj / d h) ;;;Write txt on graphic screen (from Ssg - Cadviet forum)
;;;Specify txt, point, layer, style, scale factor, hor justify, ver justify
(setq
d (tblsearch "style" sty)
h (cdr (assoc 40 d))
LH (list "L" "C" "R") ;;;Left, Center, Right
LV (list "" "B" "M" "T") ;;;Bottom, Middle, Top
hcode (vl-position hj LH)
vcode (vl-position vj LV)
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
(list (cons 0 "TEXT") (cons 8 lay) (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 40 (* k h)) (assoc 41 d) (cons 72 hcode) (cons 73 vcode))
)
)
;;;*****************************************************

  • 1
Share for all, all will share !

--------------------
HTTP://WWW.HCSC.VN
HTTP://WWW.HCSC.COM.VN

#6 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 10 December 2008 - 03:20 PM

elle đã fix đánh số thửa ziczac theo ý bác đây:

Ha ha! bái phục, bái phục. Thế mới gọi là "đánh số thửa" chớ. Nếu có thể, bác sửa chút cho nó pro :
Khi nhập lệnh, xuất hiện hộp thoại để nhập thông tin xử lý: chiều rộng giải quét; lớp chứa đối tượng thửa đất (đề phòng đối tượng Closed_polyline khác không phải là thửa đất), lớp chứa số thửa sẽ tạo ra (mặc định là SOHIEUTHUA chẳng hạn, nếu hiện thời lớp này chưa có thì chương trình sẽ tạo mới), chiều cao text...
Cám ơn bác nhiều lắm đấy, bác nào là dân địa chính, vô đây mà chiêm ngưỡng
  • 0

#7 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 10 December 2008 - 05:21 PM

1. Các thửa đất là các Closed_polyline, user làm bằng cách nào thì tuỳ, có thể dùng cadmap tạo topology để sau đó tạo Closed_polyline hoặc tự tạo bằng cách dùng lệnh Bounary...

2. Các điểm tâm thửa (Centroid) là các Point nằm trên layer "Centroid" cũng vậy hoặc tạo bằng Cadmap cho nhanh hoặc user tự tạo. Mục này elle sẽ cố gắng hoàn thiện tiếp trong nay mai vì đã có Closed_polyline thì việc xác định centroid và diện tích để gán cùng với số thửa chắc chắn sẽ làm được.

Tuyệt lắm!
Cám ơn bạn rất nhiều! Bạn đã "trả nợ" giúp ssg!
Nếu bạn có điều gì vướng mắc về lisp, ssg sẽ cố gắng hỗ trợ, xem như chuộc lỗi với bạn tnmtpc cũng như toàn thể anh em trắc địa.
Về centroid, bạn tham khảo đoạn code sau và có thể biên tập lại theo ý muốn.

Lisp tạo Point tại Centroid của các đối tượng Pline kín. Lệnh CTR:

;;;-------------------------------------------------------------
(defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename
(setq i 0 Le nil)
(repeat (sslength ss)
(setq
e (ssname ss i)
Le (append Le (list e))
i (1+ i)
)
)
Le
)
;;;-------------------------------------------------------------
(defun closed(e / ps pe) ;;;Return True if curve closed
(vl-load-com)
(setq
ps (vlax-curve-getPointAtParam e (vlax-curve-getStartParam e))
pe (vlax-curve-getPointAtParam e (vlax-curve-getEndParam e))
)
(equal ps pe)
)
;;;-------------------------------------------------------------
(defun get_cenp (e) ;;;Get Centroid of pline
(vl-load-com)
(command "region" e "")
(setq
e1 (entlast)
obj (vlax-ename->vla-object e1)
var (vlax-variant-value (vlax-get-property obj 'centroid))
)
(setq p (append (vlax-safearray->list var) '(0.0))) ;;;return 2Dpoint
(command "undo" 1)
p
)
;;;-------------------------------------------------------------
(defun C:CTR( / ss LT e p) ;;;Make Centroid Point
(setq
ss (ssget '((0 . "POLYLINE,LWPOLYLINE,CIRCLE,ELLIPSE")))
LT (ss2ent ss)
LT (vl-remove-if-not 'closed LT)
)
(foreach e LT
(setq p (get_cenp e))
(entmake (list (cons 0 "POINT") (cons 10 p)))
)
)
;;;-------------------------------------------------------------


Lấy Area, Perimeter, Vertex chắc bạn đã biết rồi?
  • 1

#8 dacvien2007

dacvien2007

    biết vẽ polygon

  • Members
  • PipPip
  • 75 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 10 December 2008 - 07:18 PM

Nhờ bạn giúp mình thêm Lisp lấy diện tích ghi dưới số thửa có đường gạch ngang, giửa đường gạch ngang ben trái yêu cầu nhập số thửa.
Thề hiện các cạnh thửa
Mong được bạn giúp
  • 0

#9 elleHCSC

elleHCSC

    biết lệnh copy

  • Members
  • PipPipPip
  • 119 Bài viết
Điểm đánh giá: 98 (tàm tạm)

Đã gửi 11 December 2008 - 08:52 AM

Loay hoay cả tối qua mới ra được thế này, cũng chưa kịp xem qua gợi ý của Ssg. elle up lên để Ssg dòm lại qua 1 lượt vì mình viết ko được sáng sủa lắm, dần dần sẽ update sau.
Hiện giờ đòi hỏi chỉ cần có Closed_Polyline còn việc tìm Centroid và tính diện tích, đánh số thửa đã giải quyết xong:
file vd chỉ cần như vầy :
http://www.cadviet.c...files/Out_2.dwg

;;;*****************************************************************;;;




;;; Tks to Ssg & all Cadviet members who make lisp impressed me much;;;
;;;*****************************************************************;;;

;;;*****************************************************
;;; Danh so thua tu dong cho thua dat (Closed_Polyline)
(defun c:dst ( / ent tongsothua)
(command "Undo" "Begin")
(command "osnap" "none")
(Tao_lop)
(setq ent (ssget "X" (list (cons 8 "gioithua")(cons 0 "LWPOLYLINE"))))
(if(= ent nil)(progn (alert "Kh«ng t×m thÊy thöa, h·y t¹o Closed_PolyLine trªn layer 'GioiThua' !"))
(progn
(setq ent (ssget "X" (list (cons 8 "GioiThua")(cons 0 "LWPOLYLINE"))))
(if (/= nil ent) (setq tongsothua(sslength ent) ))
(danhsothua tongsothua)
(alert (strcat "Cã tæng sè " (itoa tongsothua) " thöa ®Êt ®· ®­îc ®¸nh sè !" ))
);prog
);if
(command "Undo" "End")
)
;;;*****************************************************************************



**************
(defun danhsothua (tongsothua / ent List_cen List_sort List_ok i e1 e2)
(vl-load-com)
(setq ent (ssget "X" (list (cons 8 "GioiThua")(cons 0 "LWPOLYLINE"))))
(VE_CENTROID_DIENTICH ent)

(command "layer" "s" "SoThua" "")

; Buoc 1 - sort kieu descending cho point CentroID.Y (X trac dia)
(setq list_sort (vl-sort list_cen (function (lambda (e1 e2)(> (cadr e1)(cadr e2))))) )

; Buoc 2 - sort kieu ascending point CentroID tu trai sang phai truc X (Y trac dia)
(sort_trai_phai tongsothua list_sort)

; Ve so thua ra ban ve;
(setq i 0)
(while (< i tongsothua)
(wtxt2 (itoa (1+ i)) (nth i List_ok) "SoThua" "SoThua" 1 "C" "B" )
(setq i (1+ i))
)
)
;;;*****************************************************************************



**************
(defun VE_CENTROID_DIENTICH (ent / ent_gioithua i et Centroid Obj-vla dientich)
(command "layer" "s" "tmp_region" "")
(setq ent_gioithua (command "copy" ent "" (list 0 0) (list 0 0)) ) ; Luu lai ent tren layer gioithua;

(command "region" ent "")
(setq ent (ssget "X" (list (cons 8 "tmp_region")(cons 0 "REGION"))))

(command "layer" "s" "DienTich" "")
(setq i 0)
(while (< i (sslength ent))
(setq et (ssname ent i))
(setq Obj-vla (vlax-ename->vla-object et))
(setq centroid (vlax-safearray->list (vlax-variant-value (vla-get-centroid Obj-vla))))
(setq dientich (vla-get-area Obj-vla))
(wtxt2 (rtos dientich 2 1) centroid "DienTich" "DienTich" 1 "C" "T" )
(make_point centroid "CentroID")
(setq List_cen(append List_cen (list centroid)))
(setq i (1+ i))
)
(command "erase" ent "")
)
;;;*****************************************************************************



**************
(defun sort_trai_phai (tongsothua list_sort / list_tmp step sp ep m k p last_point chan dn)
(setq step (getreal "\n Nhap do rong cua giai danh so thua <20> : "))
(if (= step nil) (setq step 20) )
(setq
m (- tongsothua 1)
sp (+ (cadr(nth 0 list_sort)) (* step 0.5)) ; sp.Y + step*0.5
ep (cadr (nth m list_sort)) ; ep.Y
;num_down (+ (fix(/(- sp ep)step)) 1)
last_point (list (car(nth m list_sort)) (cadr(nth m list_sort)) )
chan 0 ; neu chan danh tu Trai sang phai, neu le danh tu Phai sang trai
dn 0
)
(while (> sp ep)
(setq k 0)
(setq list_tmp nil)
(while (< k m)
(if (and (<=(cadr(nth k list_sort)) sp) (>(cadr(nth k list_sort)) (- sp step)) )
(progn
(setq p (list (car(nth k list_sort)) (cadr(nth k list_sort))))
(setq List_tmp (append List_tmp (list p) ) )
)
)
(setq k (1+ k))
);while k
(setq dn (1+ dn))
(setq chan(rem dn 2))
(if (= chan 0)
(setq list_tmp (vl-sort list_tmp (function (lambda (e1 e2)(> (car e1)(car e2))))) ) ; chan
(setq list_tmp (vl-sort list_tmp (function (lambda (e1 e2)(< (car e1)(car e2))))) ) ; le
);if chan
(setq List_ok (append List_ok list_tmp))
(setq sp (- sp step))
);while sp;
(setq List_ok (append List_ok (list last_point) ) )
)
;;;*****************************************************************************



**************
(defun wtxt2 (txt p lay sty k hj vj / d h) ;;;Write txt on graphic screen (from Ssg - Cadviet forum)
;;;Specify txt, point, layer, style, scale factor, hor justify, ver justify
(setq
d (tblsearch "style" sty)
h (cdr (assoc 40 d))
LH (list "L" "C" "R") ;;;Left, Center, Right
LV (list "" "B" "M" "T") ;;;Bottom, Middle, Top
hcode (vl-position hj LH)
vcode (vl-position vj LV)
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
(list (cons 0 "TEXT") (cons 8 lay) (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 40 (* k h)) (assoc 41 d) (cons 72 hcode) (cons 73 vcode))
)
)
;;;*****************************************************************************



**************
(defun make_point (P Layer)
(entmake
(List
(cons 0 "POINT")
(cons 8 Layer)
(cons 10 P)
)
)
)
;;;*****************************************************************************



**************
(defun Tao_lop ( / tbl)
(setq tbl (TBLSEARCH "LAYER" "SoThua" ))
(if (= tbl nil)(command "layer" "n" "SoThua" "c" "Yellow" "SoThua" ""))

(setq tbl (TBLSEARCH "style" "SoThua" ))
(if (= tbl nil)(command "style" "SoThua" "romans.shx" "1.2" "0.8" "" "" "" ""))

(setq tbl (TBLSEARCH "LAYER" "CentroID" ))
(if (= tbl nil)(command "layer" "n" "CentroID" "c" "white" "CentroID" ""))

(setq tbl (TBLSEARCH "LAYER" "tmp_region" ))
(if (= tbl nil)(command "layer" "n" "tmp_region" "c" "8" "tmp_region" ""))

(setq tbl (TBLSEARCH "LAYER" "DienTich" ))
(if (= tbl nil)(command "layer" "n" "DienTich" "c" "Yellow" "DienTich" ""))
(setq tbl (TBLSEARCH "style" "DienTich" ))
(if (= tbl nil)(command "style" "DienTich" "romans.shx" "1.2" "0.8" "" "" "" ""))
)
;;;*****************************************************************************



**************


Chắc tới thì Ssg làm thêm cho cái GUI để user chọn option vì elle cũng thử cái dialog bằng file DCL nhưng sao lisp xử lý chuối thế. Thiết kế 1 cái dialog vất thật !
  • 1
Share for all, all will share !

--------------------
HTTP://WWW.HCSC.VN
HTTP://WWW.HCSC.COM.VN

#10 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 11 December 2008 - 11:09 AM

Tuyệt vời! Nhưng còn một chút "gợn gợn", bác xem lại: một số vị trí đánh số thửa ko liên tục, ví dụ từ thửa 14 đến 20, nó tréo hèo bác ạ!, đây là file kết quả:
http://www.cadviet.c...files/OutKQ.dwg
Bác đầu tư thêm cái này: tạo đường gạch ngang giữa số hiệu và diện tích, line này có độ dài bằng độ rộng của text box diện tích; Thêm tùy chọn chiều cao text.
Bái phục bác và cám ơn nhiều lắm
  • 0

#11 elleHCSC

elleHCSC

    biết lệnh copy

  • Members
  • PipPipPip
  • 119 Bài viết
Điểm đánh giá: 98 (tàm tạm)

Đã gửi 11 December 2008 - 02:20 PM

Nhưng còn một chút "gợn gợn", bác xem lại: một số vị trí đánh số thửa ko liên tục, ví dụ từ thửa 14 đến 20, nó tréo hèo bác ạ!


Thực tế là nó liên tục và elle biết chuyện đó, nguyên tắc đánh số thửa với giải thuật này là: Lấy centroid có toạ độ Y (X trắc địa) lớn nhất làm mốc chuẩn làm tâm giải thửa cần gán số sau đó duyệt từ trái sang phải nếu Cen nào có toạ độ X (Y trắc địa) nhỏ nhất trong giải thì gán số thứ tự từ 1 theo chiều từ trái sang phải. Hết giải đánh đó thì lùi giải xuống một giải (trừ đi giá trị của step) thì chọn Cen nào có toạ độ X (Y trắc địa) làl lớn nhất thì gán số thứ tự theo chiều ngược lại, lặp lại đến khi hết bản vẽ. Bạn sẽ thấy nó đánh không tréo ngoe khi bản đồ có các thửa sắp xếp ô vuông như bàn cờ vua, đó là điều kiện lý tưởng. Thực tế thì trong sx khi đo ra 1 cái bản đồ các hình thửa thường nằm lung tung lắm thửa thì to nhỏ, xoay ngang dọc các kiểu nên dùng cách gán số thửa nào thì cũng nhiều khi "không hợp mắt user" trong một số lần cụ thể, chỉ còn cách sửa bằng tay thôi. elle còn 1 vài giải thuật khác và cũng đã viết 1 tools khác để thực hiện việc này nhưng tất cả chúng cũng ko hoàn toàn thoả cái mắt của chính mình lắm đành chọn phương án này vì lý do sau:
- Đúng nguyên tắc đánh số thửa của quy phạm đề ra - Từ trên xuống dưới, rồi từ trái sang phải (Còn bác yêu cầu ziczac đó nha)
- Đơn giản
- Phương án này gần giống (không chính xác tuyệt đối) cách đánh số thửa của FAMIS - một tool chuẩn của ngành địa chính dùng cho Microstation, vì vào năm 1998 thì phải elle đã được đích thân một thành viên của nhóm FAMIS nói về nguyên tắc đánh số thửa của giải thuật này, khi chính elle cũng có câu hỏi tương tự như bác là đôi khi elle tìm số thửa trên bản đồ rất khó. Anh ta đã trả lời là: Bạn cứ lấy 1 cái thước dài to đè lên bản đồ có số thửa là 1 rồi lùi thước xuống 1 khoảng (step) là nhiêu đó khi user đặt trước khi chạy CT, sau đó liếc từ trái sang phải (hoặc từ phải sang trái nếu ziczac) trong khoảng rộng của cái thước đó là sẽ tìm ra các số thửa liên tiếp.

* Đường gạch ngang là chuyện nhỏ, chắc chắn là elle sẽ xong. Cái này sẽ hoàn thiện khi thiết kế được giao diện cho user chọn các option để có thể chỉnh sửa cho tỷ lệ bản đồ. Hiện tại elle lấy các giá trị tương ứng cho bản đồ tỷ lệ 1/500.
  • 0
Share for all, all will share !

--------------------
HTTP://WWW.HCSC.VN
HTTP://WWW.HCSC.COM.VN

#12 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 12 December 2008 - 01:55 PM

Chắc tới thì Ssg làm thêm cho cái GUI để user chọn option vì elle cũng thử cái dialog bằng file DCL nhưng sao lisp xử lý chuối thế. Thiết kế 1 cái dialog vất thật !

Đúng vậy, thiết kế dialog bằng lisp khá vất vả. Đây chính là nhược điểm của lisp, phải chấp nhận thôi. Tất nhiên, nếu thấy cần thiết thì cũng phải chịu khó làm.
Sau đây là ví dụ về Options Dialog để user chọn giải thửa:

http://www.cadviet.c.../DanhSoThua.zip
(giải nén và đọc readme)

Trên cơ sở đó, bạn có thể phát triển thêm (bổ sung ngay trong file *.dcl và *.lsp đã có, không cần tạo file mới). Nếu muốn ssg làm hoàn thiện, bạn cần mô tả chi tiết: trong dialog có những thành phần nào, đặc điểm, chức năng, công dụng của từng thành phần... và tốt nhất là có hình vẽ minh hoạ. Ssg không am hiểu chuyên ngành, e rằng làm mất công nhưng không đúng ý các bạn.
  • 0

#13 elleHCSC

elleHCSC

    biết lệnh copy

  • Members
  • PipPipPip
  • 119 Bài viết
Điểm đánh giá: 98 (tàm tạm)

Đã gửi 15 December 2008 - 10:37 AM

elle mới offline vài ngày giờ mới vô diễn đàn nên cùng trao đổi với các bạn được. Có sự trợ giúp của Ssg thì coi như vụ này chắc chắn xong, vấn đề chỉ còn là thời gian thôi. Bác Ssg coding gọn thật, rất tổng quát, đó là cái anh em sẽ còn phải học dài dài. Dưới đây là form elle mô phỏng qua các yêu cầu cần cho đánh số thửa, tính diện tích cho các thửa đất, up lên để lấy ý kiến thông qua trước sau đó sẽ tổng hợp lại và đi đến thống nhất cao là được:
http://www.cadviet.c...es/Form_DST.zip
(giải nén chạy file EXE)
elle thiết kế 1 cái form trên delphi vì dễ làm chứ DCL của cad loay hoay mãi chưa thoả lắm, ko sao ssg xem thử nhé !

Yêu cầu đầu vào khi chạy lệnh đánh số thửa :
1. Các thửa đất được đóng vùng thành các Closed_plyline, làm bằng cách nào thì tuỳ.

2. Khi chạy CT sẽ quét toàn bộ bản vẽ lọc ra các lớp có đối tượng là Closed_Polyline và đưa tên lớp vào ComboBox_List để user chọn.
Các yếu tố khác CT sẽ đưa ra các giá trị Default :

- "Bắt đầu đánh số từ " : 1 (Default )
- "Độ rộng" : 20m (độ rộng giải đánh số thửa Default )
- "Đặt tên lớp số thửa" : Default là "SoThua" user có thể thay đổi. Nếu chưa có layer này khi bấm nút OK thì CT sẽ tạo ra lớp này.
- "Cao chữ" : 1 (Default ) là chiều cao của text sothua, user có thể tự thay đồi
- "Đặt tên lớp diện tích" : Default là "DienTich" user có thể thay đổi. Nếu chưa có layer này khi bấm nút OK thì CT sẽ tạo ra lớp này.
- "Cao chữ" : 1 (Default ) là chiều cao của text DienTich, user có thể tự thay đồi
- "Đặt tên lớp gạch ngang" : Default là "GachNgang" user có thể thay đổi. Nếu chưa có layer này khi bấm nút OK thì CT sẽ tạo ra lớp này.

- "Tỷ lệ BĐ" : 1/500 (Default ). User chọn cái này thì tuỳ thuộc vào tỷ lệ mà ta có thế tính ra chiều dài của nét gạch ngang đặt giữa số thửa và diện tích. Cũng có thể tuỳ thuộc tỷ lệ bản đồ mà ta có thể tính ra luôn chuiêù cao chữ của text "Sothua" và "DienTich", độ rộng của các text này thì ta fix luôn with=0.8

3. Nên theo ý của Ssg là chọn tập hợp các Closed_Plyline bằng lệnh ss (ssget '((0 . "POLYLINE,LWPOLYLINE,CIRCLE,ELLIPSE"))) và check xem các đối tượng này có Closed hay ko, nếu có thì mới đưa vào tính toán: LT (vl-remove-if-not 'closed LT)
. Theo elle thì trong trường hợp cụ thể này thì nên dùng hàm: (vlax-curve-isClosed curve-obj) hơn là check xem toạ độ start_point=end_point vì như vậy mới đồng nhất được cách user làm, tránh trong bản vẽ có cả hai loại: 1. Closed_plyline khi user dùng lệnh BO, 2. "Closed_plyline" khi user nối một thửa đất có start_point=end_point mà quên chưa "Closed" theo định nghĩa của CAD.


Trong thực tế với bản đồ địa chính chỉ cần : ss (ssget '((0 . "POLYLINE,LWPOLYLINE"))) vì không ai dùng Circle và ELLIPSE để vẽ ranh giới thửa đất cả, nếu dùng thì họ sẽ ko "bóc" ra được tọa độ đỉnh thửa phục vụ cho làm hồ sơ kỹ thuật sau này.

Sorry bác Desperadosvn nha vì anh em cứ làm ngược là ngồi coding sơ bộ rồi mới thiết kế yêu cầu, đáng lẽ phải làm ngược lại theo như các project thực thụ...khổ thế chớ

Sơ lược như vậy đã, lấy ý kiến bà con rồi anh em cùng làm cho vụ này hoàn chỉnh...khớ khớ
  • 0
Share for all, all will share !

--------------------
HTTP://WWW.HCSC.VN
HTTP://WWW.HCSC.COM.VN

#14 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 15 December 2008 - 11:58 AM

Sơ lược như vậy đã, lấy ý kiến bà con rồi anh em cùng làm cho vụ này hoàn chỉnh...khớ khớ

Bác đã bắn trúng tim mấy anh thành lập bản đồ địa chính rồi còn gì mà góp ý!
Đọc qua mình thấy "ghiền" liền.
ừ mà có nên thêm cái vụ thiết lập màu cho mỗi layer Ko nhỉ
  • 0

#15 elleHCSC

elleHCSC

    biết lệnh copy

  • Members
  • PipPipPip
  • 119 Bài viết
Điểm đánh giá: 98 (tàm tạm)

Đã gửi 15 December 2008 - 12:31 PM

ừ mà có nên thêm cái vụ thiết lập màu cho mỗi layer Ko nhỉ


Có lẽ thuộc tính màu ta không nên cho vào làm gì cho cái form nó thêm phức tạp, tránh rối mắt. Cần nhất là các yếu tố cơ bản, còn đã phân lớp (layer) rồi thì còn color chỉ là chuyện nhỏ với các user, cái đó để họ tuỳ thích theo mắt của mỗi người.

Lisp có hàm nào để lấy tên của các layer trong bản vẽ thoả mãn điều kiện Closed_plyline rồi mới nhét nó vô cái List_box trong Input_form cho user chọn không các bác ?
  • 0
Share for all, all will share !

--------------------
HTTP://WWW.HCSC.VN
HTTP://WWW.HCSC.COM.VN

#16 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 18 December 2008 - 08:07 AM

@elleHCSC:
Dcl và lisp liên quan đến form nhập liệu của user:

http://www.cadviet.c...nhSoThua_00.zip

1. Ssg tách riêng nó ra để khỏi bị "nhiễu" với code của bạn. Kết quả sau khi chạy dialog là các giá trị do user chọn được gán cho các biến tương ứng. Bạn tuỳ nghi sử dụng và phối hợp với chương trình chính.

2. Điều khiển vị trí các thành phần trên dialog bằng dcl rất khó được như ý muốn. Ssg đã chơi thẳng 1 hàng từ trên xuống dưới cho đơn giản. Điều đó chắc cũng không quan trọng, miễn là có cái form thuận tiện cho user chọn và nhập liệu là được rồi. Như đã nói ở bài trước, đây là nhược điểm của lisp, đã chơi với nó thì phải chấp nhận!

3. Theo ssg, bạn gộp các thao tác cần thiết trong Tao_lop vào chung với Pre_DST cho gọn.

Chúc thành công!
  • 0

#17 elleHCSC

elleHCSC

    biết lệnh copy

  • Members
  • PipPipPip
  • 119 Bài viết
Điểm đánh giá: 98 (tàm tạm)

Đã gửi 19 December 2008 - 10:11 AM

@elleHCSC:
Dcl và lisp liên quan đến form nhập liệu của user:

http://www.cadviet.c...nhSoThua_00.zip

1. Ssg tách riêng nó ra để khỏi bị "nhiễu" với code của bạn. Kết quả sau khi chạy dialog là các giá trị do user chọn được gán cho các biến tương ứng. Bạn tuỳ nghi sử dụng và phối hợp với chương trình chính.

2. Điều khiển vị trí các thành phần trên dialog bằng dcl rất khó được như ý muốn. Ssg đã chơi thẳng 1 hàng từ trên xuống dưới cho đơn giản. Điều đó chắc cũng không quan trọng, miễn là có cái form thuận tiện cho user chọn và nhập liệu là được rồi. Như đã nói ở bài trước, đây là nhược điểm của lisp, đã chơi với nó thì phải chấp nhận!

3. Theo ssg, bạn gộp các thao tác cần thiết trong Tao_lop vào chung với Pre_DST cho gọn.

Chúc thành công!


Xong roài, elle đã fix xong !
Do hạn chế của DCL nên còn chuyện bẫy và bắt lỗi của form nhập liệu cũng chưa ưng ý lắm, cứ đành thế vậy. Khi sử dụng các bác lưu ý cho chuyện này và nhất là chiều cao của text sothua, dientich. Đáng lẽ chọn xong mẫu số tỷ lệ bản đồ thì cao chữ cũng tự có thể tính tương ứng được luôn nhưng theo nguyện vọng của tnmtpc cứ để thêm vào để cho mọi người tuỳ biến. Điều này có thể thấy trong một số lần chạy nếu user chọn xong mẫu số bản đồ mà quên nhập lại cao text tương ứng thì sẽ thấy cái nét gạch ngang sẽ không chính xác.

Còn một hạn chế nữa của phương án này theo như tnmtpc đã nêu nếu thửa đất có hình dạng chữ U thì vị trí của point CentroID sẽ bị "nhảy" sang thửa khác. Các bác yên tâm là diện tích thì vẫn chính xác, chỉ có vị trí nó lẫn sang thửa khác thôi ==> chạy xong move nó bằng tay nhé :cheers:

Các bác nhớ khi move thì lôi cả 4 đối tuợng luôn thể nhé: sothua, dientich, gachngang, poin centroid. Đừng có xoá cái point CentroID nha, nó khá quan trọng vì cái point đó có toạ độ trùng với text sothua, dientich nên hãy để dành nó cho công tác tiếp theo ==> lập HSKT thửa đất. Sau này khi lập HSKT thửa đất elle đã nghĩ ra phương án là chỉ việc tìm Closed_PolyLine không phải tính toán gì nữa chỉ cần duyệt qua xem point CentroID nó có nằm trong thửa không thì gắp ngay cái text sothua, dientich, gachngang kia (vì toạ độ text sothua, dientich trùng toạ độ point CentroID) là đã "túm" được thửa đất đó roài...

Lệnh là : DSTH
http://www.cadviet.c...anhSoThua_1.zip

Chúc vui !
  • 3
Share for all, all will share !

--------------------
HTTP://WWW.HCSC.VN
HTTP://WWW.HCSC.COM.VN

#18 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 19 December 2008 - 07:04 PM

Các bác nhớ khi move thì lôi cả 4 đối tuợng luôn thể nhé: sothua, dientich, gachngang, poin centroid. Đừng có xoá cái point CentroID nha, nó khá quan trọng vì cái point đó có toạ độ trùng với text sothua, dientich nên hãy để dành nó cho công tác tiếp theo ==> lập HSKT thửa đất. Sau này khi lập HSKT thửa đất elle đã nghĩ ra phương án là chỉ việc tìm Closed_PolyLine không phải tính toán gì nữa chỉ cần duyệt qua xem point CentroID nó có nằm trong thửa không thì gắp ngay cái text sothua, dientich, gachngang kia (vì toạ độ text sothua, dientich trùng toạ độ point CentroID) là đã "túm" được thửa đất đó roài...

Lệnh là : DSTH
http://www.cadviet.c...anhSoThua_1.zip

Chúc vui !

Tuyệt vời lắm ElleHCSC! :cheers:
Thêm một công việc nặng nhọc nữa cho Bác nè, Muốn làm hồ sơ kỹ thụât phải có thông tin loại đất , chủ sử dụng và địa chỉ. Bác nghiên cứu một form nhập các thông tin này liên hệ với point centroid để khi tạo hồ sơ KT, nó bợ đủ cả chì lẫn chài đưa vào HSKT luôn
  • 0

#19 cadcadcad

cadcadcad

    Chưa sử dụng CAD

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

Đã gửi 20 December 2008 - 01:28 PM

Các bác nhớ khi move thì lôi cả 4 đối tuợng luôn thể nhé: sothua, dientich, gachngang, poin centroid. Đừng có xoá cái point CentroID nha, nó khá quan trọng vì cái point đó có toạ độ trùng với text sothua, dientich nên hãy để dành nó cho công tác tiếp theo ==> lập HSKT thửa đất. Sau này khi lập HSKT thửa đất elle đã nghĩ ra phương án là chỉ việc tìm Closed_PolyLine không phải tính toán gì nữa chỉ cần duyệt qua xem point CentroID nó có nằm trong thửa không thì gắp ngay cái text sothua, dientich, gachngang kia (vì toạ độ text sothua, dientich trùng toạ độ point CentroID) là đã "túm" được thửa đất đó roài...
Lệnh là : DSTH
http://www.cadviet.c...anhSoThua_1.zip
Pro ơi làm ơn chỉ cho em cách tạo CentroID với. nếu có tài liệu hoặc đoạn help thì Bác chỉ giúp nhé. Cho em xin link nào để load dc cadmap anh nhé. em tìmhoài, dký rồi mà chẳng dc nên tức lắm. lần này mong Pro giúp. Thank trước 1000 lần!
  • 0

#20 elleHCSC

elleHCSC

    biết lệnh copy

  • Members
  • PipPipPip
  • 119 Bài viết
Điểm đánh giá: 98 (tàm tạm)

Đã gửi 20 December 2008 - 02:07 PM

Pro ơi làm ơn chỉ cho em cách tạo CentroID với. nếu có tài liệu hoặc đoạn help thì Bác chỉ giúp nhé. Cho em xin link nào để load dc cadmap anh nhé. em tìmhoài, dký rồi mà chẳng dc nên tức lắm. lần này mong Pro giúp. Thank trước 1000 lần!


Bạn download cái phần tính diện tích trên về chạy là dc, tự nó tìm và tạo centroID (có cái point nằm ngay đúng vị trí text sothua, dientich đó, trên layer Centroid)

Còn autodesk map thì cứ ra chợ mà mua, có 5000 vnd 1 cái cd đó mà, có cả k e y mà...tìm và down trên mạng làm gì cho nó tốn tiền internet
  • 0
Share for all, all will share !

--------------------
HTTP://WWW.HCSC.VN
HTTP://WWW.HCSC.COM.VN