Đế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

#61 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 - 09:14 AM

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

+ Thực hiện trên layer hiện hành luôn bác ạ.
Em load lệnh nó báo như trên mặc dù đã tạo layer 100. Bác fix lỗi giúp em ạ!
Hình đã gửi
  • 0

#62 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:22 AM

Mình tưởng bạn đã chạy được lisp chứ? Mình cũng đã tạo layer 100 và vẫn báo là ko có. => lisp có vấn đề chứ ko phải chỉ 3 ý bạn nêu. Mình ko dò lỗi nổi. Bạn thông cảm!
  • 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


#63 ketxu

ketxu

    Copier - Paster - Editor

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

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

Lisp báo k có là k có nét vẽ nào thuộc layer "100" ^^ Nhìn code ngán ngẩm quá
  • 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


#64 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 - 10:12 AM

Lisp chạy trên máy ông bạn em vẫn chạy ngon bình thường mà em thì không biết làm sao.
Mong các bác (@phamthanhbinh , @ketxu , @duy782006 , @DoanVanHa ....) sửa giúp em với ạ!
  • 0

#65 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 18 January 2013 - 11:19 AM

Cơ quan nhoc cũng xài lsp tương tự nè ^^, lỗi vì ranh đất bạn phải vẽ bằng layer 100 thì lsp mới chạy đc, còn mún sửa như bạn nhoc mò sáng giờ cuối cùng đã thành công :D 1 nữa, tiếc là cơ quan đang bảo trì mạng ko up đc, đang chơi bằng điện thoại ^^
  • 1
"...................][)e\/i][_ /\/\@Y CrY....................."

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








#66 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 18 January 2013 - 11:32 AM

Bạn thử xem nhé, còn font .vni thì mình thấy nó trong lsp nó cũng set toàn bộ font là .vni mà ^^. cho nhập độ chính xác như bạn mún, chạy với layer bất kỳ

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=68491&st=40
(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 ca))
)
(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:tdd( / i k luuxy p xoa)
(setvar "cmdecho" 0)
(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) "):")))
(setq tdo (getint "\nNhap do chinh xac toado:"))
(setq ca (getint "\nNhap do chinh xac canh:"))
(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" "" "" 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 "B&#182;NG LI&#214;T K&#163; T&#228;A &#167;&#233; G&#227;C RANH")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(5.0 -1.5 0.0)) 1.15 0 "S&#232; hi&#214;u &#174;i&#211;m")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(5.0 -3.5 0.0)) 1.15 0 "T&#170;n &#174;i&#211;m")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(22.5 -1.25 0.0)) 1.15 0 "T&#228;a &#174;&#233;")
(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 "C&#185;nh")
)
)
(setq i 1)
(while (<= i k)
(progn
(setq toado (pointpl luuxy 10 i))
(setq x (rtos (car toado) 2 tdo))
(setq y (rtos (cadr toado) 2 tdo))
(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 tdo))
(setq y1 (rtos (cadr toado1) 2 tdo))
)
)
(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 ca) )
(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 ca) )
(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)
)

Ps: còn 1 chỗ nhoc mò chưa ra, cũng có thể nói là ko pit ^^ là nếu số lẽ đằng sau vd:2.199 thì nó ko làm tròn đc 3 số là 2.200 mà nó thành 2.20, nếu số lẽ đằng ssau vẫn lẽ thì vẫn đc n số lúc nhập độ chính xác
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

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








#67 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 - 02:14 PM

Bạn thử xem nhé, còn font .vni thì mình thấy nó trong lsp nó cũng set toàn bộ font là .vni mà ^^. cho nhập độ chính xác như bạn mún, chạy với layer bất kỳ
Ps: còn 1 chỗ nhoc mò chưa ra, cũng có thể nói là ko pit ^^ là nếu số lẽ đằng sau vd:2.199 thì nó ko làm tròn đc 3 số là 2.200 mà nó thành 2.20, nếu số lẽ đằng ssau vẫn lẽ thì vẫn đc n số lúc nhập độ chính xác

Chạy rất ổn rồi....cho mình hỏi chút là mình đặt style là .VnArial rồi mà sao vẫn lỗi font bạn nhỉ? Chỉ cho mình cách khắc phục với!
  • 0

#68 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 - 02:28 PM

Nếu chịu khó xem các bài trên thì sẽ biết là do lỗi font TCVN3 khi chèn code của diển đàn.
-Cách làm:
+Đánh cái chử mong muốn trong cad bằng font mong muốn.
+Lệnh li chọn cái chử đó. Được cái như sau:
TEXT Layer: "0"
Space: Model space
Handle = b9
Style = "Standard"
Font file = txt
start point, X= 40.1849 Y= 14.6577 Z= 0.0000
height 2.3549
text dsfdf
rotation angle 0
width scale factor 1.0000
obliquing angle 0
generation normal

+Cái màu đỏ là nội dung của text đó
+Copy nội dụng đó vào đúng chổ của lisp rồi lưu lại.
  • 0

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


#69 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 18 January 2013 - 02:50 PM

ok men nhoc quên vụ mã TCVN3 khi up lên 4rum :D
down về nhé ko bị ^^
http://www.cadviet.c.../104473_ttd.lsp
  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

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








#70 hihas76

hihas76

    Chưa sử dụng CAD

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

Đã gửi 21 March 2013 - 11:19 PM

biggrin.png Trên sở bắt nộp bảng liệt kê tọa độ chi tiết thế sao bạn ^^, sao không chạy hết nguyên thửa đất mà cứ phải pick từng đỉnh cực vậy nè , vậy đơn giản hơn ko bạn
104473_qqqq.jpg

Anh Hà ơi cho em ké hỏi xíu nếu anh có vô tình ghé ngang qua ^^
anh Ket cho bài tập phụ mà chưa nghĩ ra ^^
ví dụ trong lsp có hỏi thủ tục để tính toán đơn thuần

Giờ anh Ket mún em tạo 1 hàm con có tác dụng in ket qua ra màn hình dùng hàm princ, để khi chạy mỗi thủ tục nó sẽ ra như thế này trên command ketqua: giá trị,
dùng hàm princ trong mỗi thủ tục cũng đc nhưng việc này sẽ lập đi lập lại trong mỗi thủ tục, nên anh Ket cho câu đố như vậy.
PS: cầu trời anh Ket ko vô lại thấy em như thế này biggrin.png

 Tôi cũng đang có nhu cầu sử dụng một lisp như thế. Thấy bạn có nhắc đến một lisp xuất được bảng tọa độ đơn giản như hình rất hay. Nếu bạn có lisp như thế thì có thể chia sẻ cho tôi được không. Cảm ơn bạn nhé. Chứ hiện tại khi muốn sử dụng bảng tọa độ như hình trên tôi thường phải chuyển sang MicroStation và dùng Famis để xuất. Làm như thế tôi rất mất thời gian. Hy vọng sẽ được các anh em trên diễn đàn giúp đỡ dùm cho tôi cái lisp xuất bảng tọa độ ra như hình trên. (Thao tác chỉ cần chọn lần lượt từ điểm 1- có thể theo chiều kim đồng hồ hoặc ngược lại - cho đến điểm thứ n và quay về điểm 1, sau đó click một vị trí nào đó trên màn hình sẽ hiện bảng tọa độ như hình trên) . Rất chân thành cảm ơn các anh em.

P/S: Nếu được các anh em diễn đàn chia sẽ lisp hãy gửi giúp tôi vào địa chỉ mail: hihass76@gmail.com. Chân thành cảm ơn anh em diễn đàn CadViet. Chúc diễn đàn ngày càng lớn mạnh.


  • -1

#71 2hproduction

2hproduction

    biết vẽ circle

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

Đã gửi 17 April 2013 - 11:09 AM

Em có bản đo hiện trạng như sau : http://www.cadviet.c...rich_toa_do.dwg
Em dùng lisp này để trích tọa độ mà sai hoài. ( chiều dài cạnh 1-2 và 23-1)

 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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ê\U+0309 kê\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)
)
  

 

Bác nào biết vào giúp em với ạ (hình như lisp này của bác @duy782006) Hình như nó không cho bắt điểm giao thì phải.
Em xin cảm ơn!


  • 0

#72 tuanchung

tuanchung

    biết vẽ line

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

Đã gửi 21 July 2013 - 07:46 PM

Bạn thử xem nhé, còn font .vni thì mình thấy nó trong lsp nó cũng set toàn bộ font là .vni mà ^^. cho nhập độ chính xác như bạn mún, chạy với layer bất kỳ

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=68491&st=40
(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 ca))
)
(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:tdd( / i k luuxy p xoa)
(setvar "cmdecho" 0)
(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) "):")))
(setq tdo (getint "\nNhap do chinh xac toado:"))
(setq ca (getint "\nNhap do chinh xac canh:"))
(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" "" "" 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 "B&#182;NG LI&#214;T K&#163; T&#228;A &#167;&#233; G&#227;C RANH")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(5.0 -1.5 0.0)) 1.15 0 "S&#232; hi&#214;u &#174;i&#211;m")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(5.0 -3.5 0.0)) 1.15 0 "T&#170;n &#174;i&#211;m")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(22.5 -1.25 0.0)) 1.15 0 "T&#228;a &#174;&#233;")
(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 "C&#185;nh")
  )
)
(setq i 1)
(while (<= i k)
  (progn
   (setq toado (pointpl luuxy 10 i))
   (setq x (rtos (car toado) 2 tdo))
   (setq y (rtos (cadr toado) 2 tdo))
   (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 tdo))
  (setq y1 (rtos (cadr toado1) 2 tdo))
)
   )
   (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 ca) )
(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 ca) )
(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)
)

Ps: còn 1 chỗ nhoc mò chưa ra, cũng có thể nói là ko pit ^^ là nếu số lẽ đằng sau vd:2.199 thì nó ko làm tròn đc 3 số là 2.200 mà nó thành 2.20, nếu số lẽ đằng ssau vẫn lẽ thì vẫn đc n số lúc nhập độ chính xác

cái này của bác thực sự là quá hay rồi, nhưng bác có thể giúp em thêm các số hiêụ đỉnh vào bản vẽ đc không ?chứ suất một loạt ra rồi chẳng biết điểm 1 ở đâu, điểm 2 ở đâu bác à.Mong bác giúp đỡ


  • 0

#73 tuanchung

tuanchung

    biết vẽ line

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

Đã gửi 21 July 2013 - 09:33 PM

không có ai giúp đc em à ???? huhu


  • 0

#74 TaiNguyen79

TaiNguyen79

    biết vẽ ellipse

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

Đã gửi 22 July 2013 - 10:16 AM

Tôi cũng đang có nhu cầu sử dụng một lisp như thế. Thấy bạn có nhắc đến một lisp xuất được bảng tọa độ đơn giản như hình rất hay. Nếu bạn có lisp như thế thì có thể chia sẻ cho tôi được không. Cảm ơn bạn nhé. Chứ hiện tại khi muốn sử dụng bảng tọa độ như hình trên tôi thường phải chuyển sang MicroStation và dùng Famis để xuất. Làm như thế tôi rất mất thời gian. Hy vọng sẽ được các anh em trên diễn đàn giúp đỡ dùm cho tôi cái lisp xuất bảng tọa độ ra như hình trên. (Thao tác chỉ cần chọn lần lượt từ điểm 1- có thể theo chiều kim đồng hồ hoặc ngược lại - cho đến điểm thứ n và quay về điểm 1, sau đó click một vị trí nào đó trên màn hình sẽ hiện bảng tọa độ như hình trên) . Rất chân thành cảm ơn các anh em.
P/S: Nếu được các anh em diễn đàn chia sẽ lisp hãy gửi giúp tôi vào địa chỉ mail: hihass76@gmail.com. Chân thành cảm ơn anh em diễn đàn CadViet. Chúc diễn đàn ngày càng lớn mạnh.

Mình đang dùng lsp này. Bạn nào đang làm địa chính vẽ 1/500 in 2=1 thì dùng rất phù hợp.  Còn in tỷ lệ khac thì chỉnh lại code lsp là đc
Lệnh như sau :
ghitd (Xuất bảng tọa độ góc ranh theo cách pick điểm tuần tự do ng dùng chỉ định)
laytd (Xuất bảng tọa độ theo cách ng dùng pick chọn 1 điểm trong vùng muốn xuất tọa độ. kết quả xuất ra bảng tọa độ theo nguyên tắc lấy điểm thứ 1 là điểm cao nhất và chạy tọa độ cùng chiều kim đồng hồ )

;Ndaitfunc 2013
;Viet boi : Ndait Nguyen
;;-------------------------------------------------------
;Ghi toa do tu dong theo chieu kim dong ho
(defun c:laytd (/ p bound k lstpt lstx lsty newlst i bien t1 p1 diem x y ymax kmax n c new name ltext diemve pt p1
p2 p3 p4 p5 p6 pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12 pt13 pt14 pt15 pt16 pt17)
(luuBHT)
(setq p (getpoint "\nPick point :"))
(setvar "osmode" 0)
(taolop '("vunglaytd" "diemtd" "texttd"))
(setvar "clayer" "vunglaytd")
(command "style" "APTIMA" "vaptimn.ttf" 0 1 0 "" "" "")
(if (/= p nil) (command "-Boundary" p "" ));end if
(setq bound (entget (entlast)))
(setq k (cdr (assoc 90 bound)))
(setq lstpt '() lstx '() lsty '() newlst '())
(setq i 1)
(while (<= i k)
(progn
(setq bien (assoc 10 bound))
(setq t1 (member bien bound))
(setq p1 (car t1))
(setq bound (cdr t1))
(setq diem (cdr p1))
(setq x (car diem) y (cadr diem))
(setq lstx (append lstx (list x)) lsty (append lsty (list y)))
(setq lstpt (append lstpt (list diem)))
(setq i (+ 1 i))));while
(setq ymax (maximum lsty))
(setq kmax (vl-position ymax (reverse lsty)))
(setq lstpt (reverse lstpt))
(setq newlst (member (nth kmax lstpt) lstpt))
(setq n 0)
(repeat kmax (setq newlst (append newlst (list (nth n lstpt)))) (setq n (+ 1 n)))
(setq c 0 new '())
(foreach name newlst (setq new (append new (list (append (list (setq c (1+ c))) name)))))
(setq c 1 new (append new (list (nth 0 new))))
(setq ltext '())
(setq ltext (append ltext (list (nth 0 new))))
(setq newlst (append newlst (list (nth 0 newlst))))
(repeat (- (length new) 1)
(setq ltext (append ltext (list (append (nth c new)
(list (distance (append (nth (- c 1) newlst) '(0.0)) (append (nth c newlst) '(0.0))))))))
(setq c (1+ c)));repeat
(setq n 0)
(setvar "clayer" "diemtd")
(repeat (- (length new) 1)
(ndait_addtext (itoa (car (nth n new))) "texttd" 256 (cdr (nth n new)) 1.0 0.0 "aptima" "BL")
(command "CIRCLE" (cdr (nth n new)) "0.25" "")
(setq n (1+ n)));repeat
(setq diemve (getpoint "\nChon vi tri ve bang toa do : "))
(if (null diemve)
(prompt "\nKhong ve bang ! ")
(progn
(setvar "osmode" 0)
(setvar "orthomode" 0)
(taolop '("Text_Bang" "Line_Bang"))
(setq pt diemve)
(taochu "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH" "Text_Bang" 256 (polar (polar pt 0.0 2.5) (* 0.5 Pi) 0.75) 1.0 "Aptima")
(command "layer" "s" "Line_Bang" "")
(setq pt1 pt pt (polar pt (* 1.5 pi) 0.25))
(setq p (polar (polar pt 0.0 0.5) (* 1.5 pi) 2.0))
(setq p1 p
p2 (polar (polar p1 0.0 11.8) (* 0.5 pi) 0.25)
p3 (polar (polar p1 0.0 0.5) (* 1.5 Pi) 2.25)
P4 (polar p3 0.0 7.0)
p5 (polar p4 0.0 9.0)
p6 (polar (polar p5 0.0 7.5) (* 0.5 Pi) 1.5))
(setq pt2 (polar pt1 0.0 5.5)
pt3 (polar pt2 0.0 18.0)
pt4 (polar pt3 0.0 5.5)
pt5 (polar pt2 (* 1.5 Pi) 2.5)
pt6 (polar pt5 0.0 9.0)
pt7 (polar pt6 0.0 9.0)
pt8 (polar pt1 (* 1.5 Pi) 5.0)
pt9 (polar pt8 0.0 5.5)
pt10 (polar pt9 0.0 9.0)
pt11 (polar pt10 0.0 9.0)
pt12 (polar pt11 0.0 5.5))
(taochu "Soá hieäu" "Text_Bang" 256 p1 1.0 "Aptima")
(taochu "Toïa ñoä" "Text_Bang" 256 p2 1.0 "Aptima")
(taochu "ñieåm" "Text_Bang" 256 p3 1.0 "Aptima")
(taochu "X( m )" "Text_Bang" 256 p4 1.0 "aptima")
(taochu "Y( m )" "Text_Bang" 256 p5 1.0 "aptima")
(taochu "Caïnh" "Text_Bang" 256 p6 1.0 "aptima")
(command "layer" "s" "Line_Bang" "")
(command "line" pt1 pt2 pt5 pt6 pt7 pt3 pt4 pt12 pt11 pt10 pt9 pt8 pt1 "")
(command "line" pt2 pt3 "")
(command "line" pt5 pt9 "")
(command "line" pt6 pt10 "")
(command "line" pt7 pt11 "")
(setq pt (polar pt (* 1.5 pi) 6.9))
(setq i 0)
(repeat (length ltext) (ghihang pt (nth i ltext)) (setq i (1+ i)) (setq pt (polar pt (* 1.5 pi) 2.0)))
(setq pt13 (polar pt8 (* 1.5 Pi) (+ (* 2.0 (length ltext)) 0.25)))
(setq pt14 (polar pt13 0.0 5.5)
pt15 (polar pt14 0.0 9.0)
pt16 (polar pt15 0.0 9.0)
pt17 (polar pt16 0.0 5.5))
(command "layer" "s" "Line_Bang" "")
(command "line" pt8 pt13 pt14 pt9 "")
(command "line" pt14 pt15 pt10 "")
(command "line" pt15 pt16 pt11 "")
(command "line" pt16 pt17 pt12 "")
));if
(traBHT)
(princ))
;;----------------------------------------------------------------
;;;Xuat so lieu toa do diem ra file va danh so thu tu
(defun c:ghitd (/ SBD DIEMDAU pt pt0 canh diem text text0 dspt ltext DIEMCUOI Tongdiem diemve i f fl)
(luuBHT)
;(setq TL (getvar "userr1"))
;(if (<= TL 0.0) (tyle))
(setvar "cmdecho" 0) (setvar "cecolor" "256")
(setq dspt '() ltext '() pt0 nil canh nil)
(Setq SBD (getint "\n Nhap so hieu diem bat dau ghi toa do : <Enter=1> "))
(if (null SBD) (setq SBD 1) (setq SBD SBD))
(command "style" "APTIMA" "vaptimn.ttf" 0 1 0 "" "" "")
(taolop '("MiaP" "MiaT"))
(SETQ DIEMDAU SBD)
(while (setq pt (getpoint (strcat "\n Chon diem toa do : <Mia so " (itoa SBD) "> (Enter de ket thuc)")))
(if (not (null pt0)) (setq canh (distance pt0 pt)))
(setq pt0 pt)
(setq diem (strcat (itoa SBD) " " (trtos (car pt) 3) " " (trtos (cadr pt) 3)))
(setq text (list SBD (car pt) (cadr pt) canh))
(command "layer" "s" "MiaP" "")
(command "point" pt "")
(command "CIRCLE" pt "0.25" "")
(taochu (itoa SBD) "MiaT" 256 pt 1.0 "Aptima")
(setq SBD (1+ SBD))
(setq dspt (append dspt (list diem)))
(setq ltext (append ltext (list text)))
);end while
(setq text0 (nth 0 ltext))
(setq canh (distance (list (nth 1 text0) (nth 2 text0) 0) pt0))
(Setq text (list (nth 0 text0) (nth 1 text0) (nth 2 text0) canh))
(setq ltext (append ltext (list text)))
(setq Tongdiem (itoa (- SBD diemdau)))
(SETQ DIEMCUOI (- SBD 1))
(setq diemve (getpoint "\nChon vi tri ve bang toa do : "))
(if (null diemve)
(prompt "\nKhong ve bang ! ")
(progn
(setvar "osmode" 0)
(setvar "orthomode" 0)
(taolop '("Text_Bang" "Line_Bang"))
(setq pt diemve)
(taochu "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH"
"Text_Bang" 256 (polar (polar pt 0.0 2.5) (* 0.5 Pi) 0.75) 1.0 "Aptima")
(command "layer" "s" "Line_Bang" "")
(setq pt1 pt pt (polar pt (* 1.5 pi) 0.25))
(setq p (polar (polar pt 0.0 0.5) (* 1.5 pi) 2.0))
(setq p1 p
p2 (polar (polar p1 0.0 11.8) (* 0.5 pi) 0.25)
p3 (polar (polar p1 0.0 0.5) (* 1.5 Pi) 2.25)
P4 (polar p3 0.0 7.0)
p5 (polar p4 0.0 9.0)
p6 (polar (polar p5 0.0 7.5) (* 0.5 Pi) 1.5)) ;_ end of setq
(setq pt2 (polar pt1 0.0 5.5)
pt3 (polar pt2 0.0 18.0)
pt4 (polar pt3 0.0 5.5)
pt5 (polar pt2 (* 1.5 Pi) 2.5)
pt6 (polar pt5 0.0 9.0)
pt7 (polar pt6 0.0 9.0)
pt8 (polar pt1 (* 1.5 Pi) 5.0)
pt9 (polar pt8 0.0 5.5)
pt10 (polar pt9 0.0 9.0)
pt11 (polar pt10 0.0 9.0)
pt12 (polar pt11 0.0 5.5)) ;_ end of setq
(taochu "Soá hieäu" "Text_Bang" 256 p1 1.0 "Aptima")
(taochu "Toïa ñoä" "Text_Bang" 256 p2 1.0 "Aptima")
(taochu "ñieåm" "Text_Bang" 256 p3 1.0 "Aptima")
(taochu "X( m )" "Text_Bang" 256 p4 1.0 "aptima")
(taochu "Y( m )" "Text_Bang" 256 p5 1.0 "aptima")
(taochu "Caïnh" "Text_Bang" 256 p6 1.0 "aptima")
(command "layer" "s" "Line_Bang" "")
(command "line" pt1 pt2 pt5 pt6 pt7 pt3 pt4 pt12 pt11 pt10 pt9 pt8 pt1 "") ;_ end of command
(command "line" pt2 pt3 "")
(command "line" pt5 pt9 "")
(command "line" pt6 pt10 "")
(command "line" pt7 pt11 "")
(setq pt (polar pt (* 1.5 pi) 6.9))
(setq i 0)
(repeat (length ltext) (ghihang pt (nth i ltext)) (setq i (1+ i)) (setq pt (polar pt (* 1.5 pi) 2.0)))
(setq pt13 (polar pt8 (* 1.5 Pi) (+ (* 2.0 (length ltext)) 0.25))
pt14 (polar pt13 0.0 5.5)
pt15 (polar pt14 0.0 9.0)
pt16 (polar pt15 0.0 9.0)
pt17 (polar pt16 0.0 5.5))
(command "layer" "s" "Line_Bang" "")
(command "line" pt8 pt13 pt14 pt9 "")
(command "line" pt14 pt15 pt10 "")
(command "line" pt15 pt16 pt11 "")
(command "line" pt16 pt17 pt12 "")))
(if (/= (setq f (getstring "\n<Ten FILE> luu toa do diem , Go <ENTER> neu khong luu : ")) "")
(progn
(if (findfile f) (setq fl (open f "a")) (setq fl (open f "w")))
(write-line "DANH SACH TOA DO DIEM " fl)
(write-line (strcat "File name : " (getvar "dwgprefix") (getvar "dwgname")) fl)
(write-line (strcat "TONG SO DIEM : " Tongdiem) fl)
(write-line (strcat "DIEM DAU : " (itoa DIEMDAU) " DIEM CUOI : " (itoa DIEMCUOI)) fl)
(setq i 0)
(repeat (length dspt) (write-line (nth i dspt) fl) (setq i (1+ i)))))
(if fl (close fl))
(traBHT)
(princ))
;;Dung cho ham ghitd
(defun ghihang (point hang / p p1 p2 p3 pt pt2 pt3 pt4 pt5 t1 t2 t3 t4)
(setq pt point
p (polar (polar pt 0.0 2.0) (/ pi 2.0) 0.25)
t1 (rtos (car hang) 2 0)
t2 (trtos (cadr hang) 3)
t3 (trtos (cadr (cdr hang)) 3))
(if (not (null (nth 3 hang))) (setq t4 (trtos (nth 3 hang) 2)))
(setq p1 p
p2 (polar p1 0.0 12.0)
p3 (polar p2 0.0 8.5)
p4 (polar (polar p3 0.0 5.5) (* 0.5 Pi) 1.0))
(taochu t1 "Text_Bang" 256 p1 0.9 "aptima")
(Ndait_addtext t3 "Text_Bang" 256 p2 0.9 nil "aptima" "R")
(Ndait_addText t2 "Text_Bang" 256 p3 0.9 nil "aptima" "R")
(if (not (null t4)) (Ndait_addText t4 "Text_Bang" 256 p4 0.9 nil "aptima" "R")));end of defun
;-----------------------------------
;Cac ham dung chung
;;Luu va tra bien he thong
(defun luuBHT ()
(setq
auts (getvar "autosnap")
blip (getvar "blipmode")
ceco (getvar "cecolor")
clay (getvar "clayer")
cmec (getvar "cmdecho")
fdia (getvar "filedia")
osmo (getvar "osmode")
orth (getvar "orthomode")
plwi (getvar "plinewid")
pola (getvar "polarmode")
tsty (getvar "textstyle")) ;_ end of setq
) ;_ end of defun
(defun traBHT ()
(setvar "autosnap" auts)
(setvar "blipmode" blip)
(setvar "cecolor" ceco)
(setvar "clayer" clay)
(setvar "cmdecho" cmec)
(setvar "filedia" fdia)
(setvar "osmode" osmo)
(setvar "orthomode" orth)
(setvar "plinewid" plwi)
(setvar "polarmode" pola)
(setvar "textstyle" tsty)
) ;_ end of defun
;---
;;Tao lop theo danh sach di kem
(defun taolop (dslop)
(mapcar '(lambda (a) (if (null (tblsearch "layer" a)) (command "layer" "N" a ""))) dslop)
)
;-----
;Ham tao text
(defun taochu (noidung lop mau diem caochu kieu / x y)
(setq x (car diem) y (cadr diem))
(entmod (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 8 lop) (cons 62 mau)
(cons 100 "AcDbText") (list 10 x y 0.0) (cons 40 caochu)
(cons 1 noidung) (cons 7 kieu))))
) ;defun
(defun Ndait_addtext (noidung lop mau diem caochu goc kieu canhchu / x y va ha)
(cond
((= canhchu "L") (setq va 0 ha 0));Left
((= canhchu "C") (setq va 0 ha 1));Center
((= canhchu "R") (setq va 0 ha 2));Right
;((= canhchu "A") (setq va 0 ha 3));Aligned
((= canhchu "M") (setq va 0 ha 4));Middle
;((= canhchu "F") (setq va 0 ha 5));Fit
((= canhchu "TL") (setq va 3 ha 0));Top Left
((= canhchu "TC") (setq va 3 ha 1));Top Center
((= canhchu "TR") (setq va 3 ha 2));Top Right
((= canhchu "ML") (setq va 2 ha 0));Middle Left
((= canhchu "MC") (setq va 2 ha 1));Middle Center
((= canhchu "MR") (setq va 2 ha 2));Middle Right
((= canhchu "BL") (setq va 1 ha 0));Bottom Left
((= canhchu "BC") (setq va 1 ha 1));Bottom Center
((= canhchu "BR") (setq va 1 ha 2));Bottom Right
(T (setq va 0 ha 0));canhchu false -> Left
);cond
(if (null (tblsearch "style" kieu)) (setq kieu (getvar "textstyle")))
(if (null goc) (setq goc 0.0))
(if (null caochu) (setq caochu 1.0))
(if (null diem) (progn (initget 1) (setq diem (getpoint "\npick point :"))))
(if (null mau) (setq mau 256))
(if (null lop) (setq lop (getvar "clayer")))
(setq x (car diem) y (cadr diem))
(entmod (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 8 lop)
(cons 62 mau) (cons 100 "AcDbText") (list 10 x y 0.0)
(cons 40 caochu) (cons 50 goc)(cons 1 noidung) (cons 7 kieu)
(cons 72 ha) (list 11 x y 0.0) (cons 100 "AcDbText") (cons 73 va))))
);defun
;Tra ve so lon nhat trong danh sach a
(defun maximum (a)
(setq i 0 maxa (max (nth 0 a) (nth 1 a)))
(repeat (length a) (setq maxa (max (nth i a) maxa)) (setq i (1+ i)))
maxa)
;;Doi so thuc sang chuoi (giong rtos)
;;VD (trtos 1.05 3) -> "1.050"
(defun trtos (Num dec / HSLT N0 N1 N2 N3 them0 them1 CHU)
(setq HSLT dec N0 (+ Num 0.000000001) N1 (- N0 (fix N0)) N2 (rtos N1 2 HSLT)
N3 (- (strlen N2) 2) them0 "." them1 "")
(if (>= N3 HSLT)
(setq CHU (rtos N0 2 HSLT))
(if (= N3 -1)
(setq CHU (strcat (rtos N0 2 HSLT)
(if (= HSLT 0)
(setq them0 "") (repeat HSLT (setq them0 (strcat them0 "0"))))))
(setq CHU (strcat (rtos N0 2 HSLT)
(repeat (- HSLT N3) (setq them1 (strcat them1 "0")))))
);if
);if
CHU)
;the end


ps: trên máy người dùng nhất định phải có font Aptima (vaptimn.ttf) nếu không lsp sẽ bị lỗi.
  • 1

#75 tuanchung

tuanchung

    biết vẽ line

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

Đã gửi 22 July 2013 - 12:36 PM

em load lisp của bác lên thì lệnh laytd thì đc nhưng lenh ghitd thì lỗi thế này bác à 
Command: ghitd
; error: no function definition: TYLE
  • 0

#76 TaiNguyen79

TaiNguyen79

    biết vẽ ellipse

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

Đã gửi 22 July 2013 - 12:43 PM

em load lisp của bác lên thì lệnh laytd thì đc nhưng lenh ghitd thì lỗi thế này bác à 
Command: ghitd
; error: no function definition: TYLE

Sr mình quên xóa 2 dòng :
(setq TL (getvar "userr1"))

(if (<= TL 0.0) (tyle))

trong phần đầu của hàm ghitd đó bạn. Mình đã edit lại rồi đó.

Có lỗi thì trả lời nhé !
  • 1

#77 tuanchung

tuanchung

    biết vẽ line

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

Đã gửi 22 July 2013 - 12:56 PM

cái này hình như đang nhầm giữa X và Y thì phải anh à, Kiểm tra thấy bảng X thành bảng Y bác à
  • 0

#78 TaiNguyen79

TaiNguyen79

    biết vẽ ellipse

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

Đã gửi 22 July 2013 - 01:06 PM

cái này hình như đang nhầm giữa X và Y thì phải anh à, Kiểm tra thấy bảng X thành bảng Y bác à

Tọa độ địa chính thì X = North và Y = East mà bạn :)
  • 0

#79 tuanchung

tuanchung

    biết vẽ line

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

Đã gửi 22 July 2013 - 02:01 PM

bác xem xem phải không nhé em tríc tọa độ 2 điểm này,với cả em muốn chỉnh cái cỡ chữ số hiệu điểm thì chỉnh ở đâu bác, bác đang để 1.0 giờ em muốn cho nó nhỏ hơn chút
đây là file ảnh http://www.upanh.com...&id=8vp5bvcl5oz
  • 0

#80 TaiNguyen79

TaiNguyen79

    biết vẽ ellipse

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

Đã gửi 22 July 2013 - 02:16 PM

bác xem xem phải không nhé em tríc tọa độ 2 điểm này,với cả em muốn chỉnh cái cỡ chữ số hiệu điểm thì chỉnh ở đâu bác, bác đang để 1.0 giờ em muốn cho nó nhỏ hơn chút
đây là file ảnh http://www.upanh.com...&id=8vp5bvcl5oz

Tọa độ địa chính thì như mình đã nói, không có gì phải bàn cả.
Nếu muốn sửa độ lớn của chữ thì bạn tìm dòng như vầy :
(taochu "Soá hieäu" "Text_Bang" 256 p1 1.0 "Aptima")
sửa giá trị 1.0 đi là đc.
PS: Nếu bạn muốn Trục XY như cũ thì hoặc là sửa code hoặc là move cột X thành Y thôi
À mà mình thấy có lẽ bạn cần cái này để lấy tọa độ diểm phải không ?

(defun c:T_id ()
(luuBHT) (setvar "cmdecho" 0)
(initget 1) (setq point01 (getpoint "\nChon diem 1 : \n"))
(setq x1 (rtos (car point01) 2 3) y1 (rtos (cadr point01) 2 3))
(setvar "osmode" 0)
(initget 1) (setq point02 (getpoint point01 "\nChon diem 2 :\n :"))
(setq Angle12 (angle Point01 Point02) dis12 (distance point01 point02))
(if (and (> Angle12 (/ pi 2)) (< Angle12 (* pi 1.5)))
(progn (setq Angle0 pi) (setq Jus "BR"))
(progn (setq Angle0 0.0) (setq Jus "BL")));end if
(setq Point03 (polar (polar Point01 Angle12 dis12) (/ pi 2) 0.275))
(taolop '("Hientrang")) (command "layer" "s" "Hientrang" "")
(command "style" "APTIMA" "vaptimn.ttf" 0 1 0 "" "" "")
(command "pline" point01 "w" 0.0 0.4 (polar Point01 Angle12 1) "w" 0.0 0.0
(polar Point01 Angle12 dis12)
(polar (polar Point01 Angle12 dis12) Angle0 10.5) "")
(command ".text" Jus Point03 1.0 0.0 (strcat "X = " x1) "")
(command ".text" Jus (polar Point03 (* pi 1.5) 2.5) 1.0 0.0 (strcat "Y = " y1) "")
(traBHT) (princ))

(Không có vòng tròn như bạn vì công việc của mình không cần vòng tròn đó )
  • 1