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

'Tạo khung bản đồ'

Bởi thanhduan2407 , trong AutoLisp

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

thanhduan2407    272

thanhduan2407
Đã đăng

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.com/file/bMvNVwMM/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

  • Vote tăng 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

tiendaica    0

tiendaica
Đã đăng
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

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

thanhduan2407    272

thanhduan2407
Đã đăng
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

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

thanhduan2407    272

thanhduan2407
Đã đăng
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

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

thanhduan2407    272

thanhduan2407
Đã đăng
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ẻ

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

NDBNGO    20

NDBNGO
Đã đăng

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

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

tiendaica    0

tiendaica
Đã đăng

à 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

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

NDBNGO    20

NDBNGO
Đã đăng

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

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

nguyentuan_hagl    0

nguyentuan_hagl
Đã đăng
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.com/file/bMvNVwMM/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

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

ro88    2

ro88
Đã đăng

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.com/upfiles/3/73751_khung_to.dwg

 

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

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

VoHoan    6

VoHoan
Đã đăng

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 đó!

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

sirgau    1

sirgau
Đã đăng

Chào bác    bạn thanhduan2407  mình có dowload lisp KH của bạn về khi test thử mình có load lên bằng lệnh AP và gõ lệnh KH sao không thấy chạy, bạn có thể chỉ giúp mình được không...

 Chân thành cảm ơn.

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

thanhduan2407    272

thanhduan2407
Đã đăng

Chào bác    bạn thanhduan2407  mình có dowload lisp KH của bạn về khi test thử mình có load lên bằng lệnh AP và gõ lệnh KH sao không thấy chạy, bạn có thể chỉ giúp mình được không...

 Chân thành cảm ơn.

Mình viết lại lisp đó rồi. Bạn download về giải nén và làm theo hướng dẫn nhé.

- Lisp tạo mắt lưới: TML

- Lisp vẽ khung: KBD

 

Link: http://www.mediafire.com/download/ad9lwgdtd69wgor/Lisp+cat+khung+binh+do_.rar

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

minhphuong_humg    5

minhphuong_humg
Đã đăng

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

Bạn ơi, cho mình hỏi cái này nó chạy trên Autocad phiên bản nào vậy hay là Autocad phiên bản nào cũng dùng được? Mình đang dùng autocad 2014 thì có dùng được không? Trân trọng cảm ơn.

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

thanhduan2407    272

thanhduan2407
Đã đăng

Phiên bản Autocad 2004 cũng được nhưng phải cài Tools Express. Còn 2007 trở lên thì vô tư. Bạn download về dùng biết ngay được hay ko được. ^^

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

minhphuong_humg    5

minhphuong_humg
Đã đăng

Phiên bản Autocad 2004 cũng được nhưng phải cài Tools Express. Còn 2007 trở lên thì vô tư. Bạn download về dùng biết ngay được hay ko được. ^^

Bạn ơi, Autocad 2014 chứ không phải Autocad 2004 bạn à. Mình hỏi để biết xem nó dùng được cho phiên bản nào. Còn giả sử không tương thích với phiên bản nào các bạn nào cài trước thì chia sẻ cho mọi người cùng biết. Trân trọng cảm ơn!

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Về Đầu Trang AutoLisp
×