Đến nội dung


Hình ảnh
- - - - -

Nhờ Anh Em Sửa Giúp Lisp Pick Tọa Độ


  • Please log in to reply
11 replies to this topic

#1 quachno1

quachno1

    biết pan

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

Đã gửi 28 August 2015 - 10:38 AM

http://www.cadviet.c...841_ttd_new.lsp

 

Mình xin được Lisp pick tọa độ này hay quá. Nhưng mình làm trắc đạc, chỉ cần hiển thị phần tọa độ và không cần hiển thị nút. Nhờ anh em sửa giúp, thanks anh em!

11893895_10203439701392090_6140996026103


  • -2

#2 Tr.CongSon

Tr.CongSon

    biết lệnh array

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

Đã gửi 28 August 2015 - 01:49 PM

Thế có cần hiện bang thong kê toạ độ điểm không bạn???

Có cần theo Text Style nào không ?


  • 0

#3 quachno1

quachno1

    biết pan

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

Đã gửi 28 August 2015 - 02:30 PM

Thế có cần hiện bang thong kê toạ độ điểm không bạn???

Có cần theo Text Style nào không ?

Mọi thứ giữ như cũ, mình chỉ không muốn có ký tự nút đi kèm theo lúc pick tọa độ như hình vẽ mình minh họa thôi. Thanks!


  • 0

#4 Tr.CongSon

Tr.CongSon

    biết lệnh array

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

Đã gửi 28 August 2015 - 02:44 PM

Mọi thứ giữ như cũ, mình chỉ không muốn có ký tự nút đi kèm theo lúc pick tọa độ như hình vẽ mình minh họa thôi. Thanks!

 

Bảng thống kê có 3 cột :Tên điểm ,Tọa độ X,Tọa độ Y .Nếu giữ như cũ thì cái Tên điểm điền thế nào???

Có theo số thứ Pick điểm hay bắt đầu từ số nào ?


  • 0

#5 Tr.CongSon

Tr.CongSon

    biết lệnh array

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

Đã gửi 28 August 2015 - 03:00 PM

Sửa cho bạn rồi đây :)

 

(prompt "\n[cmd : TTD] - THONG KE TOA DO")
(prompt "\nEdit : @ Tr\U+1EA7n C\U+00F4ng S\U+01A1n _ XDDD & CN\n")
;;;----------------------------------------------
(defun C:TTD (/ angd angr bit c caot1 d1 d2 di dt dx dy h i k kc l1 l11 l2 l22 lacol lc n om p1 p11 p2 p22 p3 p33 p4 pt pt3 pt4 pt5 ptb ptc ptd ptx pty rc stt tapx tapy tb tmp tstt tx ty x xx y yy)
(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 caot1 *h*)
)
(setq tapx '()
tapy '()
stt '()
)
(setvar "osmode" 125)
(setq lacol (getvar "CEColor")
i 1
)
(While
(setq D1 (getpoint (strcat "\nPick \U+0111i\U+1EC3m th\U+1EE9 " (rtos i 2 0) " :")))
(Progn
(setvar "osmode" 0)
(setq DX (getpoint (strcat "\n\U+0110i\U+1EC3m \U+0111\U+1EB7t Text c\U+1EE7a n\U+00FAt th\U+1EE9 " (rtos i 2 0) " :") D1)
DY (getpoint "\H\U+01B0\U+1EDBng g\U+00F3c nghi\U+00EAng c\U+1EE7a Text :" Dx)
angr (angle Dx Dy)
)
(setq angd (/ (* 180 angr) pi)
x (rtos (car D1) 2 0)
y (rtos (cadr D1) 2 0)
TX (strcat "X:" (rtos (Car D1) 2 0))
TY (strcat "Y:" (rtos (Cadr D1) 2 0))
tapx (append tapx (list x))
tapy (append tapy (list y))
stt (append stt (list i))
) ;setq
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (>= (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 caot1)))
(command "text" "BL" D2 caot1 angd tX)
(setq TB (textbox (entget (entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 angr (+ di (* 0.4 caot1)))
pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 caot1))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 caot1))
) ;setq
(command "text" "F" PT4 PT5 caot1 ty "pline" D1 DX PT3 "") ;command
(setvar "CECOLOR" lacol)
) ;progn
) ;if
(if (< (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 caot1)))
(command "text" "BR" D2 caot1 (+ 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 caot1)))
pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 caot1))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 caot1))
) ;setq
(command "text" "F" PT5 PT4 caot1 TY "pline" D1 DX PT3 "") ;command
(setvar "CECOLOR" lacol)
) ;progn
) ;if
) ;progn
(setq i (+ i 1))
)
(setvar "osmode" 125) ;if
(setq bit (cond (bit)
("Yes")
)
)
(initget "Yes No")
(setq Tmp (strcat "\nXuat b\U+1EA3ng th\U+1ED1ng k\U+00EA t\U+1ECDa \U+0111\U+1ED9 ? [Yes/No] <" bit ">: ")
bit (cond ((getkword Tmp))
(bit)
)
)
(if (eq bit "Yes")
(progn
(setq di (- di (* 0.4 caot1))
kc (* 2 di)
PT (getpoint "\nCh\U+1ECDn v\U+1ECB tr\U+00ED \U+0111\U+1EB7t b\U+1EA3ng :")
PTC (list (+ (* 2 kc) (- di caot1 caot1 caot1 caot1) (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT) (* 2 caot1)))
p2 (list (car PTC) (+ (cadr PTC) (* 2 caot1)))
p3 (list (car p1) (+ (cadr p1) (* 2 caot1)))
p4 (list (car p2) (+ (cadr p2) (* 2 caot1)))
PTD (list (+ (/ di 2) (car PT)) (+ caot1 (cadr PT)))
PTX (list (+ di (/ di 2) (- 0 caot1) (car PTD)) (cadr PTD))
PTY (list (+ kc (- caot1 caot1 caot1 caot1) (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ (* 1.1 caot1) (cadr p1)))
p22 (list (+ di (/ di 2) (- 0 caot1) (car p11)) (- (cadr p11) (* 0.1 caot1)))
p33 (list (+ kc (- caot1 caot1 caot1 caot1) (car p22)) (cadr p22))
L1 (list (+ di (car p3)) (cadr p3))
L2 (list (+ kc (- 0 caot1 caot1) (car L1)) (cadr L1))
PTB (list (+ (- (* 2 caot1)) (* 0.5 (+ (* 2 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 caot1)))
n (length tapx)
k 0
) ;setq
(setvar "osmode" 0)
(command "CECOLOR"
3
"line"
p1
p2
""
"line"
p3
p4
""
"CECOLOR"
2
"text"
"m"
p11
caot1
0
"STT"
"text"
"m"
p22
caot1
0
"Toa do X"
"text"
"m"
p33
caot1
0
"Toa do Y"
"text"
"m"
pTB
(* 1.3 caot1)
0
"Bang thong ke toa do diem"
)
(while (< k n)
(setq xx (nth k tapx)
yy (nth k tapy)
tstt (nth k stt)
)
(command "CECOLOR" 2 "text" "m" PTD caot1 0 tstt "text" "m"
PTX caot1 0 xx "text" "m" PTY caot1 0 yy "CECOLOR"
3 "line" PT PTC ""
)
(setq PT (list (car PT) (- (cadr PT) (* 2 caot1)))
PTC (list (+ (* 2 kc) (- di caot1 caot1 caot1 caot1) (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ caot1 (cadr PT)))
PTX (list (+ di (/ di 2) (- 0 caot1) (car PTD)) (cadr PTD))
PTY (list (+ kc (- caot1 caot1 caot1 caot1) (car PTX)) (cadr PTX))
k (+ 1 k)
) ;setq
) ;while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT) (* 2 caot1)))
PTC (list (+ (* 2 kc) (- di caot1 caot1 caot1 caot1) (car PT)) (cadr PT))
L11 (list (+ di (car PT)) (cadr PT))
L22 (list (+ kc (- 0 caot1 caot1) (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[TTD - THONG KE TOA DO]\n")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
) ;DONG toa do

 

Chào thân ái!


  • 1

#6 quachno1

quachno1

    biết pan

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

Đã gửi 28 August 2015 - 03:11 PM

Sửa cho bạn rồi đây :)

 

(prompt "\n[cmd : TTD] - THONG KE TOA DO")
(prompt "\nEdit : @ Tr\U+1EA7n C\U+00F4ng S\U+01A1n _ XDDD & CN\n")
;;;----------------------------------------------
(defun C:TTD (/ angd angr bit c caot1 d1 d2 di dt dx dy h i k kc l1 l11 l2 l22 lacol lc n om p1 p11 p2 p22 p3 p33 p4 pt pt3 pt4 pt5 ptb ptc ptd ptx pty rc stt tapx tapy tb tmp tstt tx ty x xx y yy)
(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 caot1 *h*)
)
(setq tapx '()
tapy '()
stt '()
)
(setvar "osmode" 125)
(setq lacol (getvar "CEColor")
i 1
)
(While
(setq D1 (getpoint (strcat "\nPick \U+0111i\U+1EC3m th\U+1EE9 " (rtos i 2 0) " :")))
(Progn
(setvar "osmode" 0)
(setq DX (getpoint (strcat "\n\U+0110i\U+1EC3m \U+0111\U+1EB7t Text c\U+1EE7a n\U+00FAt th\U+1EE9 " (rtos i 2 0) " :") D1)
DY (getpoint "\H\U+01B0\U+1EDBng g\U+00F3c nghi\U+00EAng c\U+1EE7a Text :" Dx)
angr (angle Dx Dy)
)
(setq angd (/ (* 180 angr) pi)
x (rtos (car D1) 2 0)
y (rtos (cadr D1) 2 0)
TX (strcat "X:" (rtos (Car D1) 2 0))
TY (strcat "Y:" (rtos (Cadr D1) 2 0))
tapx (append tapx (list x))
tapy (append tapy (list y))
stt (append stt (list i))
) ;setq
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (>= (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 caot1)))
(command "text" "BL" D2 caot1 angd tX)
(setq TB (textbox (entget (entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 angr (+ di (* 0.4 caot1)))
pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 caot1))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 caot1))
) ;setq
(command "text" "F" PT4 PT5 caot1 ty "pline" D1 DX PT3 "") ;command
(setvar "CECOLOR" lacol)
) ;progn
) ;if
(if (< (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 caot1)))
(command "text" "BR" D2 caot1 (+ 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 caot1)))
pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 caot1))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 caot1))
) ;setq
(command "text" "F" PT5 PT4 caot1 TY "pline" D1 DX PT3 "") ;command
(setvar "CECOLOR" lacol)
) ;progn
) ;if
) ;progn
(setq i (+ i 1))
)
(setvar "osmode" 125) ;if
(setq bit (cond (bit)
("Yes")
)
)
(initget "Yes No")
(setq Tmp (strcat "\nXuat b\U+1EA3ng th\U+1ED1ng k\U+00EA t\U+1ECDa \U+0111\U+1ED9 ? [Yes/No] <" bit ">: ")
bit (cond ((getkword Tmp))
(bit)
)
)
(if (eq bit "Yes")
(progn
(setq di (- di (* 0.4 caot1))
kc (* 2 di)
PT (getpoint "\nCh\U+1ECDn v\U+1ECB tr\U+00ED \U+0111\U+1EB7t b\U+1EA3ng :")
PTC (list (+ (* 2 kc) (- di caot1 caot1 caot1 caot1) (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT) (* 2 caot1)))
p2 (list (car PTC) (+ (cadr PTC) (* 2 caot1)))
p3 (list (car p1) (+ (cadr p1) (* 2 caot1)))
p4 (list (car p2) (+ (cadr p2) (* 2 caot1)))
PTD (list (+ (/ di 2) (car PT)) (+ caot1 (cadr PT)))
PTX (list (+ di (/ di 2) (- 0 caot1) (car PTD)) (cadr PTD))
PTY (list (+ kc (- caot1 caot1 caot1 caot1) (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ (* 1.1 caot1) (cadr p1)))
p22 (list (+ di (/ di 2) (- 0 caot1) (car p11)) (- (cadr p11) (* 0.1 caot1)))
p33 (list (+ kc (- caot1 caot1 caot1 caot1) (car p22)) (cadr p22))
L1 (list (+ di (car p3)) (cadr p3))
L2 (list (+ kc (- 0 caot1 caot1) (car L1)) (cadr L1))
PTB (list (+ (- (* 2 caot1)) (* 0.5 (+ (* 2 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 caot1)))
n (length tapx)
k 0
) ;setq
(setvar "osmode" 0)
(command "CECOLOR"
3
"line"
p1
p2
""
"line"
p3
p4
""
"CECOLOR"
2
"text"
"m"
p11
caot1
0
"STT"
"text"
"m"
p22
caot1
0
"Toa do X"
"text"
"m"
p33
caot1
0
"Toa do Y"
"text"
"m"
pTB
(* 1.3 caot1)
0
"Bang thong ke toa do diem"
)
(while (< k n)
(setq xx (nth k tapx)
yy (nth k tapy)
tstt (nth k stt)
)
(command "CECOLOR" 2 "text" "m" PTD caot1 0 tstt "text" "m"
PTX caot1 0 xx "text" "m" PTY caot1 0 yy "CECOLOR"
3 "line" PT PTC ""
)
(setq PT (list (car PT) (- (cadr PT) (* 2 caot1)))
PTC (list (+ (* 2 kc) (- di caot1 caot1 caot1 caot1) (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ caot1 (cadr PT)))
PTX (list (+ di (/ di 2) (- 0 caot1) (car PTD)) (cadr PTD))
PTY (list (+ kc (- caot1 caot1 caot1 caot1) (car PTX)) (cadr PTX))
k (+ 1 k)
) ;setq
) ;while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT) (* 2 caot1)))
PTC (list (+ (* 2 kc) (- di caot1 caot1 caot1 caot1) (car PT)) (cadr PT))
L11 (list (+ di (car PT)) (cadr PT))
L22 (list (+ kc (- 0 caot1 caot1) (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[TTD - THONG KE TOA DO]\n")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
) ;DONG toa do

 

Chào thân ái!

Cám ơn bạn nhiều, chuẩn không cần chỉnh roài ^^


  • 0

#7 quachno1

quachno1

    biết pan

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

Đã gửi 29 August 2015 - 01:45 PM

alô Cong Son ơi, check lại cho mình cái. Chỉ được điểm đầu tiên thôi, sang điểm thứ 2 lại phải đặt lại chế độ bắt điểm, tự nó xóa hết chế độ bắt điểm rồi. Thanks


  • -1

#8 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 993 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 29 August 2015 - 07:46 PM

Như này bạn thích ko?


  • 2



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#9 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 993 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 29 August 2015 - 07:53 PM

Kết hợp với lisp này sẽ ổn nếu muốn lấy tọa độ ra


  • 1



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#10 quachno1

quachno1

    biết pan

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

Đã gửi 31 August 2015 - 08:51 AM

Như này bạn thích ko?

Thanks đã chia sẻ, nhưng mình chỉ cần tới hàng như Truong Son đã giúp thôi, giờ chỉ cần sửa lại sau khi pick điểm thứ nhất nó giữ lại cho mình chế độ bắt điểm thôi là oke


  • 0

#11 Tr.CongSon

Tr.CongSon

    biết lệnh array

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

Đã gửi 03 September 2015 - 10:48 AM

alô Cong Son ơi, check lại cho mình cái. Chỉ được điểm đầu tiên thôi, sang điểm thứ 2 lại phải đặt lại chế độ bắt điểm, tự nó xóa hết chế độ bắt điểm rồi. Thanks

 

Mấy hôm ni nghỉ lễ nên giờ mới đọc cmt của bạn ^^

Chỉnh cái bắt điểm này thì trên diễn đàn có vô số người chỉnh được,nhưng do bạn nêu "đích danh" mình nên không ai giúp bạn đó :)

Sửa cho bạn rồi đây ^^

 

(prompt "\n[cmd : TTD] - THONG KE TOA DO")
(prompt "\nEdit : @ Tr\U+1EA7n C\U+00F4ng S\U+01A1n _ XDDD & CN\n")
;;;----------------------------------------------
(defun C:TTD (/ angd angr bit c caot1 d1 d2 di dt dx dy h i k kc l1 l11 l2 l22 lacol lc n om p1 p11 p2 p22 p3 p33 p4 pt pt3 pt4 pt5 ptb ptc ptd ptx pty rc stt tapx tapy tb tmp tstt tx ty x xx y yy)
(setvar "cmdecho" 0)
(command "Undo" "Begin")
(setq osm (getvar "osmode"))
(if (not *h*)
(setq *h* 1)
)
(setq caot1 (getreal (strcat "\nCao text < " (rtos *h* 2 2) " >:")))
(if caot1
(setq *h* caot1)
(setq caot1 *h*)
)
(setq tapx '()
tapy '()
stt '()
)
(setvar "osmode" 125)
(setq lacol (getvar "CEColor")
i 1
)
(While
(setq D1 (getpoint (strcat "\nPick \U+0111i\U+1EC3m th\U+1EE9 " (rtos i 2 0) " :")))
(Progn
(setq DX (getpoint (strcat "\n\U+0110i\U+1EC3m \U+0111\U+1EB7t Text c\U+1EE7a n\U+00FAt th\U+1EE9 " (rtos i 2 0) " :") D1)
DY (getpoint "\H\U+01B0\U+1EDBng g\U+00F3c nghi\U+00EAng c\U+1EE7a Text :" Dx)
angr (angle Dx Dy)
)
(setq angd (/ (* 180 angr) pi)
x (rtos (car D1) 2 0)
y (rtos (cadr D1) 2 0)
TX (strcat "X:" (rtos (Car D1) 2 0))
TY (strcat "Y:" (rtos (Cadr D1) 2 0))
tapx (append tapx (list x))
tapy (append tapy (list y))
stt (append stt (list i))
)
(setvar "osmode" 0)
(if (>= (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 caot1)))
(command "text" "BL" D2 caot1 angd tX)
(setq TB (textbox (entget (entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 angr (+ di (* 0.4 caot1)))
pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 caot1))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 caot1))
) ;setq
(command "text" "F" PT4 PT5 caot1 ty "pline" D1 DX PT3 "") ;command
(setvar "CECOLOR" lacol)
) ;progn
) ;if
(if (< (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 caot1)))
(command "text" "BR" D2 caot1 (+ 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 caot1)))
pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 caot1))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 caot1))
) ;setq
(command "text" "F" PT5 PT4 caot1 TY "pline" D1 DX PT3 "") ;command
(setvar "CECOLOR" lacol)
) ;progn
)
(setvar "osmode" 125);if
) ;progn
(setq i (+ i 1))
) ;if
(setq bit (cond (bit)
("Yes")
)
)
(initget "Yes No")
(setq Tmp (strcat "\nXuat b\U+1EA3ng th\U+1ED1ng k\U+00EA t\U+1ECDa \U+0111\U+1ED9 ? [Yes/No] <" bit ">: ")
bit (cond ((getkword Tmp))
(bit)
)
)
(if (eq bit "Yes")
(progn
(setq di (- di (* 0.4 caot1))
kc (* 2 di)
PT (getpoint "\nCh\U+1ECDn v\U+1ECB tr\U+00ED \U+0111\U+1EB7t b\U+1EA3ng :")
PTC (list (+ (* 2 kc) (- di caot1 caot1 caot1 caot1) (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT) (* 2 caot1)))
p2 (list (car PTC) (+ (cadr PTC) (* 2 caot1)))
p3 (list (car p1) (+ (cadr p1) (* 2 caot1)))
p4 (list (car p2) (+ (cadr p2) (* 2 caot1)))
PTD (list (+ (/ di 2) (car PT)) (+ caot1 (cadr PT)))
PTX (list (+ di (/ di 2) (- 0 caot1) (car PTD)) (cadr PTD))
PTY (list (+ kc (- caot1 caot1 caot1 caot1) (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ (* 1.1 caot1) (cadr p1)))
p22 (list (+ di (/ di 2) (- 0 caot1) (car p11)) (- (cadr p11) (* 0.1 caot1)))
p33 (list (+ kc (- caot1 caot1 caot1 caot1) (car p22)) (cadr p22))
L1 (list (+ di (car p3)) (cadr p3))
L2 (list (+ kc (- 0 caot1 caot1) (car L1)) (cadr L1))
PTB (list (+ (- (* 2 caot1)) (* 0.5 (+ (* 2 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 caot1)))
n (length tapx)
k 0
) ;setq
(setvar "osmode" 0)
(command "CECOLOR"
3
"line"
p1
p2
""
"line"
p3
p4
""
"CECOLOR"
2
"text"
"m"
p11
caot1
0
"STT"
"text"
"m"
p22
caot1
0
"Toa do X"
"text"
"m"
p33
caot1
0
"Toa do Y"
"text"
"m"
pTB
(* 1.3 caot1)
0
"Bang thong ke toa do diem"
)
(while (< k n)
(setq xx (nth k tapx)
yy (nth k tapy)
tstt (nth k stt)
)
(command "CECOLOR" 2 "text" "m" PTD caot1 0 tstt "text" "m"
PTX caot1 0 xx "text" "m" PTY caot1 0 yy "CECOLOR"
3 "line" PT PTC ""
)
(setq PT (list (car PT) (- (cadr PT) (* 2 caot1)))
PTC (list (+ (* 2 kc) (- di caot1 caot1 caot1 caot1) (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ caot1 (cadr PT)))
PTX (list (+ di (/ di 2) (- 0 caot1) (car PTD)) (cadr PTD))
PTY (list (+ kc (- caot1 caot1 caot1 caot1) (car PTX)) (cadr PTX))
k (+ 1 k)
) ;setq
) ;while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT) (* 2 caot1)))
PTC (list (+ (* 2 kc) (- di caot1 caot1 caot1 caot1) (car PT)) (cadr PT))
L11 (list (+ di (car PT)) (cadr PT))
L22 (list (+ kc (- 0 caot1 caot1) (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[TTD - THONG KE TOA DO]\n")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
) ;DONG toa do

 

Thanks đã chia sẻ, nhưng mình chỉ cần tới hàng như Truong Son đã giúp thôi, giờ chỉ cần sửa lại sau khi pick điểm thứ nhất nó giữ lại cho mình chế độ bắt điểm thôi là oke

 

Màu đỏ: Mình là Trần Công Sơn chứ không phải Trường Sơn nha bạn .hi

Chúc bạn vui !


  • 1

#12 quachno1

quachno1

    biết pan

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

Đã gửi 04 September 2015 - 09:28 AM

:lol:  thanks Công Sơn nhé!

Sr vụ nhầm tên hehee
Ai biết đâu, mình tham diễn đàn cũng lâu lâu rồi, nhưng trình kém chỉ le ve xin hàng thôi chứ không giúp gì được anh em mấy.

Cảm ơn Sơn và anh em đã giúp đỡ.


  • 0