Đến nội dung


Hình ảnh
- - - - -

[Nhờ chỉnh sửa]Lisp thống kê tọa độ TDN.lisp


  • Please log in to reply
6 replies to this topic

#1 toai

toai

    biết vẽ ellipse

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

Đã gửi 05 July 2012 - 01:22 PM

Nhờ mọi người sửa giúp lisp này sao cho đường kính hình tròn bao xung quanh số thứ tự điểm tăng tương ứng khi chiều dài của số thứ tự tăng đồng thời khống chế sao cho ký hiệu STT điểm không chồng lên ký hiệu tọa độ.
http://www.cadviet.c...o_diemtdn_1.lsp

Đây là hình minh họa:
Hình đã gửi

(Lisp mình sưu tầm trên Cadviet)
  • 0
Mưu sự tại nhân, thành sự tại thiên.

#2 mathan

mathan

    biết vẽ rectang

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

Đã gửi 05 July 2012 - 03:31 PM

Bạn dùng thử xem sao

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12702
(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
(setq dt (* 0.5 (- (strlen N) 2) h));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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 ) dt)) (+ (* 1.5 h) dt)
"text" "m" (polar PT3 angr (+ (* 1.5 h) dt )) h angd N
"CECOLOR" 8
"circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt)
);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) dt)) (+ (* 1.5 h) dt)
"text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h (+ angd 180) N
"CECOLOR" 8
"circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt)
);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" 0)
(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
(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
(setq dt (* 0.5 (- (strlen N) 2) h));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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) dt)) (+ (* 1.5 h) dt)
"text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h angd N
"CECOLOR" 8
"circle" (polar PT3 angr (+(* 1.5 h) dt)) (+ (* 1.35 h) dt)
);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) dt)) (+ (* 1.5 h) dt)
"text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h (+ angd 180) N
"CECOLOR" 8
"circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt)
);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 "\nXuat bang toa do? [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 "Ten diem"
"text" "m" p22 h 0 "Toa do X"
"text" "m" p33 h 0 "Toa do Y"
"text" "m" pTB (* 1.3 h) 0 "%&#186;ng 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 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
Trong đó có dòng (setq dt (* 0.5 (- (strlen N) 2) h)) để điểu chỉnh độ to của vòng tròn theo chiều dài tên Nút
Nếu muốn bạn có thể sửa lại.
Bạn dùng thử và phản hồi lại nhé!!
  • 2
-----------
Hình đã gửi Hãy chia sẻ để thấy có được nhiều hơn điều mình muốn!
Best regard,

#3 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 05 July 2012 - 03:45 PM

Trong đó có dòng (setq dt (* 0.5 (- (strlen N) 2) h)) để điểu chỉnh độ to của vòng tròn theo chiều dài tên Nút
Nếu muốn bạn có thể sửa lại.
Bạn dùng thử và phản hồi lại nhé!!

Dùng (setq dt (* 0.5 (- (strlen N) 2) h)) không ổn lắm. Nên lấy textbox của string.
  • 0

* 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.


#4 toai

toai

    biết vẽ ellipse

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

Đã gửi 07 July 2012 - 10:44 AM

Thank bạn mathan. Với mình, như vậy là đúng yêu cầu rồi.
P/s: (Doan van Ha) Nếu có ý kiến chỉnh sửa cho ứng dụng trên "mượt mà" hơn, nhờ các bạn bổ sung giúp nhé.
Trân trọng!
  • 0
Mưu sự tại nhân, thành sự tại thiên.

#5 longbyoongho

longbyoongho

    biết vẽ pline

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

Đã gửi 13 July 2012 - 04:36 PM

Bạn dùng thử xem sao

 ;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12702 (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 (setq dt (* 0.5 (- (strlen N) 2) h));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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 ) dt)) (+ (* 1.5 h) dt) "text" "m" (polar PT3 angr (+ (* 1.5 h) dt )) h angd N "CECOLOR" 8 "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt) );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) dt)) (+ (* 1.5 h) dt) "text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h (+ angd 180) N "CECOLOR" 8 "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt) );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" 0) (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 (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 (setq dt (* 0.5 (- (strlen N) 2) h));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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) dt)) (+ (* 1.5 h) dt) "text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h angd N "CECOLOR" 8 "circle" (polar PT3 angr (+(* 1.5 h) dt)) (+ (* 1.35 h) dt) );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) dt)) (+ (* 1.5 h) dt) "text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h (+ angd 180) N "CECOLOR" 8 "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt) );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 "\nXuat bang toa do? [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 "Ten diem" "text" "m" p22 h 0 "Toa do X" "text" "m" p33 h 0 "Toa do Y" "text" "m" pTB (* 1.3 h) 0 "%&#186;ng 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 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 
Trong đó có dòng (setq dt (* 0.5 (- (strlen N) 2) h)) để điểu chỉnh độ to của vòng tròn theo chiều dài tên Nút Nếu muốn bạn có thể sửa lại. Bạn dùng thử và phản hồi lại nhé!!


Bạn có thể thêm dòng chọn "chọn số chữ số thập phân" được không vì đôi khi có những bản vẽ chỉ cần chính xác đến 3 chữ số đằng sau dấu "," thôi. Thanks :D
  • 0
Đã 18 mùa cây lúa trổ bông,
Chưa 1 lần sờ mông con gái
Cũng từng ấy mùa khoai sọ,
Chưa 1 lần này nọ với ai.

#6 mathan

mathan

    biết vẽ rectang

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

Đã gửi 13 July 2012 - 05:03 PM


Bạn có thể thêm dòng chọn "chọn số chữ số thập phân" được không vì đôi khi có những bản vẽ chỉ cần chính xác đến 3 chữ số đằng sau dấu "," thôi. Thanks :D

Cũng dễ thôi bạn ah, mình sẽ chỉ để bạn tự chỉnh vào code đó nhé
Bạn tìm tới dòng

(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 2) " >:")))
(if caot1 (setq h caot1))
copy nó và sửa lại thành

(if (not TP) (setq TP 4))
(setq TP1 (getint (strcat "\nSo chu so thap phan < " (itoa TP) " >:")))
(if TP1 (setq TP TP1))
Sau đó bạn tìm đến như thằng có dạng như (chỉ quan tâm mấy chữ in đậm nhé :D) (rtos (car D1) 2 4) bạn chuyển thành (rtos (car D1) 2 TP)
Bạn hãy tự sửa lại và tận hưởng một cảm giác "LISPer chế" nhé :D
  • 0
-----------
Hình đã gửi Hãy chia sẻ để thấy có được nhiều hơn điều mình muốn!
Best regard,

#7 bach186

bach186

    Chưa sử dụng CAD

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

Đã gửi 21 January 2013 - 02:49 PM

em muốn bỏ đi phần chọn độ nghiên của text 1 thì phải làm thế nào hả bác
  • 0