Đến nội dung


Hình ảnh
- - - - -

'Tạo khung bản đồ'


  • Please log in to reply
49 replies to this topic

#1 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 08 August 2010 - 11:39 AM

Hiện tại mình có lisp tạo khung bản đồ tự động rất hay. Nhưng mình vẫn chưa hài lòng lắm vì chỉ tạo được khung bản đồ ở khi hình chữ nhật ở dạng đứng, nếu hình chữ nhật mà bị nghiêng thì không đúng theo ý muốn.
Mình post lên đây lisp đó, nếu ai cần thì download về dùng tạm.

;;; Tu dong ve khung ban do .

 (defun c:kh ()
;;; (princ "\n CHUONG TRINH VE KHUNG BAN DO .")
(command "osnap" "Endpoint,Intersection")
(setvar "blipmode" 1)
(setq sp (getpoint "\n Chon goc khung thu 1 (Goc trai ben tren): "))
(setq ep (getpoint sp "\n Chon goc khung thu 2 (Goc phai ben duoi): "))

; (princ "\n Chon goc khung thu 1 (Goc trai ben tren): ")
; (setq sp (getpoint))

; (prompt "\n Chon goc khung thu 2 (Goc phai ben duoi): ")
; (setq ep (getcorner (getpoint)) )
(command "osnap" "off")

(setq tyle (getint "\n Hay cho ty le ban do <500>: "))
(if (= tyle nil) (setq tyle 500.0))
(setvar "blipmode" 0)
;;--- Dat bien chung cho chuong trinh -----
(setq x1 (nth 0 sp)) (setq y1 (nth 1 sp))
(setq x2 (nth 0 ep)) (setq y2 (nth 1 ep))
(setq dayn (/ (* tyle 0.05) 500.0))
(setq kctn (/ tyle 142.857))
(setq ktmk (/ (* tyle 1.75) 500.0))
(setq caoc (/ (* tyle 0.90) 500.0))
(setq dich (/ (* tyle 0.33) 500.0))
;;;---- ve khung trong ------
(command "LAYER" "M" "KHUNG" "")
(Command "PLINE"
(list x1 y1)
(list x2 y1)
(list x2 y2)
(list x1 y2)
"C"
)
;;;;-------Ve khung ngoai ----------
(command "LAYER" "M" "KHUNG" "")
(Command "PLINE"
(list (- x1 kctn) (+ y1 kctn)) "w" dayn dayn
(list (+ x2 kctn) (+ y1 kctn))
(list (+ x2 kctn) (- y2 kctn))
(list (- x1 kctn) (- y2 kctn))
"C"
)
;;;------- Ve net ngang va doc -------
(setq nhay (/ tyle 10.0))
(setq tmpX1 (/ x1 nhay)) (setq tmpX2 (fix tmpX1)) (setq x (* tmpX2 nhay))
(setq tmpY1 (/ y2 nhay)) (setq tmpY2 (fix tmpY1)) (setq y (* tmpY2 nhay))
;-------------------------------------
(command "style" "STANDARD" "" caoc "" "" "" "" "" "")
(while (<= x x2)
(if (>= x x1)
(command "LINE" (list x y1) (list x (+ y1 kctn)) ""
"LINE" (list x y2) (list x (- y2 kctn)) ""
"TEXT" "C" (list x (+ y1 (/ kctn 2))) 0. (rtos x 2 0)
"TEXT" "TC" (list x (- y2 (/ kctn 2))) 0. (rtos x 2 0)
)
) ;endif
(setq x (+ x nhay))
)
(while (<= y y1)
(setq tmp1 (rtos y 2 0))
(setq len1 (strlen tmp1))
(if ( <= len1 3)
(progn (setq bef "000") (setq aff tmp1))
(progn (setq bef (substr tmp1 1 (- len1 3)))
(setq aff (substr tmp1 (- len1 2) 3))
)
) ;;if
(if (>= y y2)
(command "LINE" (list x1 y) (list (- x1 kctn) y) ""
"LINE" (list x2 y) (list (+ x2 kctn) y) ""
"TEXT" "BC" (list (- x1 (/ kctn 2)) y) 0. bef
"TEXT" "TC" (list (- x1 (/ kctn 2)) (- y dich)) 0. aff

"TEXT" "BC" (list (+ x2 (/ kctn 2)) y) 0. bef
"TEXT" "TC" (list (+ x2 (/ kctn 2)) (- y dich)) 0. aff
)
); endif
(setq y (+ y nhay))
)
;--------- Ve chu thap --------------
(setq nhay (/ tyle 10.0)) (setq tmpX1 (/ x1 nhay)) (setq tmpX2 (fix tmpX1))
(setq x (* tmpX2 nhay))
(setq tmpY1 (/ y2 nhay)) (setq tmpY2 (fix tmpY1))
(while (< x x2)
(setq y (* tmpY2 nhay))
(while (< y y1)
(if (and (>= x x1) (>= y y2))
(command "LINE" (list (- x ktmk) y) (list (+ x ktmk) y) "")
)
(if (and (>= y y2) (>= x x1))
(command "LINE" (list x (- y ktmk)) (list x (+ y ktmk)) "")
)
(setq y (+ y nhay))
)
(setq x (+ x nhay))
)
(command "REDRAW")
); End of program



Xin nhờ các pro có thể chỉnh sửa giúp lisp này được ko?
Với thuật toán như trên, mình muốn quét 1 lần tất cả các hình như nhật (kể cả các hình chữ nhật bị nghiêng) ta tạo được các mắt lưới dấu thập (các mắt lưới đều song song với trục X và trục Y) đồng thời trên khung ghi text các tọa độ của mắt lưới đó. Mình upload ví dụ lên đây. Kính mong các Pro giúp đỡ
Ví dụ : http://www.4shared.c...khungtoado.html
Cảm ơn mọi người đã quan tâm.
Chương trình này mình đã dùng ở TEDIPORT nhưng đó là phần mềm tích hợp trong Cad phải cài đặt
Nó tên là EGS hay gì đó mà lâu rồi mình không nhớ nổi. Trên khung mình có thể ghi theo tọa độ X Y hay tọa độ địa lý B L đều được hết
Nếu ai có phần mềm đó có thể gửi cho mình được không?
Bạn có thể upload lên diễn đàn để mọi người cùng dùng hoặc gửi vào hòm thư: heaven2407@gmal.com
Chân thành cảm ơn
  • 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







#2 tiendaica

tiendaica

    biết zoom

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

Đã gửi 11 August 2010 - 02:25 PM

hay nhưng thêm toạ đọ x,y ở hình chữ thập thì tuyệt vời! các men xem thử được không giúp anh em trong diễn đàn với
  • 0

#3 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 11 August 2010 - 02:38 PM

Mình đã tìm được phần mềm EGS (bao gồm E-soft và e-program). Ai cần mình sẽ gửi cho
địa chỉ Mail của mình là: heaven2407@gmail.com
  • 0



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







#4 tiendaica

tiendaica

    biết zoom

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

Đã gửi 12 August 2010 - 11:04 AM

Mình đã tìm được phần mềm EGS (bao gồm E-soft và e-program). Ai cần mình sẽ gửi cho
địa chỉ Mail của mình là: heaven2407@gmail.com

bạn gửi cho mình nhé mail mình Vantynet@yahoo.com!!!!!!!!!!!!!!! thanksssssssssssss
  • 0

#5 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 12 August 2010 - 11:45 AM

bạn gửi cho mình nhé mail mình Vantynet@yahoo.com!!!!!!!!!!!!!!! thanksssssssssssss

Mình shared cho mọi người luôn. Có gì không hiểu phần mềm này thì bạn hãy Mail cho mình nhé
thanhduan_mda@yahoo.com
or
heaven2407@gmail.ocm
Địa chỉ download đây:http://www.4shared.com/file/R5zzCdWX/Thanhduan.html
  • 0



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







#6 tiendaica

tiendaica

    biết zoom

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

Đã gửi 13 August 2010 - 10:21 PM

bạn up qua trang khác được không sao down lâu quá nó rởt mạng ! mong bạn up lai cho
  • 0

#7 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 13 August 2010 - 11:45 PM

bạn up qua trang khác được không sao down lâu quá nó rởt mạng ! mong bạn up lai cho

Phần mềm EGS 58Mb nên hơi nặng một chút. Nó tích hợp vào Cad và thực hiện rất nhiều chức năng. Bạn đợi sau 90s thì load về.
Mình đã thử đường link chạy rất tốt. Mình sẽ upload huớng dẫn sử dụng vào 1 ngày gần nhất có thể. Chúc bạn gặp nhiều may mắn
  • 0



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







#8 tiendaica

tiendaica

    biết zoom

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

Đã gửi 19 August 2010 - 01:45 PM

bạn có thể gửi file hướng dẫn không bạn rất cám ơn ban mong được bạn giúp đỡ ! chúc bạn hạnh phuc và may mắn trong cuộc sống !
  • 0

#9 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 19 August 2010 - 02:03 PM

bạn có thể gửi file hướng dẫn không bạn rất cám ơn ban mong được bạn giúp đỡ ! chúc bạn hạnh phuc và may mắn trong cuộc sống !

Dạo này mình bận quá nên cũng chưa viết xong. Công trình đang nhiều mà mình phải luôn tay và thỉnh thoảng ghé qua thăm diễn đàn. Mong rằng tuần sau mình có thể upload nó lên được. Cảm ơn bạn vì lời chúc. À cho mình hỏi. Công việc của bạn đang làm là gì vậy? Và phương pháp bạn đang cần để thực hiện công việc là gì để mình nói kỹ vấn đề đó. Nếu bạn cần vấn đề gì thì hãy lên diễn đàn trao đổi nha. Chúc bạn vui vẻ
  • 0



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







#10 NDBNGO

NDBNGO

    biết lệnh rotate

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

Đã gửi 19 August 2010 - 03:48 PM

Gửi bạn Thanhduan2407
Mình vừa xem và chạy thử lisp khung của bạn và có 1 số nhận xét sau:
1.Đây mới thuần túy vẽ hình khung
2. Thiếu tỷ lệ xích bản đồ .
3. Mầu sắc và hình thức text không theo quy định ký hiệu bản đồ và địa chính.
4.Chương trình chỉ mới ốp cái hình khung lên bản vẽ.
5.Không thể hiện được tọa độ góc khung.
Vậy bạn phải viết thêm các phần trên ,riêng mục 4 khi chỉ vào bản vẽ phải tự dộng cắt được các phần năm ngoài bản vẽ.
Mình cũng làm trắc địa ,nhưng chưa hiểu khái niệm hình chua nhật xiên (Hay đó là vẽ khung xiên cho các công trình dạng tuyến ,các công trình này chỉ thể hiện các mắt lưới và ghi trực tiếp tọa độ vào mắt lưới thôi).
mấy điều góp ý để bạn cải tiến.
Nhưng thực ra vấn đề này đã được giải quyết bằng rất nhiều chương trình và đã tương đối hoàn thiện (Như topo...) bạn tham khảo.
Chứ đã viết ra là cố gắng phải hay hơn cái đã có .Cố gắng viêt hướng đối tượng và gắn liền với thực tế sản xuât,thường xuyên nâng cấp khi công nghệ đòi hỏi thì phần mình viết mới có giá trị .
Chúc bạn thành công.
Ngô Đông Phương 0988529640
  • 0

#11 tiendaica

tiendaica

    biết zoom

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

Đã gửi 19 August 2010 - 10:13 PM

à mình đang làm bên giao thông cái mình cần là lisp vẽ khung bản đồ va lisp ghi toạ độ x,y lên mắc lưới ! nếu bạn có thì cho mình nhé mình cám ơn ban rất nhiều
  • 0

#12 NDBNGO

NDBNGO

    biết lệnh rotate

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

Đã gửi 19 August 2010 - 10:16 PM

Nhưng cái đó mình viết từ 1995 qua pascal chạy *.dxf,*.scr,*.lsp nhưng bây giờ dùng nó nghe trẻ con quá, chưa sửa lại được.Tạm thời bạn sử dụng topo5.0 nhé .Trong đó có đủ hết rồi đó .
Nhiều phần chưa hợp vơi quy phạm Việt song để làm cũng tốt đó .
Chúc bạn thành công.
Ngô Đông Phương 0988529640
  • 0

#13 NDBNGO

NDBNGO

    biết lệnh rotate

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

Đã gửi 19 August 2010 - 10:51 PM

Mình gửi mẫu chuẩn khung bản vẽ để bạn nghiên cứu nhé,viết từ lâu nhưng vẫn hợp quy phạm hiện nay .

http://www.4shared.c...fOa8/KHUNG.html
  • 1

#14 nguyentuan_hagl

nguyentuan_hagl

    Chưa sử dụng CAD

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

Đã gửi 22 August 2010 - 01:56 PM

Hiện tại mình có lisp tạo khung bản đồ tự động rất hay. Nhưng mình vẫn chưa hài lòng lắm vì chỉ tạo được khung bản đồ ở khi hình chữ nhật ở dạng đứng, nếu hình chữ nhật mà bị nghiêng thì không đúng theo ý muốn.
Mình post lên đây lisp đó, nếu ai cần thì download về dùng tạm.

;;; Tu dong ve khung ban do .

 (defun c:kh ()
;;; (princ "\n CHUONG TRINH VE KHUNG BAN DO .")
(command "osnap" "Endpoint,Intersection")
(setvar "blipmode" 1)
(setq sp (getpoint "\n Chon goc khung thu 1 (Goc trai ben tren): "))
(setq ep (getpoint sp "\n Chon goc khung thu 2 (Goc phai ben duoi): "))

; (princ "\n Chon goc khung thu 1 (Goc trai ben tren): ")
; (setq sp (getpoint))

; (prompt "\n Chon goc khung thu 2 (Goc phai ben duoi): ")
; (setq ep (getcorner (getpoint)) )
(command "osnap" "off")

(setq tyle (getint "\n Hay cho ty le ban do <500>: "))
(if (= tyle nil) (setq tyle 500.0))
(setvar "blipmode" 0)
;;--- Dat bien chung cho chuong trinh -----
(setq x1 (nth 0 sp)) (setq y1 (nth 1 sp))
(setq x2 (nth 0 ep)) (setq y2 (nth 1 ep))
(setq dayn (/ (* tyle 0.05) 500.0))
(setq kctn (/ tyle 142.857))
(setq ktmk (/ (* tyle 1.75) 500.0))
(setq caoc (/ (* tyle 0.90) 500.0))
(setq dich (/ (* tyle 0.33) 500.0))
;;;---- ve khung trong ------
(command "LAYER" "M" "KHUNG" "")
(Command "PLINE"
(list x1 y1)
(list x2 y1)
(list x2 y2)
(list x1 y2)
"C"
)
;;;;-------Ve khung ngoai ----------
(command "LAYER" "M" "KHUNG" "")
(Command "PLINE"
(list (- x1 kctn) (+ y1 kctn)) "w" dayn dayn
(list (+ x2 kctn) (+ y1 kctn))
(list (+ x2 kctn) (- y2 kctn))
(list (- x1 kctn) (- y2 kctn))
"C"
)
;;;------- Ve net ngang va doc -------
(setq nhay (/ tyle 10.0))
(setq tmpX1 (/ x1 nhay)) (setq tmpX2 (fix tmpX1)) (setq x (* tmpX2 nhay))
(setq tmpY1 (/ y2 nhay)) (setq tmpY2 (fix tmpY1)) (setq y (* tmpY2 nhay))
;-------------------------------------
(command "style" "STANDARD" "" caoc "" "" "" "" "" "")
(while (<= x x2)
(if (>= x x1)
(command "LINE" (list x y1) (list x (+ y1 kctn)) ""
"LINE" (list x y2) (list x (- y2 kctn)) ""
"TEXT" "C" (list x (+ y1 (/ kctn 2))) 0. (rtos x 2 0)
"TEXT" "TC" (list x (- y2 (/ kctn 2))) 0. (rtos x 2 0)
)
) ;endif
(setq x (+ x nhay))
)
(while (<= y y1)
(setq tmp1 (rtos y 2 0))
(setq len1 (strlen tmp1))
(if ( <= len1 3)
(progn (setq bef "000") (setq aff tmp1))
(progn (setq bef (substr tmp1 1 (- len1 3)))
(setq aff (substr tmp1 (- len1 2) 3))
)
) ;;if
(if (>= y y2)
(command "LINE" (list x1 y) (list (- x1 kctn) y) ""
"LINE" (list x2 y) (list (+ x2 kctn) y) ""
"TEXT" "BC" (list (- x1 (/ kctn 2)) y) 0. bef
"TEXT" "TC" (list (- x1 (/ kctn 2)) (- y dich)) 0. aff

"TEXT" "BC" (list (+ x2 (/ kctn 2)) y) 0. bef
"TEXT" "TC" (list (+ x2 (/ kctn 2)) (- y dich)) 0. aff
)
); endif
(setq y (+ y nhay))
)
;--------- Ve chu thap --------------
(setq nhay (/ tyle 10.0)) (setq tmpX1 (/ x1 nhay)) (setq tmpX2 (fix tmpX1))
(setq x (* tmpX2 nhay))
(setq tmpY1 (/ y2 nhay)) (setq tmpY2 (fix tmpY1))
(while (< x x2)
(setq y (* tmpY2 nhay))
(while (< y y1)
(if (and (>= x x1) (>= y y2))
(command "LINE" (list (- x ktmk) y) (list (+ x ktmk) y) "")
)
(if (and (>= y y2) (>= x x1))
(command "LINE" (list x (- y ktmk)) (list x (+ y ktmk)) "")
)
(setq y (+ y nhay))
)
(setq x (+ x nhay))
)
(command "REDRAW")
); End of program

Xin nhờ các pro có thể chỉnh sửa giúp lisp này được ko?
Với thuật toán như trên, mình muốn quét 1 lần tất cả các hình như nhật (kể cả các hình chữ nhật bị nghiêng) ta tạo được các mắt lưới dấu thập (các mắt lưới đều song song với trục X và trục Y) đồng thời trên khung ghi text các tọa độ của mắt lưới đó. Mình upload ví dụ lên đây. Kính mong các Pro giúp đỡ
Ví dụ : http://www.4shared.c...khungtoado.html
Cảm ơn mọi người đã quan tâm.
Chương trình này mình đã dùng ở TEDIPORT nhưng đó là phần mềm tích hợp trong Cad phải cài đặt
Nó tên là EGS hay gì đó mà lâu rồi mình không nhớ nổi. Trên khung mình có thể ghi theo tọa độ X Y hay tọa độ địa lý B L đều được hết
Nếu ai có phần mềm đó có thể gửi cho mình được không?
Bạn có thể upload lên diễn đàn để mọi người cùng dùng hoặc gửi vào hòm thư: heaven2407@gmal.com
Chân thành cảm ơn


  • 0

#15 tiendaica

tiendaica

    biết zoom

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

Đã gửi 25 August 2010 - 10:19 PM

sao mình tạo đối tương trong topo , mình lưu lại và mở bằng cad thi không thấy được có cách nào lấy được toạ độ đó không
  • 0

#16 NDBNGO

NDBNGO

    biết lệnh rotate

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

Đã gửi 25 August 2010 - 10:48 PM

Bạn gửi bản vễ lên xem .chưa hiểu ý bạn.
Gửi lê nđi và bạn muốn gì trong đó.
  • 0

#17 ro88

ro88

    biết vẽ arc

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

Đã gửi 29 September 2012 - 02:27 PM

Mình có cái khung tên này do ở công ty mình làm từ lâu giờ. toàn bộ làm thủ công hết.nhưng đối với bản vẽ nhỏ thì còn đỡ chứ mấy bản vẽ lớn thì làm mất phải vài ngày.Nhờ các bạn dựa trên khung tên có sẵn trên bản vẽ có thể viết cho mình cái lisp để làm cho nhanh hơn được ko. Cảm ơn rất nhiều.
đây là bản mẫu:


http://www.cadviet.c...51_khung_to.dwg

Mong được các bạn quan tâm .
  • 0

#18 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5683 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 29 September 2012 - 04:13 PM

Đang ở topic tạo mắt lưới cho khung bản đồ, bạn vô khung bản vẽ làm j ?
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#19 ro88

ro88

    biết vẽ arc

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

Đã gửi 29 September 2012 - 04:35 PM

post nhầm topic sorry nhé.
  • 0

#20 VoHoan

VoHoan

    biết lệnh move

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

Đã gửi 29 September 2012 - 05:27 PM

post nhầm topic sorry nhé.

Mình thấy ro88 là người nóng vội hay không đọc quy định của CadViet thì đúng hơn là "nhầm". Hôm qua Ketxu đã nhắc nhớ bạn 1 lần rồi đó!
  • 0