Đến nội dung


Hình ảnh
- - - - -

[Nhờ chỉnh sửa] Nhờ các cao thủ sửa hộ lisp thống kê tọa độ theo ý muốn


  • Please log in to reply
12 replies to this topic

#1 akay_arch

akay_arch

    biết zoom

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

Đã gửi 14 June 2012 - 09:31 AM

Cái lisp thống kê tọa độ của bạn ThaiStreetz viết rất tốt cho công việc của mình link nó đây ạ: http://www.cadviet.c...pic=12702&st=0. Nhưng có điều là khi xuất tọa độ trên Cad và ghi ra bản vẽ thì phải đổi vị trí tọa độ X và Y cho nhau - đấy là điều mình muốn nhờ tác giả hoặc bạn nào rành về lisp sửa hộ. Vì topic trên lâu quá rồi nên mình không yêu cầu ở đấy nữa. Mạo muội tạo topic mới. Xin phép mod cho xin 1 thời gian ngắn. hoặc ai biết lisp nào đã sửa theo đúng ý mình làm ơn chỉ dùm đường link. thank all
  • 0

#2 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 14 June 2012 - 10:15 AM

Việc sửa thì chắc không khó, nhưng bạn đang làm khó cho người sửa:
1). Lisp nằm ở đâu thì hỏi ngay ở đó, chứ đừng mở topic khác => nhạt forum.
2). Tôi đọc link bạn chỉ thì trong link đó có rất nhiều lisp sửa đi sửa lại, không thể biết cái nào bạn nhờ.
=> qua lại topic đó hỏi, chỉ ngay bài đó (ví dụ ở #3 chẳng bạn).
  • 1

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

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


#3 cd2k44

cd2k44

    Edu level: li5

  • Members
  • PipPipPipPipPipPipPip
  • 648 Bài viết
Điểm đánh giá: 121 (tàm tạm)

Đã gửi 14 June 2012 - 10:18 AM

Bạn đổi 2 dòng sau

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))
Thành

y (rtos (car D1) 2 4)
x (rtos (cadr D1) 2 4)
TY (strcat "X="(rtos (Car D1) 2 4))
TX (strcat "Y="(rtos (Cadr D1) 2 4))

  • 1

#4 akay_arch

akay_arch

    biết zoom

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

Đã gửi 14 June 2012 - 10:38 AM

@Doan Van Ha: lý do mở topic mới mình đã nêu rồi. lần sâu mình sẽ rút kinh nghiệm. :))
@CD2k44: Cám ơn bạn nhiều. Bạn học cầu đường K44 ĐHXD à. mình 44KD4 của ĐHXD đây. Mỗi tội gà về lisp lắm.
  • 0

#5 akay_arch

akay_arch

    biết zoom

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

Đã gửi 14 June 2012 - 10:52 AM

@CD2K44: Bạn hình như vẫn chưa hiểu ý mình, ý mình ví dụ là: một điểm trong file cad của mình có tọa độ khi list kiểm tra là "X=582027.2825 Y=2187655.3823" nhưng mình muốn ghi ra trên bản vẽ là "X=2187655.3823 Y=582027.2825". Bạn xem giúp mình được không.
@ Doan Van Ha: Code của lisp gốc là:
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12702
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:tdn ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tapx '() tapy '() stt '() k 0
ten (getstring "\nNhap ten nut:"))
(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >:")))
(if caot1 (setq h caot1))
(setvar "osmode" 125)
(setq lacol (getvar "CEColor"))
;================================================
(While
(setq D1 (getpoint "\nPick diem toa do:"))
(Progn
(setvar "osmode" 0)
(setq DX (getpoint "\nDiem dat text:" 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.4 h)))
pt5 (list (+ (car D2) di) (- (cadr D2) (* 1.4 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.4 h)))
pt5 (list (car D2) (- (cadr D2) (* 1.4 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
;=============================================
;tao bang thong ke
(setq di (- di (* 2 h))
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))
PTB (list (+ (* 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 "STT"
"text" "m" p22 h 0 "T&#228;a &#174;&#233; X"
"text" "m" p33 h 0 "T&#228;a &#174;&#233; Y"
"text" "m" pTB (* 1.3 h) 0 "%&#11;&#182;ng th&#232;ng k&#170; t&#228;a &#174;&#233; n&#243;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 (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 "CECOLOR" 3
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado
Bạn xem giúp mình với. Cám ơn nhiều.
  • 0

#6 cd2k44

cd2k44

    Edu level: li5

  • Members
  • PipPipPipPipPipPipPip
  • 648 Bài viết
Điểm đánh giá: 121 (tàm tạm)

Đã gửi 14 June 2012 - 11:10 AM

@CD2K44: Bạn hình như vẫn chưa hiểu ý mình, ý mình ví dụ là: một điểm trong file cad của mình có tọa độ khi list kiểm tra là "X=582027.2825 Y=2187655.3823" nhưng mình muốn ghi ra trên bản vẽ là "X=2187655.3823 Y=582027.2825". Bạn xem giúp mình được không.
@ Doan Van Ha: Code của lisp gốc là:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12702
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:tdn ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(setq tapx '() tapy '() stt '() k 0
ten (getstring "\nNhap ten nut:"))
(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >:")))
(if caot1 (setq h caot1))
(setvar "osmode" 125)
(setq lacol (getvar "CEColor"))
;================================================
(While
(setq D1 (getpoint "\nPick diem toa do:"))
(Progn
(setvar "osmode" 0)
(setq DX (getpoint "\nDiem dat text:" 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.4 h)))
pt5 (list (+ (car D2) di) (- (cadr D2) (* 1.4 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.4 h)))
pt5 (list (car D2) (- (cadr D2) (* 1.4 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
;=============================================
;tao bang thong ke
(setq di (- di (* 2 h))
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))
PTB (list (+ (* 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 "STT"
"text" "m" p22 h 0 "T&#228;a &#174;&#233; X"
"text" "m" p33 h 0 "T&#228;a &#174;&#233; Y"
"text" "m" pTB (* 1.3 h) 0 "%&#11;&#182;ng th&#232;ng k&#170; t&#228;a &#174;&#233; n&#243;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 (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 "CECOLOR" 3
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado
Bạn xem giúp mình với. Cám ơn nhiều.

đoạn code lấy tọa độ điểm của bạn chính là đoạn mình ghi ở trên.Theo lisp của bác Thai thì nó lấy x, y như vậy, khi bạn đổi vị trí này thì kết quả sẽ như bạn muốn
  • 1

#7 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 14 June 2012 - 11:15 AM

Sửa 4 dòng này:
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))
Thành 4 dòng này:
x (rtos (cadr D1) 2 4)
y (rtos (car D1) 2 4)
TX (strcat "X="(rtos (Cadr D1) 2 4))
TY (strcat "Y="(rtos (Car D1) 2 4))
  • 1

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

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


#8 akay_arch

akay_arch

    biết zoom

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

Đã gửi 14 June 2012 - 11:17 AM

@ CD2K44:
Mình thử rồi nhưng chỉ là thay đổi vị trí đặt hiển thị giữa Y=2187655.3823/X=582027.2825 so với cái code gốc là X=582027.2825/Y=2187655.3823. cái mình muốn là X=2187655.3823/Y=582027.2825
  • 0

#9 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 14 June 2012 - 11:20 AM

Đã thử tôi sửa ở trên chưa?
  • 1

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

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


#10 akay_arch

akay_arch

    biết zoom

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

Đã gửi 14 June 2012 - 11:23 AM

Ok rồi. Cám ơn bạn rất nhiều. Chúc bữa trưa ngon miệng. Giờ có thể đóng topic rồi :)
  • 0

#11 quanghuyvblc

quanghuyvblc

    Chưa sử dụng CAD

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

Đã gửi 27 June 2013 - 10:32 AM

các sư phụ ơi cho em hỏi tí. Sao em làm nó toàn ra cái hình thế này là bị làm sao vậy. giúp em với.....!


  • 0

#12 quanghuyvblc

quanghuyvblc

    Chưa sử dụng CAD

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

Đã gửi 27 June 2013 - 10:33 AM

http://www.cadviet.c.../120581_123.dwg

 

đó hình ví dụ thôi nhé


  • 0

#13 naunong

naunong

    Chưa sử dụng CAD

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

Đã gửi 29 July 2016 - 04:18 PM

Xin chào các bạn!

mình mới nhận được lips tọa độ này. Khi dùng nếu không đổi trục tọa độ thì bình thường nhưng nếu đổi trục theo lệnh UCS thì vòng tròn ở một nơi, tên điểm ở một nơi. Xin nhờ các Pro giúp với:

 

GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun textM (pt height string / lst)
(setq lst (list '(0 . "TEXT") (cons 10 pt) (cons 40 height) (cons 1 string) (cons 50 0) (cons 72 4) (cons 11 pt) (cons 7 (getvar "Textstyle"))))
(entmakeX Lst)  )
(defun C:td (/ diem PT1 PT2 tapx tapy obj ss
           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:"))
    (setq   PT1 (getpoint diem "Nhap diem thu 2")
         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
(if (> (distance diem PT1) (* 1.8 h)) (setq PT2 (polar diem (angle diem PT1) (- (distance diem PT1) (* 1.8 h)))) (setq PT2 NIL))
  (setvar "osmode" 0)
(setq obj (textM pt1 h x)) (setq ss (entlast))
;(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget ss))
LC (car TB) RC (cadr TB) di (distance LC RC) C PT1);setq
(command "erase" ss "" "pline" diem pt2 ""
         "circle" C (* 1.8 h))
         (textM C h N)
    (setvar "osmode" om)    );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


  • 0