Đến nội dung


Hình ảnh
* * * * - 5 Bình chọn

[Yêu cầu] Lisp thống kê tọa độ địa chính


  • Please log in to reply
96 replies to this topic

#41 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 03 January 2013 - 01:55 PM

Bị lỗi trong quá trình cho vào thẻ code của diển đàn đấy bác Hà ạ.
  • 1

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#42 2hproduction

2hproduction

    biết vẽ circle

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

Đã gửi 03 January 2013 - 02:05 PM

Bị lỗi trong quá trình cho vào thẻ code của diển đàn đấy bác Hà ạ.

Hình như là thế bác à....

Hỏi chủ topic và NhocLangbat tí: có phải các bạn đang dùng VietKey chứ không phải Unikey?

Em dùng Unikey mà bác.....

Em mạo phạm xin phép bác duy782006 thêm tí tiếng Việt vào command cho nó sinh động.....Nhờ có bác mà công việc của em giảm tải thời gian đi quá nửa.
Thay mặt Đảng, Chính phủ, UBND, HĐND em xin trân trọng cảm ơn và đa tạ bác ạ...

P/S: À quên, bác nghiên cứu thêm cái line để hoàn chỉnh cái bảng, đỡ phải mất công gõ PL và Copy rất nhiều cho từng bảng một ạ.


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chuyen gia tri goc tu do sang radian
;;;Cu phap su dung (duy:s_do>radian giatri)
;;;giatri la goc tinh theo do, kq la goc tinh theo radian
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:s_do>radian (gt / gt kq)
(setq kq (* (/ pi 180) gt))
kq)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao moi text
;;;Cu phap su dung (duy:t_text diemchen docao gocquay canhle noidung textstyle layer color)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:t_text (d c g cl nd k la co / d c g cl nd k la co)
(cond
((= cl "trai") (setq kcl 0))
((= cl "phai") (setq kcl 2))
((= cl "giua") (setq kcl 1))
)
(cond ((= g "") (setq g 0) ))
(cond ((= cl "") (setq kcl 0) ))
(setq g (duy:s_do>radian g))
(cond ((= k "") (setq k (getvar "TEXTSTYLE")) ))
(cond ((= la "") (setq la (getvar "Clayer")) ))
(cond ((= co "") (setq co 256) ))
(entmake (list (cons 0 "TEXT")(cons 10 d)(cons 11 d)(cons 40 c)(cons 50 g)(cons 72 kcl)(cons 1 nd)(cons 7 k)(cons 8 la)(cons 62 co)))
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao moi line
;;;Cu phap su dung (duy:t_line diemdau diemcuoi layer color ltype ltypescale)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:t_line (a b la co lt slt / a b la co lt slt)
(cond ((= la "") (setq la (getvar "Clayer")) ))
(cond ((= co "") (setq co 256) ))
(cond ((= lt "") (setq lt "bylayer") ))
(cond ((= slt "") (setq slt 1) ))
(entmake (list (cons 0 "LINE")(cons 10 a)(cons 11 B)(cons 8 la)(cons 62 co)(cons 6 lt)(cons 48 slt) ))
(princ)
)

(defun c:btd (/ ddt dtn dth)
(command "undo" "be")
(setq dvbd (getpoint "\nCho\U+0323n \u+0110iê\U+0309m che\U+0300n ba\U+0309ng: "))
(duy:t_line dvbd (list (+ (car dvbd) 30) (cadr dvbd)) "" "" "" "")
(duy:t_line (list (car dvbd) (- (cadr dvbd) 5)) (list (+ (car dvbd) 30) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 0) (- (cadr dvbd) 0)) (list (+ (car dvbd) 0) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 5) (- (cadr dvbd) 0)) (list (+ (car dvbd) 5) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 23) (- (cadr dvbd) 0)) (list (+ (car dvbd) 23) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 26.5) (- (cadr dvbd) 0)) (list (+ (car dvbd) 26.5) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 30) (- (cadr dvbd) 0)) (list (+ (car dvbd) 30) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 5) (- (cadr dvbd) 2.5)) (list (+ (car dvbd) 23) (- (cadr dvbd) 2.5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 14) (- (cadr dvbd) 2.5)) (list (+ (car dvbd) 14) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_text (list (+ (car dvbd) 2.5) (- (cadr dvbd) 3)) 1 0 "giua" "§Ønh" "" "" "")
(duy:t_text (list (+ (car dvbd) 14) (- (cadr dvbd) 1.75)) 1 0 "giua" "Täa §é" "" "" "")
(duy:t_text (list (+ (car dvbd) 9.5) (- (cadr dvbd) 4.25)) 1 0 "giua" "X (m)" "" "" "")
(duy:t_text (list (+ (car dvbd) 18.5) (- (cadr dvbd) 4.25)) 1 0 "giua" "Y (m)" "" "" "")
(duy:t_text (list (+ (car dvbd) 24.75) (- (cadr dvbd) 1.75)) 1 0 "giua" "Tªn" "" "" "")
(duy:t_text (list (+ (car dvbd) 28.25) (- (cadr dvbd) 1.75)) 1 0 "giua" "C¹nh" "" "" "")
(duy:t_text (list (+ (car dvbd) 24.75) (- (cadr dvbd) 4.25)) 1 0 "giua" "C¹nh" "" "" "")
(duy:t_text (list (+ (car dvbd) 28.25) (- (cadr dvbd) 4.25)) 1 0 "giua" "(m)" "" "" "")

(setq dvbd (list (car dvbd) (- (cadr dvbd) 5)))
(duy:t_line (list (car dvbd) (- (cadr dvbd) 2)) (list (+ (car dvbd) 23) (- (cadr dvbd) 2)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 23) (- (cadr dvbd) 3)) (list (+ (car dvbd) 30) (- (cadr dvbd) 3)) "" "" "" "")

(setq ddt (getpoint "\nCho\U+0323n \u+0110i\U+0309nh 1: "))
(setq dtn ddt)
(setq sttn 1)
(duy:t_text (list (+ (car dvbd) 2.5) (- (cadr dvbd) 1.5)) 1 0 "giua" "1" "" "" "")
(duy:t_text (list (+ (car dvbd) 9.5) (- (cadr dvbd) 1.5)) 1 0 "giua" (rtos (cadr dtn) 2 3) "" "" "")
(duy:t_text (list (+ (car dvbd) 18.5) (- (cadr dvbd) 1.5)) 1 0 "giua" (rtos (car dtn) 2 3) "" "" "")

(while (setq dth (getpoint dtn(strcat "\nCho\U+0323n \U+0110i\U+0309nh" (rtos (+ sttn 1) 2 0) " <Enter \u+0110&#234;\U+0309 k&#234;\U+0301t thu\U+0301c!>") ))
(grdraw dtn dth 7)
(duy:t_line (list (car dvbd) (- (- (cadr dvbd) (* 2 sttn)) 2)) (list (+ (car dvbd) 23) (- (- (cadr dvbd) (* 2 sttn)) 2)) "" "" "" "")
(duy:t_text (list (+ (car dvbd) 2.5) (- (- (cadr dvbd) (* 2 sttn)) 1.5)) 1 0 "giua" (rtos (+ sttn 1) 2 0) "" "" "")
(duy:t_text (list (+ (car dvbd) 9.5) (- (- (cadr dvbd) (* 2 sttn)) 1.5)) 1 0 "giua" (rtos (cadr dth) 2 3) "" "" "")
(duy:t_text (list (+ (car dvbd) 18.5) (- (- (cadr dvbd) (* 2 sttn)) 1.5)) 1 0 "giua" (rtos (car dth) 2 3) "" "" "")
(duy:t_text (list (+ (car dvbd) 24.8) (- (- (cadr dvbd) (* 2 sttn)) 0.5)) 1 0 "giua" (strcat (rtos sttn 2 0) "-" (rtos (+ sttn 1) 2 0)) "" "" "")
(duy:t_text (list (+ (car dvbd) 28.3) (- (- (cadr dvbd) (* 2 sttn)) 0.5)) 1 0 "giua" (rtos (distance dtn dth) 2 2) "" "" "")
(duy:t_line (list (+ (car dvbd) 23) (- (- (cadr dvbd) (* 2 sttn)) 3)) (list (+ (car dvbd) 30) (- (- (cadr dvbd) (* 2 sttn)) 3)) "" "" "" "")

(setq dtn dth)
(setq sttn (+ sttn 1))
)
(command ".erase" "last" "")
(duy:t_line (list (car dvbd) (- (- (cadr dvbd) (* 2 sttn)) 2)) (list (+ (car dvbd) 30) (- (- (cadr dvbd) (* 2 sttn)) 2)) "" "" "" "")
(duy:t_text (list (+ (car dvbd) 2.5) (- (- (cadr dvbd) (* 2 sttn)) 1.5)) 1 0 "giua" "1" "" "" "")
(duy:t_text (list (+ (car dvbd) 9.5) (- (- (cadr dvbd) (* 2 sttn)) 1.5)) 1 0 "giua" (rtos (cadr ddt) 2 3) "" "" "")
(duy:t_text (list (+ (car dvbd) 18.5) (- (- (cadr dvbd) (* 2 sttn)) 1.5)) 1 0 "giua" (rtos (car ddt) 2 3) "" "" "")
(duy:t_text (list (+ (car dvbd) 24.8) (- (- (cadr dvbd) (* 2 sttn)) 0.5)) 1 0 "giua" (strcat (rtos sttn 2 0) "-" "1") "" "" "")
(duy:t_text (list (+ (car dvbd) 28.3) (- (- (cadr dvbd) (* 2 sttn)) 0.5)) 1 0 "giua" (rtos (distance dtn ddt) 2 2) "" "" "")

(command "undo" "end")
(Princ)
)


  • 0

#43 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 03 January 2013 - 02:43 PM

oh thì ra là do diễn đàn giờ đã hỉu :D, bạn nói nghe ghê vậy ^^

Thay mặt Đảng, Chính phủ, UBND, HĐND em xin trân trọng cảm ơn và đa tạ bác ạ...

Bạn yêu cầu nhiều hỉ lsp chỉ hộ trợ 1 phần thui bạn ah, còn lại làm bình thường tí đi ^^, trong lsp các phần nó kết nối với nhau, thêm 1 cột hay bớt 1 cột nó phiền hà lắm, tùy trường hợp bạn có thể tùy cơ tự xử lẹ hơn sửa lsp đấy bạn :D
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#44 2hproduction

2hproduction

    biết vẽ circle

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

Đã gửi 03 January 2013 - 02:51 PM

oh thì ra là do diễn đàn giờ đã hỉu :D, bạn nói nghe ghê vậy ^^
Bạn yêu cầu nhiều hỉ lsp chỉ hộ trợ 1 phần thui bạn ah, còn lại làm bình thường tí đi ^^, trong lsp các phần nó kết nối với nhau, thêm 1 cột hay bớt 1 cột nó phiền hà lắm, tùy trường hợp bạn có thể tùy cơ tự xử lẹ hơn sửa lsp đấy bạn :D

Mình làm gần 900 hộ mà phải vẽ line để hoàn thành cái bảng trong lisp của bác duy782006 cũng...... :wacko: ạ....
  • 0

#45 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 03 January 2013 - 03:59 PM

Bạn dùng lệnh extend kéo dài các đường đã có trên bảng tiêu đề xuống line cuối cùng đi. Thêm mấy cái line vào lisp nhọc quá. Tôi lười rồi.
  • 1

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#46 2hproduction

2hproduction

    biết vẽ circle

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

Đã gửi 03 January 2013 - 04:10 PM

Bạn dùng lệnh extend kéo dài các đường đã có trên bảng tiêu đề xuống line cuối cùng đi. Thêm mấy cái line vào lisp nhọc quá. Tôi lười rồi.

Huhu....các mod khác vào giúp em với ạ......huhu
  • 0

#47 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 03 January 2013 - 04:16 PM

Nước mắt không làm mềm lòng bác Duy đâu.
Chỉ có "Like This" mới lay động được thôi.
Chắc bác ấy thấy dạo này xù nợ quá nên cũng không sướng với tín chấp của bạn?
:lol: :lol: :lol:
  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#48 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 03 January 2013 - 04:25 PM

Bác cụ thể hóa giúp em với ạ.....ý này cũng rất hay ạ! Em xin đa tạ!

Hề hề hề,
Muốn cụ thì có cụ :
Xin lỗi bác Duy vì mình chôm ít đồ của bác để xài cho nó lẹ. Có chỉnh sửa chút chút cho nó hợp với mưu đồ của chủ thớt.
http://www.cadviet.c...dotrichthua.lsp



(defun c:lbtd (/ oldos en enlst e1 i n dvbd db1 dth dtn)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chuyen gia tri goc tu do sang radian
;;;Cu phap su dung (duy:s_do>radian giatri)
;;;giatri la goc tinh theo do, kq la goc tinh theo radian
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:s_do>radian (gt / gt kq)
(setq kq (* (/ pi 180) gt))
kq)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao moi text
;;;Cu phap su dung (duy:t_text diemchen docao gocquay canhle noidung textstyle layer color)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:t_text (d c g cl nd k la co / d c g cl nd k la co)
(cond
((= cl "trai") (setq kcl 0))
((= cl "phai") (setq kcl 2))
((= cl "giua") (setq kcl 1))
)
(cond ((= g "") (setq g 0) ))
(cond ((= cl "") (setq kcl 0) ))
(setq g (duy:s_do>radian g))
(cond ((= k "") (setq k (getvar "TEXTSTYLE")) ))
(cond ((= la "") (setq la (getvar "Clayer")) ))
(cond ((= co "") (setq co 256) ))
(entmake (list (cons 0 "TEXT")(cons 10 d)(cons 11 d)(cons 40 c)(cons 50 g)(cons 72 kcl)(cons 1 nd)(cons 7 k)(cons 8 la)

(cons 62 co)))
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao moi line
;;;Cu phap su dung (duy:t_line diemdau diemcuoi layer color ltype ltypescale)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:t_line (a b la co lt slt / a b la co lt slt)
(cond ((= la "") (setq la (getvar "Clayer")) ))
(cond ((= co "") (setq co 256) ))
(cond ((= lt "") (setq lt "bylayer") ))
(cond ((= slt "") (setq slt 1) ))
(entmake (list (cons 0 "LINE")(cons 10 a)(cons 11 B)(cons 8 la)(cons 62 co)(cons 6 lt)(cons 48 slt) ))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun vepolyline (/ i)
(setq i 0)
(command "pline")
(while (setq p (getpoint (strcat "\n Chon dinh thu " (rtos (setq i (1+ i)) 2 0) " <Enter de ket thuc>")))
(command p)
)
(command "c")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(alert "\n Chon lan luot cac dinh cua thua dat can lap bang toa do")
(command "undo" "be")
(vepolyline)
(setq en (entlast) i 0
enlst (acet-geom-vertex-list en)
n (length enlst) )

(setq dvbd (getpoint "\nChon diem dat bang: "))
(duy:t_line dvbd (list (+ (car dvbd) 30) (cadr dvbd)) "" "" "" "")
(duy:t_line (list (car dvbd) (- (cadr dvbd) 5)) (list (+ (car dvbd) 30) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 0) (- (cadr dvbd) 0)) (list (+ (car dvbd) 0) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 5) (- (cadr dvbd) 0)) (list (+ (car dvbd) 5) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 23) (- (cadr dvbd) 0)) (list (+ (car dvbd) 23) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 26.5) (- (cadr dvbd) 0)) (list (+ (car dvbd) 26.5) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 30) (- (cadr dvbd) 0)) (list (+ (car dvbd) 30) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 5) (- (cadr dvbd) 2.5)) (list (+ (car dvbd) 23) (- (cadr dvbd) 2.5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 14) (- (cadr dvbd) 2.5)) (list (+ (car dvbd) 14) (- (cadr dvbd) 5)) "" "" "" "")

(duy:t_text (list (+ (car dvbd) 2.5) (- (cadr dvbd) 3)) 1 0 "giua" "&#167;&#216;nh" "" "" "")
(duy:t_text (list (+ (car dvbd) 14) (- (cadr dvbd) 1.75)) 1 0 "giua" "T&#228;a &#167;&#233;" "" "" "");;;"T&#228;a &#167;&#233;"
(duy:t_text (list (+ (car dvbd) 9.5) (- (cadr dvbd) 4.25)) 1 0 "giua" "X (m)" "" "" "")
(duy:t_text (list (+ (car dvbd) 18.5) (- (cadr dvbd) 4.25)) 1 0 "giua" "Y (m)" "" "" "")
(duy:t_text (list (+ (car dvbd) 24.75) (- (cadr dvbd) 1.75)) 1 0 "giua" "T&#170;n" "" "" "")
(duy:t_text (list (+ (car dvbd) 28.25) (- (cadr dvbd) 1.75)) 1 0 "giua" "C&#185;nh" "" "" "")
(duy:t_text (list (+ (car dvbd) 24.75) (- (cadr dvbd) 4.25)) 1 0 "giua" "C&#185;nh" "" "" "")
(duy:t_text (list (+ (car dvbd) 28.25) (- (cadr dvbd) 4.25)) 1 0 "giua" "(m)" "" "" "")

(setq dvbd (list (car dvbd) (- (cadr dvbd) 5)))
(setq db1 dvbd)

(while (< i (1- n))
(setq dtn (nth i enlst))
(duy:t_text (list (+ (car dvbd) 2.5) (- (cadr dvbd) 1.5)) 1 0 "giua" (rtos (setq i (1+ i)) 2 0) "" "" "")
(duy:t_text dtn 1 0 "giua" (rtos i 2 0) "" "" "")
(duy:t_text (list (+ (car dvbd) 9.5) (- (cadr dvbd) 1.5)) 1 0 "giua" (rtos (cadr dtn) 2 3) "" "" "")
(duy:t_text (list (+ (car dvbd) 18.5) (- (cadr dvbd) 1.5)) 1 0 "giua" (rtos (car dtn) 2 3) "" "" "")
(duy:t_line (list (car dvbd) (- (cadr dvbd) 2)) (list (+ (car dvbd) 23) (- (cadr dvbd) 2)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 23) (- (cadr dvbd) 3)) (list (+ (car dvbd) 30) (- (cadr dvbd) 3)) "" "" "" "")
(setq e1 (entlast))
(if (> i 1)
(progn
(duy:t_text (list (+ (car dvbd) 24.8) (- (cadr dvbd) 0.5)) 1 0 "giua"
(strcat (rtos (1- i) 2 0) "-" (rtos i 2 0)) "" "" "")
(duy:t_text (list (+ (car dvbd) 28.3) (- (cadr dvbd) 0.5)) 1 0 "giua" (rtos (distance dtn dth) 2 2) "" "" "")
)
)
(setq dth dtn)

(setq dvbd (list (car dvbd) (- (cadr dvbd) 2)))
)
(command "erase" e1 en "")
(duy:t_text (list (+ (car dvbd) 2.5) (- (cadr dvbd) 1.5)) 1 0 "giua" "1" "" "" "")
(duy:t_text (list (+ (car dvbd) 9.5) (- (cadr dvbd) 1.5)) 1 0 "giua" (rtos (cadr (nth 0 enlst)) 2 3) "" "" "")
(duy:t_text (list (+ (car dvbd) 18.5) (- (cadr dvbd) 1.5)) 1 0 "giua" (rtos (car (nth 0 enlst)) 2 3) "" "" "")
(duy:t_line (list (car dvbd) (- (cadr dvbd) 2)) (list (+ (car dvbd) 30) (- (cadr dvbd) 2)) "" "" "" "")
(duy:t_text (list (+ (car dvbd) 24.8) (- (cadr dvbd) 0.5)) 1 0 "giua" (strcat (rtos i 2 0) "-1" ) "" "" "")
(duy:t_text (list (+ (car dvbd) 28.3) (- (cadr dvbd) 0.5)) 1 0 "giua" (rtos (distance (nth 0 enlst) dth) 2 2) "" "" "")
(duy:t_line db1 (list (car db1) (- (cadr dvbd) 2)) "" "" "" "")
(duy:t_line (list (+ (car db1) 5) (cadr db1) ) (list (+ (car dvbd) 5) (- (cadr dvbd) 2)) "" "" "" "")
(duy:t_line (list (+ (car db1) 14) (cadr db1) ) (list (+ (car dvbd) 14) (- (cadr dvbd) 2)) "" "" "" "")
(duy:t_line (list (+ (car db1) 23) (cadr db1) ) (list (+ (car dvbd) 23) (- (cadr dvbd) 2)) "" "" "" "")
(duy:t_line (list (+ (car db1) 26.5) (cadr db1) ) (list (+ (car dvbd) 26.5) (- (cadr dvbd) 2)) "" "" "" "")
(duy:t_line (list (+ (car db1) 30) (cadr db1) ) (list (+ (car dvbd) 30) (- (cadr dvbd) 2)) "" "" "" "")
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)
Chúc bạn vui.
  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#49 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 03 January 2013 - 04:28 PM

Huhu....các mod khác vào giúp em với ạ......huhu

Thì đây.
http://www.cadviet.c.../1285_btd_2.lsp
  • 1

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#50 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 03 January 2013 - 04:41 PM

Lạm phát rồi! Nhờ tiếng khóc chăng?


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=68491&pid=224313&st=40&#entry224313
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chuyen gia tri goc tu do sang radian
;;;Cu phap su dung (duy:s_do>radian giatri)
;;;giatri la goc tinh theo do, kq la goc tinh theo radian
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:s_do>radian (gt / gt kq)
(setq kq (* (/ pi 180) gt))
kq)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao moi text
;;;Cu phap su dung (duy:t_text diemchen docao gocquay canhle noidung textstyle layer color)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:t_text (d c g cl nd k la co / d c g cl nd k la co)
(cond
((= cl "trai") (setq kcl 0))
((= cl "phai") (setq kcl 2))
((= cl "giua") (setq kcl 1))
)
(cond ((= g "") (setq g 0) ))
(cond ((= cl "") (setq kcl 0) ))
(setq g (duy:s_do>radian g))
(cond ((= k "") (setq k (getvar "TEXTSTYLE")) ))
(cond ((= la "") (setq la (getvar "Clayer")) ))
(cond ((= co "") (setq co 256) ))
(entmake (list (cons 0 "TEXT")(cons 10 d)(cons 11 d)(cons 40 c)(cons 50 g)(cons 72 kcl)(cons 1 nd)(cons 7 k)(cons 8 la)(cons 62 co)))
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Tao moi line
;;;Cu phap su dung (duy:t_line diemdau diemcuoi layer color ltype ltypescale)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun duy:t_line (a b la co lt slt / a b la co lt slt)
(cond ((= la "") (setq la (getvar "Clayer")) ))
(cond ((= co "") (setq co 256) ))
(cond ((= lt "") (setq lt "bylayer") ))
(cond ((= slt "") (setq slt 1) ))
(entmake (list (cons 0 "LINE")(cons 10 a)(cons 11 B)(cons 8 la)(cons 62 co)(cons 6 lt)(cons 48 slt) ))
(princ)
)

(defun c:btd (/ ddt dtn dth)
(command "undo" "be")
(setq dvbd (getpoint "\nCho\U+0323n \u+0110i&#234;\U+0309m che\U+0300n ba\U+0309ng: "))
(duy:t_line dvbd (list (+ (car dvbd) 30) (cadr dvbd)) "" "" "" "")
(duy:t_line (list (car dvbd) (- (cadr dvbd) 5)) (list (+ (car dvbd) 30) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 0) (- (cadr dvbd) 0)) (list (+ (car dvbd) 0) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 5) (- (cadr dvbd) 0)) (list (+ (car dvbd) 5) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 23) (- (cadr dvbd) 0)) (list (+ (car dvbd) 23) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 26.5) (- (cadr dvbd) 0)) (list (+ (car dvbd) 26.5) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 30) (- (cadr dvbd) 0)) (list (+ (car dvbd) 30) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 5) (- (cadr dvbd) 2.5)) (list (+ (car dvbd) 23) (- (cadr dvbd) 2.5)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 14) (- (cadr dvbd) 2.5)) (list (+ (car dvbd) 14) (- (cadr dvbd) 5)) "" "" "" "")
(duy:t_text (list (+ (car dvbd) 2.5) (- (cadr dvbd) 3)) 1 0 "giua" "&#167;&#216;nh" "" "" "")
(duy:t_text (list (+ (car dvbd) 14) (- (cadr dvbd) 1.75)) 1 0 "giua" "T&#228;a &#167;&#233;" "" "" "")
(duy:t_text (list (+ (car dvbd) 9.5) (- (cadr dvbd) 4.25)) 1 0 "giua" "X (m)" "" "" "")
(duy:t_text (list (+ (car dvbd) 18.5) (- (cadr dvbd) 4.25)) 1 0 "giua" "Y (m)" "" "" "")
(duy:t_text (list (+ (car dvbd) 24.75) (- (cadr dvbd) 1.75)) 1 0 "giua" "T&#170;n" "" "" "")
(duy:t_text (list (+ (car dvbd) 28.25) (- (cadr dvbd) 1.75)) 1 0 "giua" "C&#185;nh" "" "" "")
(duy:t_text (list (+ (car dvbd) 24.75) (- (cadr dvbd) 4.25)) 1 0 "giua" "C&#185;nh" "" "" "")
(duy:t_text (list (+ (car dvbd) 28.25) (- (cadr dvbd) 4.25)) 1 0 "giua" "(m)" "" "" "")

(setq dvbd (list (car dvbd) (- (cadr dvbd) 5)))
(duy:t_line (list (car dvbd) (- (cadr dvbd) 2)) (list (+ (car dvbd) 23) (- (cadr dvbd) 2)) "" "" "" "")
(duy:t_line (list (+ (car dvbd) 23) (- (cadr dvbd) 3)) (list (+ (car dvbd) 30) (- (cadr dvbd) 3)) "" "" "" "")

(setq ddt (getpoint "\nCho\U+0323n \u+0110i\U+0309nh 1: "))
(setq dtn ddt)
(setq sttn 1)
(duy:t_text (list (+ (car dvbd) 2.5) (- (cadr dvbd) 1.5)) 1 0 "giua" "1" "" "" "")
(duy:t_text (list (+ (car dvbd) 9.5) (- (cadr dvbd) 1.5)) 1 0 "giua" (rtos (cadr dtn) 2 3) "" "" "")
(duy:t_text (list (+ (car dvbd) 18.5) (- (cadr dvbd) 1.5)) 1 0 "giua" (rtos (car dtn) 2 3) "" "" "")

(while (setq dth (getpoint dtn(strcat "\nCho\U+0323n \U+0110i\U+0309nh" (rtos (+ sttn 1) 2 0) " <Enter \u+0110&#234;\U+0309 k&#234;\U+0301t thu\U+0301c!>") ))
(grdraw dtn dth 7)
(duy:t_line (list (car dvbd) (- (- (cadr dvbd) (* 2 sttn)) 2)) (list (+ (car dvbd) 23) (- (- (cadr dvbd) (* 2 sttn)) 2)) "" "" "" "")
(duy:t_text (list (+ (car dvbd) 2.5) (- (- (cadr dvbd) (* 2 sttn)) 1.5)) 1 0 "giua" (rtos (+ sttn 1) 2 0) "" "" "")
(duy:t_text (list (+ (car dvbd) 9.5) (- (- (cadr dvbd) (* 2 sttn)) 1.5)) 1 0 "giua" (rtos (cadr dth) 2 3) "" "" "")
(duy:t_text (list (+ (car dvbd) 18.5) (- (- (cadr dvbd) (* 2 sttn)) 1.5)) 1 0 "giua" (rtos (car dth) 2 3) "" "" "")
(duy:t_text (list (+ (car dvbd) 24.8) (- (- (cadr dvbd) (* 2 sttn)) 0.5)) 1 0 "giua" (strcat (rtos sttn 2 0) "-" (rtos (+ sttn 1) 2 0)) "" "" "")
(duy:t_text (list (+ (car dvbd) 28.3) (- (- (cadr dvbd) (* 2 sttn)) 0.5)) 1 0 "giua" (rtos (distance dtn dth) 2 2) "" "" "")
(duy:t_line (list (+ (car dvbd) 23) (- (- (cadr dvbd) (* 2 sttn)) 3)) (list (+ (car dvbd) 30) (- (- (cadr dvbd) (* 2 sttn)) 3)) "" "" "" "")

(setq dtn dth)
(setq sttn (+ sttn 1))
)
(command ".erase" "last" "")
(duy:t_line (list (car dvbd) (- (- (cadr dvbd) (* 2 sttn)) 2)) (list (+ (car dvbd) 30) (- (- (cadr dvbd) (* 2 sttn)) 2)) "" "" "" "")
(duy:t_text (list (+ (car dvbd) 2.5) (- (- (cadr dvbd) (* 2 sttn)) 1.5)) 1 0 "giua" "1" "" "" "")
(duy:t_text (list (+ (car dvbd) 9.5) (- (- (cadr dvbd) (* 2 sttn)) 1.5)) 1 0 "giua" (rtos (cadr ddt) 2 3) "" "" "")
(duy:t_text (list (+ (car dvbd) 18.5) (- (- (cadr dvbd) (* 2 sttn)) 1.5)) 1 0 "giua" (rtos (car ddt) 2 3) "" "" "")
(duy:t_text (list (+ (car dvbd) 24.8) (- (- (cadr dvbd) (* 2 sttn)) 0.5)) 1 0 "giua" (strcat (rtos sttn 2 0) "-" "1") "" "" "")
(duy:t_text (list (+ (car dvbd) 28.3) (- (- (cadr dvbd) (* 2 sttn)) 0.5)) 1 0 "giua" (rtos (distance dtn ddt) 2 2) "" "" "")

(duy:t_line (polar dvbd (/ pi -2) 0) (polar dvbd (/ pi -2) (* (1+ sttn) 2)) "" "" "" "")
(command "copy" (entlast) "" dvbd (polar dvbd 0 5))
(command "copy" (entlast) "" dvbd (polar dvbd 0 9))
(command "copy" (entlast) "" dvbd (polar dvbd 0 9))
(command "copy" (entlast) "" dvbd (polar dvbd 0 3.5))
(command "copy" (entlast) "" dvbd (polar dvbd 0 3.5))

(command "undo" "end")
(Princ)
)

  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#51 2hproduction

2hproduction

    biết vẽ circle

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

Đã gửi 03 January 2013 - 05:10 PM

Hề hề hề,
Muốn cụ thì có cụ :
Xin lỗi bác Duy vì mình chôm ít đồ của bác để xài cho nó lẹ. Có chỉnh sửa chút chút cho nó hợp với mưu đồ của chủ thớt.
http://www.cadviet.c...dotrichthua.lsp
Chúc bạn vui.

Em load lisp trên thì được nhưng lisp dưới thì không lên được lệnh bác ạ :D
Bác ơi...cho e xin dòng lệnh để Ctrl+Z lại khi em kích nhầm đỉnh bác nhé!
  • 0

#52 2hproduction

2hproduction

    biết vẽ circle

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

Đã gửi 03 January 2013 - 05:13 PM

Thì đây.
http://www.cadviet.c.../1285_btd_2.lsp


Bác ơi...cho e xin dòng lệnh để Ctrl+Z lại khi em kích nhầm đỉnh bác nhé!
  • 0

#53 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 03 January 2013 - 05:24 PM

sax đc 1 đòi 2, đc 2 đòi n.. :D, nên có điểm dừng bạn ah ^^, để mấy huynh còn kím cơm luôi vợ luôi con B)
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#54 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 03 January 2013 - 05:34 PM

- Trường hợp này, theo Ketxu thì :
+ Nên sử dụng Boundary (chế độ bán auto - pick 1 điểm trong thửa đất)
+ Vẫn giữ lại chế độ pick điểm đề phòng (manual)
+ Chế độ tự động hoàn toàn (chỉ có thao tác chọn khu đặt bảng, vùng sơ đồ => có bao nhiêu thửa tự tạo bấy nhiêu bảng = 900 hộ = 1 lần lệnh)

+ Nên dùng Table

Tuy nhiên, với yêu cầu chữa cháy thì chủ thớt k cần quan tâm đọc thêm
  • 2

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


#55 2hproduction

2hproduction

    biết vẽ circle

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

Đã gửi 03 January 2013 - 06:37 PM

sax đc 1 đòi 2, đc 2 đòi n.. :D, nên có điểm dừng bạn ah ^^, để mấy huynh còn kím cơm luôi vợ luôi con B)

đã giúp thì giúp cho chót mà bác.......xong vụ này em xin đa tạ!
  • 0

#56 nhoclangbat

nhoclangbat

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1409 Bài viết
Điểm đánh giá: 379 (khá)

Đã gửi 03 January 2013 - 07:00 PM

thế dự ánh 900 hộ của bạn chắc cũng đc vài chục cũ không nhỉ :D, đa tạ bạn cứ quy ra thóc cho anh Duy :D
Em nói vui thui mấy anh đừng để ý ^^, viết đc 1 chương trình là 1 lần rèn luyện tay nghề nuôi dưỡng đam mê. Như có huynh nào đó nói em quên mất rùi đại khái ý như vầy "cảm giác hoành thành 1 cái gì đó và thành công đc mọi người vỗ tay là sung sướng nhất rùi"
Ps: chỉ mong đạt đc bằng 1/4 anh Ket :D :D :D
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#57 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 03 January 2013 - 07:46 PM

Viết theo yêu cầu không ớn. Ớn nhất là chạy theo yêu cầu. Hết yêu cầu lại cải tạo yêu cầu. Duy782006 chính thức dừng viết đối với yêu cầu này tại đây. Đa tạ đã dùng lisp.
  • 2

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#58 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 04 January 2013 - 09:49 AM


Bác ơi...cho e xin dòng lệnh để Ctrl+Z lại khi em kích nhầm đỉnh bác nhé!

Hề hề hề,
Cái ni đã có rồi. nếu lỡ kích nhầm thì chỉ việc enter rồi undo để làm lại từ đầu như mới. Ngon choét.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#59 Mọt Sách

Mọt Sách

    biết zoom

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

Đã gửi 18 January 2013 - 08:31 AM

Vừa ngó qua topic của bác này cũng có cái lisp nhờ các bác sửa giúp em ạ:
+ Khi gõ lệnh lisp nó yêu cầu tạo layer 100 trước khi thực hiện thao tác của lisp ===> Xóa phần này đi được không ạ?
+ Có dòng lệnh cho phép hỏi chọn độ chính xác thập phân tọa độ , độ chính xác thập phân khoảng cách ạ.
+ Đổi font tiêu đề khi tạo ra về font .vni

(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)[/b]
[b](defun Wdis (p1 p2 / dis ang point)
(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 Point (polar p1 ang (/ dis 2.0)))
)
(command "Text" "S" "vaptimn" "c" point (/ 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 tM k / namem i bien t1 p1 diem)
(setq namem name)
(setq i 1)
(while (<= i k)
(progn
(setq bien (assoc tM 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:hh( / i k luuxy st p xoa)
(setvar "cmdecho" 0)
(setq st (ssgetLayer "100" "thua") )
(if (/= st nil)
(progn
(if (null (tblsearch "style" "vaptimn"))
(command "_style" "vaptimn" ".vnarial" "" "" "" "" ""))
(if (null (tblsearch "style" "vhelveb"))
(command "_style" "vhelveb" ".vnarial" "" "" "" "" ""))
(if (null (tblsearch "layer" "sohieu_diem"))
(command "_layer" "n" "sohieu_diem" ""))
(command "_layer" "c" "2" "sohieu_diem" "")
(if (null (tblsearch "layer" "bang_toado"))
(command "_layer" "n" "bang_toado" ""))
(command "_layer" "c" "7" "bang_toado" "")
(command "_layer" "c" "6" "thua" "")
(command "_layer" "c" "6" "100" "")
(setq r1 (getvar "USERI1"))
(setq TileBdHT (getreal (strcat "\nMau So Ti Le Cua BDHT" "(" (rtos r1 2 0) "):")))
(if (= TileBdHT nil)
(setq TileBdHT r1))
(setvar "USERR1" TileBdHT)[/b]
[b](setvar "blipmode" 0)
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(setq p (getpoint "\n Pick"))
(if (/= p nil)
(command "-Boundary" "a" "b" "n" st "" "" p "" )
)
(setq luuxy (entget (entlast)))
(setq p (getpoint "\n Diem dat bang toa do :"))
(entdel (entlast))
(setq k (cdr (assoc 90 luuxy)))
(if (/= p nil)
(progn
(setq p01 p)
(setq p02 (mapcar '+ p '(10.0 0.0 0.0)))
(setq p03 (mapcar '+ p '(22.5 -2.5 0.0)))
(setq p04 (mapcar '+ p '(35.0 0.0 0.0)))
(setq p05 (mapcar '+ p '(45.0 0.0 0.0)))
(setq p06 (mapcar '+ p '(0.0 -5.0 0.0)))
(setq p07 (mapcar '+ p '(10.0 -2.5 0.0)))
(setq p08 (mapcar '+ p '(35.0 -2.5 0.0)))
(setq p09 (mapcar '+ p '(45.0 -5.0 0.0)))
(if (<= k 10)
(progn
(setq p10 (mapcar '+ p '(0.0 -40.0 0.0)))
(setq p11 (mapcar '+ p '(10.0 -40.0 0.0)))
(setq p12 (mapcar '+ p '(22.5 -40.0 0.0)))
(setq p13 (mapcar '+ p '(35.0 -40.0 0.0)))
(setq p14 (mapcar '+ p '(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 '+ p t0))
(setq p11 (mapcar '+ p t1))
(setq p12 (mapcar '+ p t2))
(setq p13 (mapcar '+ p t3))
(setq p14 (mapcar '+ p 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 '+ p '(22.5 2.0 0.0)) 1.25 0 "BA&#219;NG LIE&#196;T KE&#194; TO&#207;A &#209;O&#196; GO&#217;C RANH")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(5.0 -1.5 0.0)) 1.15 0 "So&#225; hie&#228;u")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(5.0 -3.5 0.0)) 1.15 0 "&#241;ie&#229;m")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(22.5 -1.25 0.0)) 1.15 0 "To&#239;a &#241;o&#228;")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(16.25 -3.75 0.0)) 1.15 0 "X(m)")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(28.75 -3.75 0.0)) 1.25 0 "Y(m)")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(40.0 -2.5 0.0)) 1.25 0 "Ca&#239;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" (* 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 '+ p tsh))
(setq pxx (mapcar '+ p txx))
(setq pyy (mapcar '+ p tyy))
(setq pgc (mapcar '+ p 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" "sohieu_diem" "")
(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" "sohieu_diem" "")
(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 '+ p tsh))
(setq pxx (mapcar '+ p txx))
(setq pyy (mapcar '+ p tyy))
(setq pgc (mapcar '+ p 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 100")
)
)
)

  • 0

#60 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 18 January 2013 - 09:03 AM

Vừa ngó qua topic của bác này cũng có cái lisp nhờ các bác sửa giúp em ạ:
+ Khi gõ lệnh lisp nó yêu cầu tạo layer 100 trước khi thực hiện thao tác của lisp ===> Xóa phần này đi được không ạ?
+ Có dòng lệnh cho phép hỏi chọn độ chính xác thập phân tọa độ , độ chính xác thập phân khoảng cách ạ.
+ Đổi font tiêu đề khi tạo ra về font .vni

+Bỏ đi là tự tạo layer 100 hay sao?
+Hỏi hoài khi thực hiện lệnh sao bạn?
  • 1

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D