Đến nội dung


Hình ảnh
* * * * * 1 Bình chọn

Xin Lisp xuat toa độ


  • Please log in to reply
49 replies to this topic

#1 vantin_pro

vantin_pro

    Chưa sử dụng CAD

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

Đã gửi 21 July 2009 - 08:07 AM

Em dang lam quy hoach khu độ thị phần giao thông, Bác nào có lisp xuất toạ độ các Nút giao cho em xin !
  • 0

#2 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 22 July 2009 - 07:46 PM

Em dang lam quy hoach khu độ thị phần giao thông, Bác nào có lisp xuất toạ độ các Nút giao cho em xin !


;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:td (/ diem PT1 PT2 PT3 tapx tapy
x y xx yy h n di kc
C PT PTX PTY PTD PTC N
p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tapx '()
tapy '()
stt '()
k 0
h (getreal "\nnhap chieu cao chu:"))

(while
(setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
(progn
(setq PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
x (rtos(car diem) 2 4)
y (rtos (cadr diem) 2 4)
tapx (append tapx (list x))
tapy (append tapy (list y))
k (+ 1 k)
N (strcat "N" (rtos k 2 0))
stt (append stt (list N))
);setq
(setvar "osmode" 0)
(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar PT1 0 (+ di h))
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" PT2 h 0 y
"pline" diem PT1 PT3 ""
"circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )

(setvar "osmode" om)
);progn
);dong while

;tao bang thong ke
(setq kc (* 2 di)
PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ h (cadr p1)))
p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
p33 (list (+ kc (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (car L1))(cadr L1))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "line" p1 p2 ""
"text" "j" "m" p11 h 0 "STT"
"text" "j" "m" p22 h 0 "Täa ®é X"
"text" "j" "m" p33 h 0 "Täa ®é Y"
"line" p3 p4 "")

(while (< k n)
(setq xx (nth k tapx)
yy (nth k tapy)
tstt(nth k stt))
(command "text" "j" "m" PTD h 0 tstt
"text" "j" "m" PTX h 0 xx
"text" "j" "m" PTY h 0 yy
"line" PT PTC "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (car L11))(cadr L11))
);setq
);if
(command "line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado

lisp này ghi tọa độ vào mỗi điểm bạn cần kiểm tra và xuất bảng thống kê tọa độ trực tiếp ra màn hình.
Nếu bạn muốn xuất ra file excel thì mình nghĩ có nhiều cách để làm việc đó khi đã có bảng tọa độ
  • 4

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#3 vantin_pro

vantin_pro

    Chưa sử dụng CAD

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

Đã gửi 23 July 2009 - 09:24 AM

;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:td (/ diem PT1 PT2 PT3 tapx tapy
x y xx yy h n di kc
C PT PTX PTY PTD PTC N
p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tapx '()
tapy '()
stt '()
k 0
h (getreal "\nnhap chieu cao chu:"))

(while
(setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
(progn
(setq PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
x (rtos(car diem) 2 4)
y (rtos (cadr diem) 2 4)
tapx (append tapx (list x))
tapy (append tapy (list y))
k (+ 1 k)
N (strcat "N" (rtos k 2 0))
stt (append stt (list N))
);setq
(setvar "osmode" 0)
(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar PT1 0 (+ di h))
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" PT2 h 0 y
"pline" diem PT1 PT3 ""
"circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )

(setvar "osmode" om)
);progn
);dong while

;tao bang thong ke
(setq kc (* 2 di)
PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ h (cadr p1)))
p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
p33 (list (+ kc (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (car L1))(cadr L1))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "line" p1 p2 ""
"text" "j" "m" p11 h 0 "STT"
"text" "j" "m" p22 h 0 "Täa ®é X"
"text" "j" "m" p33 h 0 "Täa ®é Y"
"line" p3 p4 "")

(while (< k n)
(setq xx (nth k tapx)
yy (nth k tapy)
tstt(nth k stt))
(command "text" "j" "m" PTD h 0 tstt
"text" "j" "m" PTX h 0 xx
"text" "j" "m" PTY h 0 yy
"line" PT PTC "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (car L11))(cadr L11))
);setq
);if
(command "line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado

lisp này ghi tọa độ vào mỗi điểm bạn cần kiểm tra và xuất bảng thống kê tọa độ trực tiếp ra màn hình.
Nếu bạn muốn xuất ra file excel thì mình nghĩ có nhiều cách để làm việc đó khi đã có bảng tọa độ


  • 0

#4 khaosat2009

khaosat2009

    biết lệnh offset

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

Đã gửi 23 July 2009 - 07:06 PM

[quote name='Thaistreetz' date='Jul 22 2009, 19:46' post='68029']

lisp này ghi tọa độ vào mỗi điểm bạn cần kiểm tra và xuất bảng thống kê tọa độ trực tiếp ra màn hình.
Nếu bạn muốn xuất ra file excel thì mình nghĩ có nhiều cách để làm việc đó khi đã có bảng tọa độ

Nhờ Bạn cho biết Font của bảng là fónt gì vậy bạn.
Bạn có thể bổng sung việc xác định tên mốc theo ý người dùng và chiều dài các cạnh khi chọn 2 nút đó vào bảng, canh lề hàng cho đúng theo bên phải.
Bạn giúp cho việc xuất ra file text.
Rất cám ơn

  • 0

#5 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 24 July 2009 - 03:31 AM

Nhờ Bạn cho biết Font của bảng là fónt gì vậy bạn.
Bạn có thể bổng sung việc xác định tên mốc theo ý người dùng và chiều dài các cạnh khi chọn 2 nút đó vào bảng, canh lề hàng cho đúng theo bên phải.
Bạn giúp cho việc xuất ra file text.
Rất cám ơn[/color]


Khuyên bạn: Trước khi đặt câu hỏi bạn nên thử tự tìm câu trả lời cho mình trước đã. ok?
Font sử dụng khi điền tọa độ cũng như khi thống kê bảng chính là font của textstyle đang hiện hành lúc bạn chạy lisp. không khó để nhận ra điều đó. Nếu bạn không hiển thị tốt tiếng việt trong bảng thống kê thì chuyển sang 1 textstyle khác dùng các font thuộc bảng mã TCVN3.
Về yêu cầu của bạn: mình hiểu là khi chạy lisp bạn sẽ tiến hành các bước: nhập cao text -> nhập tên mốc -> nhập chiều dài các cạnh của bảng rồi mới bắt đầu thực hiện pick truy vấn tọa độ mốc đúng không?
=> 1. quá rườm rà
=> 2. Bạn có chắc chiều dài cạnh bạn nhập không quá rộng hoặc không quá hẹp so với cao text? lisp trên đã được tính toán để text được bố trí vào bảng một cách hợp lý nhất. vì thế mình không sửa lại theo yêu cầu nhập chiều dài các cạnh của bảng nữa.
Riêng phần xuất ra file text, mình chưa bg fải làm việc với những file text chứa tọa độ điểm nên không hiểu nội dung của nó sẽ được bố trí như thế nào vì đây không fải chuyên ngành của mình. thế nên mình bó tay khoản này.

đây là lisp bạn có thể nhập tên mốc theo ý muốn của mình
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:td (/ diem PT1 PT2 PT3 tapx tapy
x y xx yy h n di kc ten
C PT PTX PTY PTD PTC N
p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tapx '()
tapy '()
stt '()
k 0
h (getreal "\nnhap chieu cao chu:")
ten (getstring "\nNhap ten diem:"))


(while
(setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
(progn
(setq PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
x (rtos(car diem) 2 4)
y (rtos (cadr diem) 2 4)
tapx (append tapx (list x))
tapy (append tapy (list y))
k (+ 1 k)
N (strcat ten (rtos k 2 0))
stt (append stt (list N))
);setq
(setvar "osmode" 0)
(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar PT1 0 (+ di h))
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" PT2 h 0 y
"pline" diem PT1 PT3 ""
"circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )

(setvar "osmode" om)
);progn
);dong while

;tao bang thong ke
(setq kc (* 2 di)
PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ h (cadr p1)))
p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
p33 (list (+ kc (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (car L1))(cadr L1))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "line" p1 p2 ""
"text" "j" "m" p11 h 0 "STT"
"text" "j" "m" p22 h 0 "Täa ®é X"
"text" "j" "m" p33 h 0 "Täa ®é Y"
"line" p3 p4 "")

(while (< k n)
(setq xx (nth k tapx)
yy (nth k tapy)
tstt(nth k stt))
(command "text" "j" "m" PTD h 0 tstt
"text" "j" "m" PTX h 0 xx
"text" "j" "m" PTY h 0 yy
"line" PT PTC "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (car L11))(cadr L11))
);setq
);if
(command "line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado

PS: mọi người trong diễn đàn thường chỉ cần cảm ơn nhau bằng nút Thank dưới mỗi bài post bạn ạ. thế là đủ :s_dead:
  • 10

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#6 khaosat2009

khaosat2009

    biết lệnh offset

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

Đã gửi 24 July 2009 - 07:17 AM

Cám ơn Bạn nha. khi số điểm lên đến hàng trăm thì số cấn vào vòng tròn.
Mong được bạn giúp
  • 0

#7 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 24 July 2009 - 08:03 AM

-Theo mình thấy thì lisp chỉ đúng trong trường hợp bản vẽ ở tỉ lệ 1-1 và bản vẽ chưa bị dời đi so với lúc mấy anh khảo sát giao cho mình.
-Thực tế khi làm quy hoạch không phải lúc nào bản vẽ cũng ở tỉ lệ 1-1 và trong 1 bản vẽ thường gộp nhiều bản: giao thông, phân lô... .
-Khi viết lisp nên bổ sung thêm phần hỏi tỉ lệ bản vẽ và chọn tọa độ giả định thỉ sẽ hoàn thiện và tiện cho người dùng hơn.
  • 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


#8 khaosat2009

khaosat2009

    biết lệnh offset

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

Đã gửi 24 July 2009 - 01:55 PM

Khuyên bạn: Trước khi đặt câu hỏi bạn nên thử tự tìm câu trả lời cho mình trước đã. ok?
Font sử dụng khi điền tọa độ cũng như khi thống kê bảng chính là font của textstyle đang hiện hành lúc bạn chạy lisp. không khó để nhận ra điều đó. Nếu bạn không hiển thị tốt tiếng việt trong bảng thống kê thì chuyển sang 1 textstyle khác dùng các font thuộc bảng mã TCVN3.
Về yêu cầu của bạn: mình hiểu là khi chạy lisp bạn sẽ tiến hành các bước: nhập cao text -> nhập tên mốc -> nhập chiều dài các cạnh của bảng rồi mới bắt đầu thực hiện pick truy vấn tọa độ mốc đúng không?
=> 1. quá rườm rà
=> 2. Bạn có chắc chiều dài cạnh bạn nhập không quá rộng hoặc không quá hẹp so với cao text? lisp trên đã được tính toán để text được bố trí vào bảng một cách hợp lý nhất. vì thế mình không sửa lại theo yêu cầu nhập chiều dài các cạnh của bảng nữa.
Riêng phần xuất ra file text, mình chưa bg fải làm việc với những file text chứa tọa độ điểm nên không hiểu nội dung của nó sẽ được bố trí như thế nào vì đây không fải chuyên ngành của mình. thế nên mình bó tay khoản này.

đây là lisp bạn có thể nhập tên mốc theo ý muốn của mình

;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:td (/ diem PT1 PT2 PT3 tapx tapy
x y xx yy h n di kc ten
C PT PTX PTY PTD PTC N
p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tapx '()
tapy '()
stt '()
k 0
h (getreal "\nnhap chieu cao chu:")
ten (getstring "\nNhap ten diem:"))


(while
(setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
(progn
(setq PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
x (rtos(car diem) 2 4)
y (rtos (cadr diem) 2 4)
tapx (append tapx (list x))
tapy (append tapy (list y))
k (+ 1 k)
N (strcat ten (rtos k 2 0))
stt (append stt (list N))
);setq
(setvar "osmode" 0)
(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar PT1 0 (+ di h))
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" PT2 h 0 y
"pline" diem PT1 PT3 ""
"circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )

(setvar "osmode" om)
);progn
);dong while

;tao bang thong ke
(setq kc (* 2 di)
PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ h (cadr p1)))
p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
p33 (list (+ kc (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (car L1))(cadr L1))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "line" p1 p2 ""
"text" "j" "m" p11 h 0 "STT"
"text" "j" "m" p22 h 0 "Täa ®é X"
"text" "j" "m" p33 h 0 "Täa ®é Y"
"line" p3 p4 "")

(while (< k n)
(setq xx (nth k tapx)
yy (nth k tapy)
tstt(nth k stt))
(command "text" "j" "m" PTD h 0 tstt
"text" "j" "m" PTX h 0 xx
"text" "j" "m" PTY h 0 yy
"line" PT PTC "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (car L11))(cadr L11))
);setq
);if
(command "line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado

Trong qúa trình chọn điểm chèn tọa độ điểm thường hay bị vướng vào các đường nét khác.
bạn có thể khắc phục để cho di chuyển đến vị trí thích hợp đặt điểm đó không ?
Ví dụ như mình dùng block động.
Mong ban giúp
  • 0

#9 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 24 July 2009 - 04:26 PM

-Theo mình thấy thì lisp chỉ đúng trong trường hợp bản vẽ ở tỉ lệ 1-1 và bản vẽ chưa bị dời đi so với lúc mấy anh khảo sát giao cho mình.
-Thực tế khi làm quy hoạch không phải lúc nào bản vẽ cũng ở tỉ lệ 1-1 và trong 1 bản vẽ thường gộp nhiều bản: giao thông, phân lô... .
-Khi viết lisp nên bổ sung thêm phần hỏi tỉ lệ bản vẽ và chọn tọa độ giả định thỉ sẽ hoàn thiện và tiện cho người dùng hơn.


Để làm được như thế này thì trình em chắc cũng fải tương đương hoặc chí ít là gần bằng anh rồi, em vẫn còn gà mà anh. đọc đến đây em hoa hết cả mắt :s_dead:

@Khaosat2009:
1. mình chưa bao giờ nghĩ có bản vẽ nào đó phải thống kê đến con số hàng trăm điểm tọa độ. nếu bạn muốn mình có thể sửa cho bạn kích thước hình tròn lớn hơn nhưng khi đó nhìn sẽ xấu (với các điểm từ 1-99).
2. Mình không hiểu ý bạn khi muốn "khắc phục để cho di chuyển đến vị trí thích hợp đặt điểm đó". bạn cần ghi tọa độ ở điểm nào thì lisp ghi kết quả ngay tại điểm đó chứ. sao lại move đi đâu nữa?
3. Mình chưa biết đến "Block động" bao giờ cả. fải chăng bạn đang muốn nói block có chưa text tạo bởi lệnh Attribute?
4. bạn có vẻ là người quá nặng nề trong việc trình bày bản vẽ. chỉ một vài thay đổi nhỏ nhặt như thế trong yêu cầu của bạn cũng sẽ khiến mình fải viết lại lisp gần như hoàn toàn đấy. bạn nên chỉnh sửa thủ công theo con mắt thẩm mĩ của bạn thì có lẽ tốt hơn. và nhớ khi đưa yêu cầu nhờ giúp đỡ bạn cố gắng nêu hết những yêu cầu cần thiết mà bạn muốn 1 lần thôi nhé. Viết rồi sửa lại ngại lắm.

Đã sửa lại kích thước hình tròn phù hợp với các điểm tọa tra độ thứ tự từ 100 trờ lên. chắc bạn không cần thống kê đến con số 1000 điểm đâu nhỉ :s_dead:)
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:td (/ diem PT1 PT2 PT3 tapx tapy
x y xx yy h n di kc ten
C PT PTX PTY PTD PTC N
p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tapx '()
tapy '()
stt '()
k 0
h (getreal "\nnhap chieu cao chu:")
ten (getstring "\nNhap ten diem:"))


(while
(setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
(progn
(setq PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
x (rtos(car diem) 2 4)
y (rtos (cadr diem) 2 4)
tapx (append tapx (list x))
tapy (append tapy (list y))
k (+ 1 k)
N (strcat ten (rtos k 2 0))
stt (append stt (list N))
);setq
(setvar "osmode" 0)
(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar PT1 0 (+ di h))
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" PT2 h 0 y
"pline" diem PT1 PT3 ""
"circle" (polar PT3 0 (* 1.8 h)) (* 1.8 h)
"text" "m" (polar PT3 0 (* 1.8 h)) h 0 N )

(setvar "osmode" om)
);progn
);dong while

;tao bang thong ke
(setq kc (* 2 di)
PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ h (cadr p1)))
p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
p33 (list (+ kc (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (car L1))(cadr L1))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "line" p1 p2 ""
"text" "j" "m" p11 h 0 "STT"
"text" "j" "m" p22 h 0 "Täa ®é X"
"text" "j" "m" p33 h 0 "Täa ®é Y"
"line" p3 p4 "")

(while (< k n)
(setq xx (nth k tapx)
yy (nth k tapy)
tstt(nth k stt))
(command "text" "j" "m" PTD h 0 tstt
"text" "j" "m" PTX h 0 xx
"text" "j" "m" PTY h 0 yy
"line" PT PTC "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (car L11))(cadr L11))
);setq
);if
(command "line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado

  • 1

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#10 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 24 July 2009 - 05:10 PM

Để làm được như thế này thì trình em chắc cũng fải tương đương hoặc chí ít là gần bằng anh rồi, em vẫn còn gà mà anh. đọc đến đây em hoa hết cả mắt :s_dead:

-Theo mình thấy thì lisp chỉ đúng trong trường hợp bản vẽ ở tỉ lệ 1-1 và bản vẽ chưa bị dời đi so với lúc mấy anh khảo sát giao cho mình.
-Thực tế khi làm quy hoạch không phải lúc nào bản vẽ cũng ở tỉ lệ 1-1 và trong 1 bản vẽ thường gộp nhiều bản: giao thông, phân lô... .
-Khi viết lisp nên bổ sung thêm phần hỏi tỉ lệ bản vẽ và chọn tọa độ giả định thỉ sẽ hoàn thiện và tiện cho người dùng hơn.

Đây là code mà Tue_NV viết theo ý anh Duy

(defun C:td (/ diem PT1 PT2 PT3 tapx tapy
x y xx yy h n di kc ten
C PT PTX PTY PTD PTC N
p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22 tlv tdo tinhtl tlv)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tinhtl (getreal "\n Mot met bang bao nhieu (mm) ? : "))
(setq tlv (/ tinhtl 1000))

(setq tdo (getpoint "\n Nhap hoac pick toa do tuong doi: "))

(setq tapx '()
tapy '()
stt '()
k 0
h (getreal "\nnhap chieu cao chu:")
ten (getstring "\nNhap ten diem:"))


(while
(setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
(progn
(setq PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
x (rtos (* (- (car diem) (car tdo)) tlv) 2 4)
y (rtos (* (- (cadr diem) (cadr tdo)) tlv) 2 4)
tapx (append tapx (list x))
tapy (append tapy (list y))
k (+ 1 k)
N (strcat ten (rtos k 2 0))
stt (append stt (list N))
);setq
(setvar "osmode" 0)
(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar PT1 0 (+ di h))
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" PT2 h 0 y
"pline" diem PT1 PT3 ""
"circle" (polar PT3 0 (* 1.8 h)) (* 1.8 h)
"text" "m" (polar PT3 0 (* 1.8 h)) h 0 N )

(setvar "osmode" om)
);progn
);dong while

;tao bang thong ke
(setq kc (* 2 di)
PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ h (cadr p1)))
p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
p33 (list (+ kc (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (car L1))(cadr L1))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "line" p1 p2 ""
"text" "j" "m" p11 h 0 "STT"
"text" "j" "m" p22 h 0 "Täa ®é X"
"text" "j" "m" p33 h 0 "Täa ®é Y"
"line" p3 p4 "")

(while (< k n)
(setq xx (nth k tapx)
yy (nth k tapy)
tstt(nth k stt))
(command "text" "j" "m" PTD h 0 tstt
"text" "j" "m" PTX h 0 xx
"text" "j" "m" PTY h 0 yy
"line" PT PTC "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (car L11))(cadr L11))
);setq
);if
(command "line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado

  • 2

#11 khaosat2009

khaosat2009

    biết lệnh offset

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

Đã gửi 24 July 2009 - 05:11 PM

Cám ơn bạn đã giúp
Bạn biết không trong công việc mình rất cần xác định tọa độ một cách chính xác, khi vạch tuyến thiết kế và phạm vi giải tỏa trên bản vẽ hay bình đồ. Cần xác định các điểm tọa độ đó để nhập vào máy đo.
Nên có làm phiển đến bạn. Thông cảm nha.
và đây ý mình nói có thể chuyển được các số và vòng tròn đến vị trí thích hợp ở file đây
http://www.cadviet.c...s/DIEMTOADO.rar
Nếu được xin bạn giúp.
  • 0

#12 khaosat2009

khaosat2009

    biết lệnh offset

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

Đã gửi 03 August 2009 - 03:21 PM

Nhờ Anh giúp em xuất các nội dung trong thửa đất ra bảng,
1. khi chọn thửa xuất ra ô diện tích
2. chọn và Xuất tên, chủ sử dụng, loại đất theo hàng
Rất cám ơn anh
http://www.cadviet.c.../2/drawing2.rar
  • 0

#13 khaosat2009

khaosat2009

    biết lệnh offset

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

Đã gửi 03 August 2009 - 08:06 PM

Xin hỏi bạn, những thông tin trên thửa đất đó bạn làm việc trên đối tượng gì?? Nếu là Block Att thì hoàn toàn lấy ra được đấy khaosat2009 àh. Theo mình được biết thì hầu hết các nhà quy hoạch, tính toán đều ghi thông tin thửa đất theo loại block Att cả.

Cám ơn anh.
Việc ghi thông tin trên thửa này là đơn giản thôi. Chỉ lấy text của ô thửa đó ghi vào ô thôi.
lấy theo Lanđcaviet (LCV) của Cadviet mình đây.
Mong được anh giúp
  • 0

#14 TICON

TICON

    biết vẽ arc

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

Đã gửi 12 September 2009 - 09:20 AM

Sao mình làm nó chỉ xuất ra vòng tròn và 3 số 0 to tướng chứ chẳng có tọa độ già cả bác ạ. Sao thế nhỉ
  • 0

#15 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 12 September 2009 - 04:25 PM

Sao mình làm nó chỉ xuất ra vòng tròn và 3 số 0 to tướng chứ chẳng có tọa độ già cả bác ạ. Sao thế nhỉ

Bạn sửa lại textstyle đang đùng. chọn chiêu cao chữ mặc định là 0
  • 1

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#16 fbh81

fbh81

    biết vẽ ellipse

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

Đã gửi 16 November 2009 - 12:38 PM

Bác Thaistreetz ơi, lisp của bác rất hay nhưng hình như bị lỗi ở đâu đó ( kết quả thừa 1 số 1 ở đầu, ví dụ lúc nhập tên điểm định vị là 1 thì kết quả lại ra 11, 2 thì ra 12...) bác tranh thủ xem lại hộ anh em nhé.
  • 0

#17 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 16 November 2009 - 12:54 PM

Tên điểm định vị bạn nhâp là một Ký Tự. Mình viết như thế để sử dụng cho trường hợp tên điêm định vị của bạn dạng A1, A2.. An.
Trường hợp bạn không nhập tên ở bước này, lisp sẽ thống kê tên chỉ có số thứ tự: 1, 2, ... n.
  • 1

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#18 fbh81

fbh81

    biết vẽ ellipse

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

Đã gửi 16 November 2009 - 02:31 PM

À ra vậy, cảm ơn bác nhiều, lisp của bác rất dễ sử dụng. Tuy nhiên để đổi vị trí giữa X và Y thì phải đổi x =>y, y=>x trong lisp đúng ko bác, vì trong Cad tọa độ XY ngược với kết quả đo của máy trắc đạc.
  • 1

#19 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 17 November 2009 - 04:08 PM

Mình không làm trắc đạc lên cũng chưa rõ hệ trục tọa độ mà bản vẽ máy trắc đạc xuất ra như thế nào. bạn chạy lisp trong bản vẽ ấy, nếu đơn thuần chỉ là thay đổi giá trị của X và Y cho nhau thì sửa cũng đơn giản thôi, bạn cứ thử nghiên cứu lisp để tự sửa. nếu gặp khó khăn thì mình sẽ giúp.
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#20 haiaubac3000

haiaubac3000

    Chưa sử dụng CAD

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

Đã gửi 30 November 2009 - 10:35 AM

Các bạn cho minh hỏi, sao khi minh dùng lệnh AP để add lisp vào thì bị lỗi, 2 dòng lệnh xuất hiện:
Command: ap APPLOAD td.lsp successfully loaded.
Command: ; error: syntax error

Rồi đánh lệnh td ko được! Mình đang rất cần cái lisp này! Cảm ơn các bạn.
  • 0