Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
quanghuy181

Lisp chương trình tự động vẽ khung bản đồ

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

quanghuy181    0

Mình có đoạn code sau nhưng mà không biết là làm sao khi chạy chương trình thì nó lại không vẽ toàn bộ khung mà thỉnh thoảng lại lỗi ở góc khung và có khi lại chỉ vẽ khung ngoài và vài dòng chữ thập. Các bạn xem rồi chỉnh lại giúp mình nhé

;;; Tu dong ve khung ban do .

 

(defun c:kh ()

;;; (princ "\n CHUONG TRINH VE KHUNG BAN DO .")

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

 

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

(setq ktmk (/ (* tyle 1.75) 500.0))

(setq caoc (/ (* tyle 1.20) 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

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
elleHCSC    98
Mình có đoạn code sau nhưng mà không biết là làm sao khi chạy chương trình thì nó lại không vẽ toàn bộ khung mà thỉnh thoảng lại lỗi ở góc khung và có khi lại chỉ vẽ khung ngoài và vài dòng chữ thập. Các bạn xem rồi chỉnh lại giúp mình nhé

 

Đồng chí này ở đâu ra mà lôi được cái code elle viết từ hồi 1998 cũ rích rồi post lung tung lên trên này thế không biết. ^_^

Config osnap bằng nil hết đi thì là đươc. Code đời đầu khi mới mày mò lisp mà

Mã nó rành rành ra thế, có 1 đoạn ngắn thì tìm xem nó bị sao mà ko chạy được chứ...hic

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
elleHCSC    98
bạn nói Config OSnap bằng nil hết đi là được nghĩa là sao cơ?? Nhờ bạn chỉ dùm cho mình cái...

 

http://www.cadviet.com/upfiles/Osnap.bmp

 

Làm sao để nó được như thế này là Ok...

Bác này chắc mới dùng cad... ^_^ nên chưa rành lắm cái Osnap...hic...giống mình hồi xửa thế...khác elleHCSC là post lisp loạn cả lên...hồi đó internet đâu có dể như bây giờ...hic

 

elleHCSC sửa lại chút cho ban nè

http://www.cadviet.com/upfiles/k.lsp

 

Mà sao bác này cứ post lisp lung tung hết cả lên thế ko biết, đúng là tam sao thất bản...diễn đàn nào cũng post...

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

Đăng nhập để thực hiện theo  

×