Đến nội dung


Hình ảnh
- - - - -

Lisp ghi tọa độ rất hay mà bị lỗi!


  • Please log in to reply
33 replies to this topic

#21 tivanteo

tivanteo

    biết vẽ circle

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

Đã gửi 28 August 2009 - 12:09 PM

theo mình nên cho thêm 1 lệnh này nữa

(COMMAND "STYLE" "STANDARD" "" 0 "" 1 "" "" "")
  • 0

#22 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 28 August 2009 - 04:47 PM

theo mình nên cho thêm 1 lệnh này nữa

(COMMAND "STYLE" "STANDARD" "" 0 "" 1 "" "" "")

Cho vào đâu? và cho vào để làm gì hả bạn? Bản thân textstyle Standard mặc định không dùng font thuộc các bảng mã tiếng việt, font đó chữ cũng rất xấu.
  • 0

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


#23 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 01 September 2009 - 03:24 PM

Chào bạn Thaistreetz.
Mình mới lên diễn đàn còn gà lằm mong các pác thông cảm.
Yêu cầu của mình là tại bảng thống kê toạ nút thì có thêm cột ghi chú, độ rộng cột gấp rưỡi độ rộng cột toạ độ x hoặc y, ở trong không cần ghi chú gì.
http://www.cadviet.c.../lay_toa_do.lsp
  • 1

#24 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 01 September 2009 - 04:49 PM

Code của bạn đây. hi vọng nó đúng ý bạn.

(prompt"\n[cmd : TDN] - THONG KE TOA DO\n")
----------------------------------------------
(defun C:tdn () (prompt"\nTHONG KE TOA DO\n")
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tapx '() tapy '() stt '()
ten (getstring "\nTên Nút:"))
(if (not h) (setq h 1))
(if (not i) (setq i 1))
(setq i1 (getreal (strcat"\nSTT Nút Ðâu Tiên < " (rtos i 2 0) " >: "))
caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >:")))
(if i1 (setq i i1))
(if caot1 (setq h caot1))
(setvar "osmode" 125)
(setq lacol (getvar "CEColor") k (- i 1))
;================================================
(While
(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))
(Progn
(setvar "osmode" 0)
(setq DX (getpoint (strcat"\nDiem dat text thu "(rtos (+ k 1) 2 0)"") D1)
x (rtos (car D1) 2 4)
y (rtos (cadr D1) 2 4)
TX (strcat "X:"(rtos (Car D1) 2 4))
TY (strcat "Y:"(rtos (Cadr D1) 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
(if (>= (car DX) (car D1))
(progn
(setq D2 (list (+ (car DX) (* 0.5 h)) (cadr DX)))
(command "text" "BL" D2 h 0 tX)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 0 (+ di (* 0.6 h)))
pt4 (list (car D2) (- (cadr D2) (* 1.35 h)))
pt5 (list (+ (car D2) di) (- (cadr D2) (* 1.35 h)))
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h ty
"pline" D1 DX PT3 ""
"circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
"circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)
"text" "m" (polar PT3 0 (* 1.5 h)) h 0 N
"CECOLOR" 8
"circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)
);command
(setvar "CECOLOR" lacol)
);progn
);if
(if (< (car DX) (car D1))
(progn
(setq D2 (list (- (car DX) (* 0.5 h)) (cadr DX)))
(command "text" "BR" D2 h 0 tx)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 0 (- (+ di (* 0.6 h))))
pt4 (list (- (car D2) di) (- (cadr D2) (* 1.35 h)))
pt5 (list (car D2) (- (cadr D2) (* 1.35 h)))
PT6 (list (- (car PT3) (* 3 h)) (cadr PT3))
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h TY
"pline" D1 DX PT3 ""
"circle" (polar PT6 0 (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT6 0 (* 1.5 h)) h 0 N
"CECOLOR" 8
"circle" (polar PT6 0 (* 1.5 h)) (* 1.35 h)
);command
(setvar "CECOLOR" lacol)
);progn
);if
);progn
(setvar "osmode" 125)
);while
(setq i (+ k 1))
;=============================================
(setq bit (cond (bit) ("Yes")))
(initget "Yes No")
(setq Tmp (strcat "\nXuât Bang Toa Ðô? [Yes/No] <" bit ">: ")
bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "Yes")
(progn
(setq di (- di (* 1.7 h))
kc (* 2 di)
PT (getpoint"\nVi tri dat bang")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTCc (list (+ (* 1.5 kc) (car PTC)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p2c (list (+ (* 1.5 kc) (car P2)) (cadr p2))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
p4c (list (+ (* 1.5 kc) (car P4)) (cadr p4))
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))
p44 (list (+ (* kc 0.75) (car p4)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (car L1))(cadr L1))
L3 (list (+ (* 1.5 kc) (car p4)) (cadr p4))
PTB (list (+ (* 0.5 (+ (* 2 kc) (* 1.5 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "CECOLOR" 3 "line" p1 p2c "" "line" p3 p4c "" "CECOLOR" 2
"text" "m" p11 h 0 "STT"
"text" "m" p22 h 0 "Täa ®é X"
"text" "m" p33 h 0 "Täa ®é Y"
"text" "m" p44 h 0 "Ghi chó"
"text" "m" pTB (* 1.3 h) 0 "%%UB¶ng thèng kª täa ®é nót")
(while (< k n)
(setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt))
(command "CECOLOR" 2
"text" "m" PTD h 0 tstt
"text" "m" PTX h 0 xx
"text" "m" PTY h 0 yy
"CECOLOR" 3
"line" PT PTCc "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTCc (list (+ (* 1.5 kc) (car ptc)) (cadr ptc))
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))
L33 (list (+ (* 1.5 kc) (car PTC)) (cadr PTC))
);setq
);if
(command "CECOLOR" 3
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 ""
"line" L3 L33 "")
);progn
);if
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(prompt"\n[TDN - THONG KE TOA DO] by Thaistreetz - huuthais@yahoo.com\n")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
);DONG toado

  • 1

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


#25 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 01 September 2009 - 05:33 PM

Cám ơn Thaistreetz đúng ý tớ rồi :s_big:
  • 0

#26 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 12 September 2009 - 08:12 AM

Code của bạn đây. hi vọng nó đúng ý bạn.


(prompt"\n[cmd : TDN] - THONG KE TOA DO\n")
----------------------------------------------
(defun C:tdn () (prompt"\nTHONG KE TOA DO\n")
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tapx '() tapy '() stt '()
ten (getstring "\nTên Nút:"))
(if (not h) (setq h 1))
(if (not i) (setq i 1))
(setq i1 (getreal (strcat"\nSTT Nút Ðâu Tiên < " (rtos i 2 0) " >: "))
caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >:")))
(if i1 (setq i i1))
(if caot1 (setq h caot1))
(setvar "osmode" 125)
(setq lacol (getvar "CEColor") k (- i 1))
;================================================
(While
(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))
(Progn
(setvar "osmode" 0)
(setq DX (getpoint (strcat"\nDiem dat text thu "(rtos (+ k 1) 2 0)"") D1)
x (rtos (car D1) 2 4)
y (rtos (cadr D1) 2 4)
TX (strcat "X:"(rtos (Car D1) 2 4))
TY (strcat "Y:"(rtos (Cadr D1) 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
(if (>= (car DX) (car D1))
(progn
(setq D2 (list (+ (car DX) (* 0.5 h)) (cadr DX)))
(command "text" "BL" D2 h 0 tX)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 0 (+ di (* 0.6 h)))
pt4 (list (car D2) (- (cadr D2) (* 1.35 h)))
pt5 (list (+ (car D2) di) (- (cadr D2) (* 1.35 h)))
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h ty
"pline" D1 DX PT3 ""
"circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
"circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)
"text" "m" (polar PT3 0 (* 1.5 h)) h 0 N
"CECOLOR" 8
"circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)
);command
(setvar "CECOLOR" lacol)
);progn
);if
(if (< (car DX) (car D1))
(progn
(setq D2 (list (- (car DX) (* 0.5 h)) (cadr DX)))
(command "text" "BR" D2 h 0 tx)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 0 (- (+ di (* 0.6 h))))
pt4 (list (- (car D2) di) (- (cadr D2) (* 1.35 h)))
pt5 (list (car D2) (- (cadr D2) (* 1.35 h)))
PT6 (list (- (car PT3) (* 3 h)) (cadr PT3))
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h TY
"pline" D1 DX PT3 ""
"circle" (polar PT6 0 (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT6 0 (* 1.5 h)) h 0 N
"CECOLOR" 8
"circle" (polar PT6 0 (* 1.5 h)) (* 1.35 h)
);command
(setvar "CECOLOR" lacol)
);progn
);if
);progn
(setvar "osmode" 125)
);while
(setq i (+ k 1))
;=============================================
(setq bit (cond (bit) ("Yes")))
(initget "Yes No")
(setq Tmp (strcat "\nXuât Bang Toa Ðô? [Yes/No] <" bit ">: ")
bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "Yes")
(progn
(setq di (- di (* 1.7 h))
kc (* 2 di)
PT (getpoint"\nVi tri dat bang")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTCc (list (+ (* 1.5 kc) (car PTC)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p2c (list (+ (* 1.5 kc) (car P2)) (cadr p2))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
p4c (list (+ (* 1.5 kc) (car P4)) (cadr p4))
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))
p44 (list (+ (* kc 0.75) (car p4)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (car L1))(cadr L1))
L3 (list (+ (* 1.5 kc) (car p4)) (cadr p4))
PTB (list (+ (* 0.5 (+ (* 2 kc) (* 1.5 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "CECOLOR" 3 "line" p1 p2c "" "line" p3 p4c "" "CECOLOR" 2
"text" "m" p11 h 0 "STT"
"text" "m" p22 h 0 "Täa ®é X"
"text" "m" p33 h 0 "Täa ®é Y"
"text" "m" p44 h 0 "Ghi chó"
"text" "m" pTB (* 1.3 h) 0 "%%UB¶ng thèng kª täa ®é nót")
(while (< k n)
(setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt))
(command "CECOLOR" 2
"text" "m" PTD h 0 tstt
"text" "m" PTX h 0 xx
"text" "m" PTY h 0 yy
"CECOLOR" 3
"line" PT PTCc "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTCc (list (+ (* 1.5 kc) (car ptc)) (cadr ptc))
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))
L33 (list (+ (* 1.5 kc) (car PTC)) (cadr PTC))
);setq
);if
(command "CECOLOR" 3
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 ""
"line" L3 L33 "")
);progn
);if
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(prompt"\n[TDN - THONG KE TOA DO] by Thaistreetz - huuthais@yahoo.com\n")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
);DONG toado

Cám ơn Bạn.
Qua Lisp bạn đã giúp mình thực hiện rất tốt trong công việc.
Xin nhờ bạn giúp cho thêm các cột của Lisp trên, như sau :
À, mục đích là thống kê các điểm cũa các đỉnh đường trong giao thông.
Xuất ra bảng thống kê giao thông, gồm :
----------------------------
stt - tên điểm - Tên đường - toạ độ X - Toạ độ Y - Cao độ Tự nhiên - Cao độ Thiết kế - Chiều dài Cạnh - Ghi chú.
----------------------------
Trên bảng tọa độ trên, thì khi thực hiện ta chọn lần lược theo cạnh, Điểm 1 và điểm 2 ( trong qúa trình chọn điểm này sẻ ghi tên điểm tùy ý ) , kết thúc việc đánh dấu điểm chọn 1 cạnh, yêu cầu nhập tên đường, CDTN,CDTK, xong ........>> xuất ra bảng theo các nội dung ở trên và kẻ khung kết thúc cạnh 1.
Và chọn tiếp cạnh 2, thực hiện như trước....> xuất kết qủa nối vào bảng trên.
Rất mong được Bạn giúp.
  • 0

#27 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:31 PM

Cám ơn Bạn.
Qua Lisp bạn đã giúp mình thực hiện rất tốt trong công việc.
Xin nhờ bạn giúp cho thêm các cột của Lisp trên, như sau :
À, mục đích là thống kê các điểm cũa các đỉnh đường trong giao thông.
Xuất ra bảng thống kê giao thông, gồm :
----------------------------
stt - tên điểm - Tên đường - toạ độ X - Toạ độ Y - Cao độ Tự nhiên - Cao độ Thiết kế - Chiều dài Cạnh - Ghi chú.
----------------------------
Trên bảng tọa độ trên, thì khi thực hiện ta chọn lần lược theo cạnh, Điểm 1 và điểm 2 ( trong qúa trình chọn điểm này sẻ ghi tên điểm tùy ý ) , kết thúc việc đánh dấu điểm chọn 1 cạnh, yêu cầu nhập tên đường, CDTN,CDTK, xong ........>> xuất ra bảng theo các nội dung ở trên và kẻ khung kết thúc cạnh 1.
Và chọn tiếp cạnh 2, thực hiện như trước....> xuất kết qủa nối vào bảng trên.
Rất mong được Bạn giúp.

Bạn up một bản vẽ của bạn lên cho mình xem đi. trong đó kẻ luôn định dạng bảng thống kê bạn muốn. Mình sẽ viết theo những gì bạn vẽ. đọc yêu cầu thế này mình khó hình dung quá :s_big:
  • 0

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


#28 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 14 September 2009 - 02:42 PM

Bạn up một bản vẽ của bạn lên cho mình xem đi. trong đó kẻ luôn định dạng bảng thống kê bạn muốn. Mình sẽ viết theo những gì bạn vẽ. đọc yêu cầu thế này mình khó hình dung quá :s_big:

mình đang làm công việc về QH giao thông, cho nên việc thống kê các yếu tố về giao thông Rất cần các bảng như bạn xây dựng đã viết Lisp trên, Chủ yếu cạnh các đỉnh đường, toạ độ, ghi chú.... của các bảng,
http://www.cadviet.c..._giao_thong.rar
Mong được Bạn giúp
  • 0

#29 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 14 September 2009 - 04:04 PM

Xuất ra bảng thống kê giao thông, gồm :
----------------------------
stt - tên điểm - Tên đường - toạ độ X - Toạ độ Y - Cao độ Tự nhiên - Cao độ Thiết kế - Chiều dài Cạnh - Ghi chú.
----------------------------
Trên bảng tọa độ trên, thì khi thực hiện ta chọn lần lược theo cạnh, Điểm 1 và điểm 2 ( trong qúa trình chọn điểm này sẻ ghi tên điểm tùy ý ) , kết thúc việc đánh dấu điểm chọn 1 cạnh, yêu cầu nhập tên đường, CDTN,CDTK, xong ........>> xuất ra bảng theo các nội dung ở trên và kẻ khung kết thúc cạnh 1.
Và chọn tiếp cạnh 2, thực hiện như trước....> xuất kết qủa nối vào bảng trên.

http://www.cadviet.c..._giao_thong.rar

Yêu cầu trên của bạn và bản vẽ bạn up không giống nhau một chút nào. Mình chịu thua :s_big:
  • 0

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


#30 toai

toai

    biết vẽ ellipse

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

Đã gửi 19 June 2012 - 09:22 PM

Nhờ bạn Thaistreet và ACE trên CadViet viết bổ sung thêm chức năng sau khi ghi tọa độ ra bản vẽ, lisp sẽ xuất các số liệu tọa độ sang Excel hoặc Notepad thì những người được "hưởng lợi" như tôi sẽ không phải apload thêm 1 lisp nữa khi làm việc bằng sản phẩm này.(Cụ thể là thêm:"Xuất số liệu sang Excel", chọn "Y" hoặc "N"
http://www.cadviet.c..._do_diemtdn.lsp.
  • 0
Mưu sự tại nhân, thành sự tại thiên.

#31 Minh Kiên

Minh Kiên

    Chưa sử dụng CAD

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

Đã gửi 22 September 2014 - 02:51 PM

Code của bạn đây. hi vọng nó đúng ý bạn.

(prompt"\n[cmd : TDN] - THONG KE TOA DO\n")----------------------------------------------(defun C:tdn () (prompt"\nTHONG KE TOA DO\n")(setvar "cmdecho" 0 )(command "Undo" "Begin")  (setq om (getvar "osmode"))(setq tapx '() tapy '() stt '()      ten (getstring "\nTên Nút:"))(if (not h) (setq h 1))(if (not i) (setq i 1))(setq i1  (getreal (strcat"\nSTT Nút Ðâu Tiên < " (rtos i 2 0) " >: "))    caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >:")))(if i1 (setq i i1))(if caot1 (setq h caot1))(setvar "osmode" 125)(setq lacol (getvar "CEColor") k (- i 1));================================================(While(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))(Progn  (setvar "osmode" 0)  (setq DX (getpoint (strcat"\nDiem dat text thu "(rtos (+ k 1) 2 0)"") D1)        x   (rtos (car D1) 2 4)        y   (rtos (cadr D1) 2 4)	TX (strcat "X:"(rtos (Car D1) 2 4))	TY (strcat "Y:"(rtos (Cadr D1) 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  (if (>= (car DX) (car D1)) 	(progn	(setq D2 (list (+ (car DX) (* 0.5 h)) (cadr DX)))	       	(command "text" "BL" D2 h 0 tX)  	(setq   TB  (textbox (entget(entlast)))    		LC  (car TB)   		RC  (cadr TB)    		di  (distance LC RC)		PT3 (polar D2 0 (+ di (* 0.6 h)))		pt4 (list (car D2) (- (cadr D2) (* 1.35 h)))		pt5 (list (+ (car D2) di) (- (cadr D2) (* 1.35 h)))				C   (polar PT3 0 (* 1.5 h))  	);setq  	(command "text" "F" PT4 PT5 h ty           	 "pline" D1 DX PT3 ""           	 "circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)           	 "circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)           	 "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N            	 "CECOLOR" 8		 "circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)  	  );command	  (setvar "CECOLOR" lacol)	);progn   );if  (if (< (car DX) (car D1)) 	(progn	  (setq D2 (list (- (car DX) (* 0.5 h)) (cadr DX)))	     	  (command "text" "BR" D2 h 0 tx)  	  (setq   TB  (textbox (entget(entlast)))    		  LC  (car TB)   		  RC  (cadr TB)    		  di  (distance LC RC)		  PT3 (polar D2 0 (- (+ di (* 0.6 h))))		  pt4 (list (- (car D2) di) (- (cadr D2) (* 1.35 h)))		  pt5 (list (car D2) (- (cadr D2) (* 1.35 h)))		  PT6 (list (- (car PT3) (* 3 h)) (cadr PT3))		  C   (polar PT3 0 (* 1.5 h))  	  );setq  	  (command "text" "F" PT4 PT5 h TY           	   "pline" D1 DX PT3 ""           	   "circle" (polar PT6 0 (* 1.5 h)) (* 1.5 h)           	   "text" "m" (polar PT6 0 (* 1.5 h)) h 0 N            	   "CECOLOR" 8		   "circle" (polar PT6 0 (* 1.5 h)) (* 1.35 h)  	  );command	  (setvar "CECOLOR" lacol)	);progn   );if);progn(setvar "osmode" 125));while(setq i (+ k 1));=============================================(setq bit (cond (bit) ("Yes")))(initget "Yes No")(setq	Tmp (strcat "\nXuât Bang Toa Ðô? [Yes/No] <" bit ">: ")	bit (cond ((getkword Tmp)) (bit)))(if (eq bit "Yes")(progn(setq	di (- di (* 1.7 h))	kc (* 2 di)        PT (getpoint"\nVi tri dat bang")    	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))	PTCc (list (+ (* 1.5 kc) (car PTC)) (cadr PT))      	p1 (list (car PT) (+ (cadr PT)(* 2 h)))      	p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))	p2c (list (+ (* 1.5 kc) (car P2)) (cadr p2))      	p3 (list (car p1) (+ (cadr p1)(* 2 h)))      	p4 (list (car p2) (+ (cadr p2)(* 2 h)))	p4c (list (+ (* 1.5 kc) (car P4)) (cadr p4))     	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))	p44 (list (+ (* kc 0.75) (car p4)) (cadr p22))      	L1 (list (+ di (car p3))(cadr p3))      	L2 (list (+ kc (car L1))(cadr L1))	L3 (list (+ (* 1.5 kc) (car p4)) (cadr p4))	PTB (list (+ (* 0.5 (+ (* 2 kc) (* 1.5 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))     	n (length tapx)     	k 0);setq(setvar "osmode" 0)(command "CECOLOR" 3 "line" p1 p2c "" "line" p3 p4c "" "CECOLOR" 2       	"text" "m" p11 h 0 "STT"        	"text" "m" p22 h 0 "Täa ®é X"        	"text" "m" p33 h 0 "Täa ®é Y"	"text" "m" p44 h 0 "Ghi chó"       	"text" "m" pTB (* 1.3 h) 0 "%¶ng thèng kª täa ®é nót")    (while (< k n) (setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt))(command "CECOLOR" 2	 "text" "m" PTD h 0 tstt          "text" "m" PTX h 0 xx          "text" "m" PTY h 0 yy	 "CECOLOR" 3          "line" PT PTCc "")    (setq 	PT (list (car PT) (- (cadr PT)(* 2 h)))	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))	PTCc (list (+ (* 1.5 kc) (car ptc)) (cadr ptc))	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))	L33 (list (+ (* 1.5 kc) (car PTC)) (cadr PTC)) );setq);if(command "CECOLOR" 3 	"line" p3 PT ""	"line" p4 PTC ""	"line" L1 L11 ""	"line" L2 L22 ""	"line" L3 L33 ""));progn);if(setvar "CECOLOR" lacol)(setvar "osmode" om)(prompt"\n[TDN - THONG KE TOA DO] by Thaistreetz - huuthais@yahoo.com\n")(command "Undo" "End")(setvar "cmdecho" 1)(princ));DONG toado

Chào bạn,mình đã tìm kiếm trên diễn đàn mấy ngày nay và thấy cái lisp về toạ độ này gần với mong muốn của mình nhất nhưng vẫn còn một vài điểm vẫn chưa đúng lắm bạn có thể chỉnh giúp mình được không:

+Sau khi gõ lệnh: nó sẽ hỏi thêm chọn gốc toạ độ  /chiều cao text/tên nút tự động/số tt/

+Chọn điểm lấy toạ độ (nếu có thể chọn theo cung tròn hay đường tròn để lấy tâm và đường kính sau này xuất ra bảng thì tốt quá) /chọn điểm đặt mà không cần chọn góc nghiêng / tương tự các điểm khác.

+Xuất và đặt bảng toạ độ ra màn hình.OK

+Tại đầu của đường thẳng chỉ vào toạ độ đang lấy có mũi tên hoặc dấu chấm (bằng chiều cao chữ đã chọn) ; phần thập phân của x,y lấy tròn đến chữ số phần trăm (0.01)và x,y này có thể liên kết với điểm tâm (đối tượng chọn để lấy điểm) tránh trường hợp khi update điểm hoặc di chuyển vị trí mà toạ độ không đổi.

Mình rất mong sự phản hồi của bạn,cảm ơn bạn đã tạo ra lisp này.


  • 0

#32 hoang_dung

hoang_dung

    biết vẽ ellipse

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

Đã gửi 30 October 2015 - 11:26 AM

Nhờ các Pro sửa lại lisp này ko thể hiện X, Y mà chỉ thể hiện tên điểm thôi giúp em!

Xin cảm ơn!

 

http://www.cadviet.c...hongketoado.lsp

 

99663_unnamed.jpg


  • 0

Liên hệ : 0982 008 725 (Mr Ngọc) để mua phần mềm ANDDESIGN bản quyền khóa cứng


#33 hoang_dung

hoang_dung

    biết vẽ ellipse

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

Đã gửi 30 October 2015 - 01:39 PM

upppppppppppppppppppppppppppp


  • -1

Liên hệ : 0982 008 725 (Mr Ngọc) để mua phần mềm ANDDESIGN bản quyền khóa cứng


#34 namgiangduy89

namgiangduy89

    biết vẽ pline

  • Members
  • PipPip
  • 61 Bài viết
Điểm đánh giá: -19 (hơi kém)

Đã gửi 02 December 2015 - 08:25 AM

Hi vọng bạn đã hài lòng với code này.
- Cho phép lựa chọn ghi tên điểm tọa độ tự động (giống lisp trước) hay thủ công (Pick chuột vào text có sẵn - tên cọc trên tuyến chẳng hạn)
- Cho phép ghi text tọa độ theo một góc xiên bất kỳ
- Cho phép lựa chọn có xuất bảng tọa độ hay không.

(prompt"\n[cmd : TDN] - THONG KE TOA DO by Thaistreetz - huuthais@yahoo.com\n")
----------------------------------------------
(defun C:tdn ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 2) " >:")))
(if caot1 (setq h caot1))
(setq tapx '() tapy '() stt '())

(setq bit1 (cond (bit1) ("Yes")))
(initget "Yes No")
(setq Tmp1 (strcat "\nTu dong ghi ten nut? [Yes/No] <" bit1 ">: ")
bit1 (cond ((getkword Tmp1)) (bit1)))
(if (eq bit1 "Yes")
(progn
(setq ten (getstring "\nTen Nut:"))
(if (not i) (setq i 1))
(setq i1 (getreal (strcat"\nSTT cua nut bat dau < " (rtos i 2 0) " >: ")))
(if i1 (setq i i1))

(setvar "osmode" 125)
(setq lacol (getvar "CEColor") k (- i 1))
(While
(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))
(Progn
(setvar "osmode" 0)
(setq DX (getpoint (strcat"\nDiem dat text thu "(rtos (+ k 1) 2 0)"") D1)
DY (getpoint (strcat"\nHuong goc nghieng cua text "(rtos (+ k 1) 2 0)"") Dx)
angr (angle Dx Dy)
angd (/ (* 180 angr) pi)
x (rtos (car D1) 2 4)
y (rtos (cadr D1) 2 4)
TX (strcat "X:"(rtos (Car D1) 2 4))
TY (strcat "Y:"(rtos (Cadr D1) 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
(if (>= (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 h)))
(command "text" "BL" D2 h angd tX)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 angr (+ di (* 0.4 h)))
pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 h))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h ty
"pline" D1 DX PT3 ""
"circle" (polar PT3 angr (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT3 angr (* 1.5 h)) h angd N
"CECOLOR" 8
"circle" (polar PT3 angr (* 1.5 h)) (* 1.35 h)
);command
(setvar "CECOLOR" lacol)
);progn
);if
(if (< (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 h)))
(command "text" "BR" D2 h (+ angd 180) tx)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 angr (+ di (* 0.4 h)))
pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 h))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT5 PT4 h TY
"pline" D1 DX PT3 ""
"circle" (polar PT3 angr (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT3 angr (* 1.5 h)) h (+ angd 180) N
"CECOLOR" 8
"circle" (polar PT3 angr (* 1.5 h)) (* 1.35 h)
);command
(setvar "CECOLOR" lacol)
);progn
);if
);progn
(setvar "osmode" 125)
);while
(setq i (+ k 1))
);progn
);if
(if (eq bit1 "No")
(progn
(setvar "osmode" 125)
(setq lacol (getvar "CEColor") i 1 k (- i 1))
(While
(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))
(Progn
(setvar "osmode" om)
(progn
(setq LOOP T)
(while (= LOOP T)
(while (null (setq ten (nentsel "\nChon mot text lam ten nut: ")))
(princ "\nChua tim thay doi tuong la text, chon lai !"));while
(setq Source_text (entget (car ten)))
(if (or (= (cdr (assoc '0 Source_text)) "TEXT")
(= (cdr (assoc '0 Source_text)) "MTEXT")
(= (cdr (assoc '0 Source_text)) "ATTRIB"));or
(progn
(setq N (cdr (assoc 1 Source_text)))
(setq LOOP nil));progn
(progn
(princ "Phai chon mot text lam ten nut !")
(setq LOOP T));progn
)if
);while
);progn
(setvar "osmode" 0)
(setq DX (getpoint (strcat"\nDiem dat text cua nut "N"") D1)
DY (getpoint (strcat"\nHuong goc nghieng cua text") Dx)
angr (angle Dx Dy))
(setq angd (/ (* 180 angr) pi)
x (rtos (car D1) 2 4)
y (rtos (cadr D1) 2 4)
TX (strcat "X:"(rtos (Car D1) 2 4))
TY (strcat "Y:"(rtos (Cadr D1) 2 4))
tapx (append tapx (list x))
tapy (append tapy (list y))
k (+ 1 k)
stt (append stt (list N))
);setq
(if (>= (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 h)))
(command "text" "BL" D2 h angd tX)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 angr (+ di (* 0.4 h)))
pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 h))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h ty
"pline" D1 DX PT3 ""
"circle" (polar PT3 angr (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT3 angr (* 1.5 h)) h angd N
"CECOLOR" 8
"circle" (polar PT3 angr (* 1.5 h)) (* 1.35 h)
);command
(setvar "CECOLOR" lacol)
);progn
);if
(if (< (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 h)))
(command "text" "BR" D2 h (+ angd 180) tx)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 angr (+ di (* 0.4 h)))
pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 h))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT5 PT4 h TY
"pline" D1 DX PT3 ""
"circle" (polar PT3 angr (* 1.5 h)) (* 1.5 h)
"text" "m" (polar PT3 angr (* 1.5 h)) h (+ angd 180) N
"CECOLOR" 8
"circle" (polar PT3 angr (* 1.5 h)) (* 1.35 h)
);command
(setvar "CECOLOR" lacol)
);progn
);if
);progn
(setvar "osmode" 125)
);while
(setq i (+ k 1))
);progn
);if
(setq bit (cond (bit) ("Yes")))
(initget "Yes No")
(setq Tmp (strcat "\nXuât Bang Toa Ðô? [Yes/No] <" bit ">: ")
bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "Yes")
(progn
(setq di (- di (* 0.4 h))
kc (* 2 di)
PT (getpoint"\nVi tri dat bang")
PTC (list (+ (* 2 kc) (- di h h h h) (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) (- 0 h) (car PTD)) (cadr PTD))
PTY (list (+ kc (- h h h h) (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ (* 1.1 h) (cadr p1)))
p22 (list (+ di (/ di 2) (- 0 h) (car p11)) (- (cadr p11) (* 0.1 h)))
p33 (list (+ kc (- h h h h) (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (- 0 h h)(car L1))(cadr L1))
PTB (list (+ (- (* 2 h)) (* 0.5 (+ (* 2 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "CECOLOR" 3 "line" p1 p2 "" "line" p3 p4 "" "CECOLOR" 2
"text" "m" p11 h 0 "Tªn Nót"
"text" "m" p22 h 0 "Täa ®é X"
"text" "m" p33 h 0 "Täa ®é Y"
"text" "m" pTB (* 1.3 h) 0 "%¶ng thèng kª täa ®é nót")
(while (< k n)
(setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt))
(command "CECOLOR" 2
"text" "m" PTD h 0 tstt
"text" "m" PTX h 0 xx
"text" "m" PTY h 0 yy
"CECOLOR" 3
"line" PT PTC "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (- 0 h) (car PTD)) (cadr PTD))
PTY (list (+ kc (- h h h h) (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 h h h h) (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (- 0 h h) (car L11))(cadr L11))
);setq
);if
(command "CECOLOR" 3
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
);progn
);if
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(prompt"\n[TDN - THONG KE TOA DO] by Thaistreetz - huuthais@yahoo.com\n")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
);DONG toa do

 

Anh bổ sung dùm em vòng tròn hiện ra khi pick điểm với.thanks


  • -2