Lisp Ghi Chú Tọa Độ Từng Điểm Khi Pick

Tháng 11 23, 2015

Pro nào có lisp pick tọa độ như hình cho emm xin với.

Tháng 11 23, 2015

Pro nào có lisp pick tọa độ như hình cho emm xin với.

Bạn dùng tạm cái này xem sao^^

Cái này,lúc trước mình sửa lại cho 1 bạn trên cadviet ^^

Lisp này không phải chính chủ nhé!

(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

Chúc thành công !

Tháng 11 24, 2015

Bạn chỉnh dùm mình

1. Lisp này toạ độ x, y bị đảo lôn ,không giống của mình

2. Không có số thập phân phía sau

3. Bạn thêm vòng tròn cho mình luôn với

Tháng 11 24, 2015

Không ai có lisp giống như hình ha, bạn nào có cho mình với.thanks

Tháng 11 24, 2015

Bạn vẽ nét tròn, nét chéo, nét thẳng và text thành 1 cái block đi, mình sẽ giúp bạn phần còn lại!

Tháng 11 25, 2015

Phải tạo block ha anh, lisp trên không sữa đuợc ha

Tháng 11 25, 2015

Tôi bổ sung thêm dòng này vào code của a Tr.CongSon theo yêu cầu của bạn.

(command "circle" D1 (* 0.2 caot1) "")

http://www.cadviet.com/upfiles/5/139246_ttd.lsp

Tháng 11 25, 2015

Tôi bổ sung thêm dòng này vào code của a Tr.CongSon theo yêu cầu của bạn.
(command "circle" D1 (* 0.2 caot1) "")
http://www.cadviet.com/upfiles/5/139246_ttd.lsp

đã loád lisp nhưng bị lỗi như sau: Anh cho em hỏi làm sao để đưa lisp lên diễn đàn có nút download như mọi người

:[cmd : TTD] - THONG KE TOA DO

Edit : @ Trần Công Sơn _ XDDD & CN

; error: malformed list on input

Command:

Tháng 11 25, 2015


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/155015-lisp-ghi-cha-ta-a-a-ta-ng-ia-m-khi-pick/
(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) " :")))

(command "circle" D1 (* 0.2 caot1) "")

(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

Tháng 11 25, 2015

Bạn chọn vào Biểu tượng thứ 3 (Special BBCode) , Chọn Lisp và dán code vào trong khung bên dưới (như hình)

Tháng 11 25, 2015

em có lisp này của anh duy cung khá hay, mà lại thao tác it hơn, anh chỉnh lại dùm em vơi. cho y nằm dưới đường line và thêm cái vong tron cho em với, cái lisp anh cho phía sau không co số thập phân.

(Defun c:xtd ( )
(setq lc (strcase (getstring "\nBan co muon chon diem toa do gia dinh khong: Co/Khong: ")))

(if (= lc "C")
(progn
(setq a (getpoint "\nChon diem gia dinh: "))
(setq ax (dnint "\nToa do X gia dinh "ax1))
(setq ax1 ax)
(setq ay (dnint "\nToa do Y gia dinh "ay1))
(setq ay1 ay)

(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(command "-style" "thep" "VNI-HELVE" "0" "1" "0" "n" "n")
(if (null met)(setq met 1))
(Setq temp T)
(While temp
(setq b (strcat "\nTi le /: "))
(Initget "t T")
(setq str (getpoint b))
(Cond
((= str "t") (setq met (dnint "\nMot met ban ve la bao nhieu "momet)))
((= str "T") (setq met (dnint "\nMot met ban ve la bao nhieu "momet)))
(Progn
(Setq b str)
(setq momet met)
(setq temp nil)
)
)
)
(setq c (getpoint b"\nChon diem viet ket qua: "))
(setq luubatdiem (getvar "osmode")) (setq luulop (getvar "clayer"))
(setvar "osmode" 0)
(setq x (/ (car b) met))
(setq y (/ (cadr b) met))

(setq xg (/ (car a) met))
(setq yg (/ (cadr a) met))
(setq kx (- x xg))
(setq ky (- y yg))
(setq xm (+ kx ax))
(setq ym (+ ky ay))

(setq toadox (rtos xm 2 3))
(setq toadoy (rtos ym 2 3))
(setq noidungviet (strcat toadox "\\P" toadoy))
(command ".LEADER" b c "" noidungviet "")


(setvar "osmode" luubatdiem) (setvar "clayer" luulop)
(setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**")
(while
(setq b (getpoint "\nChon diem muon xem toa do : "))

(setq c (getpoint b"\nChon diem viet ket qua: "))
(setq luubatdiem (getvar "osmode")) (setq luulop (getvar "clayer"))
(setvar "osmode" 0)
(setq x (/ (car b) met))
(setq y (/ (cadr b) met))
(setq xg (/ (car a) met))
(setq yg (/ (cadr a) met))
(setq kx (- x xg))
(setq ky (- y yg))
(setq xm (+ kx ax))
(setq ym (+ ky ay))

(setq toadox (rtos xm 2 3))
(setq toadoy (rtos ym 2 3))
(setq noidungviet (strcat toadox "\\P" toadoy))
(command ".LEADER" b c "" noidungviet "")


(setvar "osmode" luubatdiem) (setvar "clayer" luulop)


)


)
)


(if (= lc "K")
(progn
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(command "-style" "thep" "VNI-HELVE" "0" "1" "0" "n" "n")
(if (null met)(setq met 1))
(Setq temp T)
(While temp
(setq b (strcat "\nTi le /: "))
(Initget "t T")
(setq str (getpoint b))
(Cond
((= str "t") (setq met (dnint "\nMot met ban ve la bao nhieu "momet)))
((= str "T") (setq met (dnint "\nMot met ban ve la bao nhieu "momet)))
(Progn
(Setq b str)
(setq momet met)
(setq temp nil)
)
)
)
(setq c (getpoint b"\nChon diem viet ket qua: "))
(setq luubatdiem (getvar "osmode")) (setq luulop (getvar "clayer"))
(setvar "osmode" 0)
(setq x (/ (car b) met))
(setq y (/ (cadr b) met))

(setq toadox (rtos x 2 3))
(setq toadoy (rtos y 2 3))
(setq noidungviet (strcat toadox "\\P" toadoy))
(command ".LEADER" b c "" noidungviet "")

(setvar "osmode" luubatdiem) (setvar "clayer" luulop)


(setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**")
(while
(setq b (getpoint "\nChon diem muon xem toa do : "))
(setq x (/ (car b) met))
(setq y (/ (cadr b) met))
(setq c (getpoint b"\nChon diem viet ket qua: "))
(setq luubatdiem (getvar "osmode")) (setq luulop (getvar "clayer"))
(setvar "osmode" 0)
(setq toadox (rtos x 2 3))
(setq toadoy (rtos y 2 3))
(setq noidungviet (strcat toadox "\\P" toadoy))
(command ".LEADER" b c "" noidungviet "")

(setvar "osmode" luubatdiem) (setvar "clayer" luulop)


)


)
)





(setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**")
(Princ)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(Defun c:lkd ( )
(setq lc (strcase (getstring "\nBan co muon chon diem toa do gia dinh khong: Co/Khong: ")))

(if (= lc "C")
(progn
(setq a (getpoint "\nChon diem gia dinh: "))
(setq ax (dnint "\nToa do X gia dinh "ax1))
(setq ax1 ax)
(setq ay (dnint "\nToa do Y gia dinh "ay1))
(setq ay1 ay)

(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(command "-style" "thep" "VNI-HELVE" "0" "1" "0" "n" "n")
(if (null met)(setq met 1))
(Setq temp T)
(While temp
(setq b (strcat "\nTi le /: "))
(Initget "t T")
(setq str (getpoint b))
(Cond
((= str "t") (setq met (dnint "\nMot met ban ve la bao nhieu "momet)))
((= str "T") (setq met (dnint "\nMot met ban ve la bao nhieu "momet)))
(Progn
(Setq b str)
(setq momet met)
(setq temp nil)
)
)
)
(setq luubatdiem (getvar "osmode")) (setq luulop (getvar "clayer"))
(setvar "osmode" 0)
(setq x (/ (car b) met))
(setq y (/ (cadr b) met))

(setq xg (/ (car a) met))
(setq yg (/ (cadr a) met))
(setq kx (- x xg))
(setq ky (- y yg))
(setq xm (+ kx ax))
(setq ym (+ ky ay))


(command "INSERT" (strcat odiachay "\\tienich\\dwg\\nhap") (list (car b)(cadr b)) 1 1 0)
(setq xht (getreal "\nSo thu tu cua nut : "))
(setq xh (- xht 1))
(setq nx (* 8 xh))
(setq sb (/ xh 10))
(setq sbn (* 100 (fix sb)))
(setq snl (- xh (fix sb)))
(setq nl (- nx (* 80 (fix sb))))

(setq CHIAM (/ XHT 10))
(setq LAMCHAN (fix CHIAM))
(setq NHANM (* LAMCHAN 10))
(setq tenkc (- XHT NHANM))
(setq tenkcn (* TENKC 100))
(setq TENKCM (fix TENKCN))

(Cond
((= TENKCM 100) (command "INSERT" (strcat odiachay "\\tienich\\dwg\\tdbdiem") (list (- sbn 14) (- 6 nl)) 1 1 0)
)
((/= TENKCM 100)
)
)

(command "TEXT" (list (+ 0 sbn) (- 0 nl)) 4 0 (rtos xm 2 4))
(command "TEXT" (list (+ 42 sbn) (- 0 nl)) 4 0 (rtos ym 2 4))
(command "TEXT" (list (- sbn 10) (- 0 nl)) 4 0 (fix xht))
(command "LINE" (list (- sbn 14) (- (- 6 nl) 8))(list (+ sbn 80) (- (- 6 nl) 8)) "")
(command "LINE" (list (- sbn 14) (- 6 nl))(list (- sbn 14)(- (- 6 nl) 8)) "")
(command "LINE" (list (+ (- sbn 14) 12) (- 6 nl))(list (+ (- sbn 14) 12)(- (- 6 nl) 8)) "")
(command "LINE" (list (+ (- sbn 14) 53) (- 6 nl))(list (+ (- sbn 14) 53)(- (- 6 nl) 8)) "")
(command "LINE" (list (+ (- sbn 14) 94) (- 6 nl))(list (+ (- sbn 14) 94)(- (- 6 nl) 8)) "")
(setvar "osmode" luubatdiem) (setvar "clayer" luulop)


(setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**")
(while
(setq b (getpoint "\nChon diem muon xem toa do : "))

(setq x (/ (car b) met))
(setq y (/ (cadr b) met))
(setq xg (/ (car a) met))
(setq yg (/ (cadr a) met))
(setq kx (- x xg))
(setq ky (- y yg))
(setq xm (+ kx ax))
(setq ym (+ ky ay))

(setq luubatdiem (getvar "osmode")) (setq luulop (getvar "clayer"))
(setvar "MODEMACRO" "LIET KE TOA DO TAI DIEM 0-0")
(setvar "osmode" 0)
(command "INSERT" (strcat odiachay "\\tienich\\dwg\\nhap") (list (car b)(cadr b)) 1 1 0)
(setq xht (getreal "\nSo thu tu cua nut : "))
(setq xh (- xht 1))
(setq nx (* 8 xh))
(setq sb (/ xh 10))
(setq sbn (* 100 (fix sb)))
(setq snl (- xh (fix sb)))
(setq nl (- nx (* 80 (fix sb))))

(setq CHIAM (/ XHT 10))
(setq LAMCHAN (fix CHIAM))
(setq NHANM (* LAMCHAN 10))
(setq tenkc (- XHT NHANM))
(setq tenkcn (* TENKC 100))
(setq TENKCM (fix TENKCN))

(Cond
((= TENKCM 100) (command "INSERT" (strcat odiachay "\\tienich\\dwg\\tdbdiem") (list (- sbn 14) (- 6 nl)) 1 1 0)
)
((/= TENKCM 100)
)
)

(command "TEXT" (list (+ 0 sbn) (- 0 nl)) 4 0 (rtos xm 2 4))
(command "TEXT" (list (+ 42 sbn) (- 0 nl)) 4 0 (rtos ym 2 4))
(command "TEXT" (list (- sbn 10) (- 0 nl)) 4 0 (fix xht))
(command "LINE" (list (- sbn 14) (- (- 6 nl) 8))(list (+ sbn 80) (- (- 6 nl) 8)) "")
(command "LINE" (list (- sbn 14) (- 6 nl))(list (- sbn 14)(- (- 6 nl) 8)) "")
(command "LINE" (list (+ (- sbn 14) 12) (- 6 nl))(list (+ (- sbn 14) 12)(- (- 6 nl) 8)) "")
(command "LINE" (list (+ (- sbn 14) 53) (- 6 nl))(list (+ (- sbn 14) 53)(- (- 6 nl) 8)) "")
(command "LINE" (list (+ (- sbn 14) 94) (- 6 nl))(list (+ (- sbn 14) 94)(- (- 6 nl) 8)) "")
(setvar "osmode" luubatdiem) (setvar "clayer" luulop)


)


)
)


(if (= lc "K")
(progn
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(command "-style" "thep" "VNI-HELVE" "0" "1" "0" "n" "n")
(if (null met)(setq met 1))
(Setq temp T)
(While temp
(setq b (strcat "\nTi le /: "))
(Initget "t T")
(setq str (getpoint b))
(Cond
((= str "t") (setq met (dnint "\nMot met ban ve la bao nhieu "momet)))
((= str "T") (setq met (dnint "\nMot met ban ve la bao nhieu "momet)))
(Progn
(Setq b str)
(setq momet met)
(setq temp nil)
)
)
)
(setq luubatdiem (getvar "osmode")) (setq luulop (getvar "clayer"))
(setvar "osmode" 0)
(setq x (/ (car b) met))
(setq y (/ (cadr b) met))
(command "INSERT" "C:\\tailieukythuat\\dwg\\nhap" (list (car b)(cadr b)) 1 1 0)
(setq xht (getreal "\nSo thu tu cua nut : "))
(setq xh (- xht 1))
(setq nx (* 8 xh))
(setq sb (/ xh 10))
(setq sbn (* 100 (fix sb)))
(setq snl (- xh (fix sb)))
(setq nl (- nx (* 80 (fix sb))))

(setq CHIAM (/ XHT 10))
(setq LAMCHAN (fix CHIAM))
(setq NHANM (* LAMCHAN 10))
(setq tenkc (- XHT NHANM))
(setq tenkcn (* TENKC 100))
(setq TENKCM (fix TENKCN))

(Cond
((= TENKCM 100) (command "INSERT" "C:\\tailieukythuat\\dwg\\tdbdiem" (list (- sbn 14) (- 6 nl)) 1 1 0)
)
((/= TENKCM 100)
)
)

(command "TEXT" (list (+ 0 sbn) (- 0 nl)) 4 0 (rtos x 2 4))
(command "TEXT" (list (+ 42 sbn) (- 0 nl)) 4 0 (rtos y 2 4))
(command "TEXT" (list (- sbn 10) (- 0 nl)) 4 0 (fix xht))
(command "LINE" (list (- sbn 14) (- (- 6 nl) 8))(list (+ sbn 80) (- (- 6 nl) 8)) "")
(command "LINE" (list (- sbn 14) (- 6 nl))(list (- sbn 14)(- (- 6 nl) 8)) "")
(command "LINE" (list (+ (- sbn 14) 12) (- 6 nl))(list (+ (- sbn 14) 12)(- (- 6 nl) 8)) "")
(command "LINE" (list (+ (- sbn 14) 53) (- 6 nl))(list (+ (- sbn 14) 53)(- (- 6 nl) 8)) "")
(command "LINE" (list (+ (- sbn 14) 94) (- 6 nl))(list (+ (- sbn 14) 94)(- (- 6 nl) 8)) "")
(setvar "osmode" luubatdiem) (setvar "clayer" luulop)


(setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**")
(while
(setq b (getpoint "\nChon diem muon xem toa do : "))
(setq x (/ (car b) met))
(setq y (/ (cadr b) met))
(setq luubatdiem (getvar "osmode")) (setq luulop (getvar "clayer"))
(setvar "MODEMACRO" "LIET KE TOA DO TAI DIEM 0-0")
(setvar "osmode" 0)
(command "INSERT" "C:\\tailieukythuat\\dwg\\nhap" (list (car b)(cadr b)) 1 1 0)
(setq xht (getreal "\nSo thu tu cua nut : "))
(setq xh (- xht 1))
(setq nx (* 8 xh))
(setq sb (/ xh 10))
(setq sbn (* 100 (fix sb)))
(setq snl (- xh (fix sb)))
(setq nl (- nx (* 80 (fix sb))))

(setq CHIAM (/ XHT 10))
(setq LAMCHAN (fix CHIAM))
(setq NHANM (* LAMCHAN 10))
(setq tenkc (- XHT NHANM))
(setq tenkcn (* TENKC 100))
(setq TENKCM (fix TENKCN))

(Cond
((= TENKCM 100) (command "INSERT" "C:\\tailieukythuat\\dwg\\tdbdiem" (list (- sbn 14) (- 6 nl)) 1 1 0)
)
((/= TENKCM 100)
)
)

(command "TEXT" (list (+ 0 sbn) (- 0 nl)) 4 0 (rtos x 2 4))
(command "TEXT" (list (+ 42 sbn) (- 0 nl)) 4 0 (rtos y 2 4))
(command "TEXT" (list (- sbn 10) (- 0 nl)) 4 0 (fix xht))
(command "LINE" (list (- sbn 14) (- (- 6 nl) 8))(list (+ sbn 80) (- (- 6 nl) 8)) "")
(command "LINE" (list (- sbn 14) (- 6 nl))(list (- sbn 14)(- (- 6 nl) 8)) "")
(command "LINE" (list (+ (- sbn 14) 12) (- 6 nl))(list (+ (- sbn 14) 12)(- (- 6 nl) 8)) "")
(command "LINE" (list (+ (- sbn 14) 53) (- 6 nl))(list (+ (- sbn 14) 53)(- (- 6 nl) 8)) "")
(command "LINE" (list (+ (- sbn 14) 94) (- 6 nl))(list (+ (- sbn 14) 94)(- (- 6 nl) 8)) "")
(setvar "osmode" luubatdiem) (setvar "clayer" luulop)


)


)
)





(setvar "MODEMACRO" "**TAILIEUKYTHUAT.COM**")
(Princ)
)

;---------------------------------------
(defun nstr (stri def)
(princ stri)
(princ "<")
(princ " ")
(princ def)
(princ ">")
(princ ":")
(princ " ")
);defun nstr
;--------------------
(defun nstr1 (stri)
(princ stri)
(princ "<")
(princ "Nhap vao")
(princ ">")
(princ ":")
(princ " ")
);defun nstr1
;---------------------
(defun nint (prompt def / temp)
(if def
(setq temp (getint (nstr prompt def)))
(setq def (getint (nstr1 prompt)))
);if def
(if temp
(setq def temp)
def
);if temp
);defun nint
;---------------------
(defun dnint (prompt def / temp)
(if def
(setq temp (getreal (nstr prompt def)))
(setq def (getreal (nstr1 prompt)))
);if def
(if temp
(setq def temp)
def
);if temp
);defun nint
;--------------------
(defun ndist (po prompt def / temp) ;nhan kh/cach va luu gia tri mac dinh
(if def
(setq temp (getdist po (nstr prompt def)))
(setq def (getdist po (nstr1 prompt)))
)if def
(if temp
(setq def temp)
def
);if temp
);defun ndist

Tháng 11 25, 2015

Bạn chỉnh dùm mình

1. Lisp này toạ độ x, y bị đảo lôn ,không giống của mình

2. Không có số thập phân phía sau

3. Bạn thêm vòng tròn cho mình luôn với

Bạn vẽ nét tròn, nét chéo, nét thẳng và text thành 1 cái block đi, mình sẽ giúp bạn phần còn lại!

1. Mình đã test thấy kết quả X,Y đâu có bị đảo lộn gì đâu bạn???

2. Bạn cứ làm theo a Hoành thì mọi người sẽ giúp bạn dễ hơn bạn ạ…

3. Muốn hoàn hảo thì bạn nên post file dwg để mọi người check code dễ dàng hơn,ví dụ:

· hướng text của bạn luôn sang phải hay như thế nào?

· Chiều cao Text,textstyle,bán kính đường tròn,layer ra sao???

......

Tháng 11 26, 2015

dạ em gữi kèm file cad mong được các anh giúp.

Mấy anh đặt tùy chỉnh luôn cho em cái này:(hình tròn và cỡ chữ có thể thay đổi được do người dùng chọn)

http://www.cadviet.com/upfiles/5/133575_nho_viet_lisp.dwg

Tháng 11 26, 2015

dạ em gữi kèm file cad mong được các anh giúp.

Mấy anh đặt tùy chỉnh luôn cho em cái này:(hình tròn và cỡ chữ có thể thay đổi được do người dùng chọn)

http://www.cadviet.com/upfiles/5/133575_nho_viet_lisp.dwg

Đã code lại cho bạn rồi đây ^^

Bạn dùng thử xem sao nhé ^^

Tên lệnh: GTD

;;-----------------------=={ Xuat toa do diem }==-----------------------;;

;; ;;

;; Command : MBN ;;

;; Date : 26-Nov-2015 ;;

;;----------------------------------------------------------------------;;

;; Author : @ Tran Cong Son - Detail SS ;;

;;----------------------------------------------------------------------;;

(defun C:GTD (/ CAOTXT D1 DI DI1 DI2 DT DT1 DT2 DT3 I LST_VAR OLD_VAR STT TB1 TB2 TX TY)

(setvar "MODEMACRO" "@ Tr\U+1EA7n C\U+00F4ng S\U+01A1n _ XDDD & CN")

;;-----------------=={ Make Text }==------------------;;

(defun TS:MakeText (point string justify / Lst)

(setq Lst

(list '(0 . "TEXT")

(cons 8 "gt-duong")

(cons 10 point)

(cons 40 caotxt)

(cons 1 string)

(cons 50 0.0)

(cons 7 "VNI-CON")

)

justify (strcase justify)

)

(cond

((= justify "R")

(setq Lst (append Lst (list (cons 72 2) (cons 11 point))))

)

((= justify "TL")

(setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3))))

)

((= justify "TR")

(setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3))))

)

(entmakex Lst)

)

;;-----------------=={ Make Pline }==------------------;;

(defun TS:MakePline (listpoint / Lst)

(setq Lst (list '(0

.

"LWPOLYLINE"

)

'(100 . "AcDbEntity")

(cons 8 "gt-duong")

(cons 6 "Continuous")

'(100 . "AcDbPolyline")

(cons 90 (length listpoint))

(cons 70 0)

)

(foreach PP listpoint

(setq Lst (append Lst (list (cons 10 PP))))

)

(entmakex Lst)

)

;;-----------------=={ Main Function }==------------------;;

(setvar "cmdecho" 0)

(command "Undo" "Begin")

(setq lst_var '("osmode" "dimzin")

old_var (mapcar 'getvar lst_var)

)

(mapcar 'setvar lst_var '(32 0))

(or *h*

(setq *h* 1)

)

(setq caotxt (getreal (strcat "\nCao text < " (rtos *h* 2 0) " >:")))

(if caotxt

(setq *h* caotxt)

(setq caotxt *h*)

)

(if (not (tblsearch "layer" "gt-duong"))

(vl-cmdf ".layer" "n" "gt-duong" "l" "Continuous" "gt-duong" "")

)

(if (not (tblsearch "Style" "VNI-CON"))

(vl-cmdf "_.Style" "VNI-CON" "VNI-HELVE-CONDENSE" 0 1 "" "" "")

)

(setq i 1

stt '()

)

(While

(setq D1 (getpoint (strcat "\nPick \U+0111i\U+1EC3m th\U+1EE9 " (rtos i 2 0) " :")))

(Progn

(entmake

(list (cons 0 "CIRCLE")

(cons 8 "gt-duong")

(cons 10 D1)

(cons 40 (* 0.15 caotxt))

)

(setq DT

(getpoint

D1

(strcat "\n\U+0110i\U+1EC3m \U+0111\U+1EB7t Text c\U+1EE7a n\U+00FAt th\U+1EE9 "

(rtos i 2 0)

" :"

)

(setq TX (strcat "X=" (rtos (car D1) 2 3))

TY (strcat "Y=" (rtos (cadr D1) 2 3))

stt (append stt (list i))

)

(if (>= (car DT) (car D1))

(progn

(setq DT1 (list (+ (car DT) (* 0.5 caotxt)) (+ (cadr DT) (* 0.25 caotxt)) 0.0)

DT2 (list (+ (car DT) (* 0.5 caotxt)) (- (cadr DT) (* 0.25 caotxt)) 0.0)

)

(TS:MakeText DT1 TX "L")

(setq TB1 (textbox (entget (entlast)))

di1 (distance (car TB1) (cadr TB1))

)

(TS:MakeText DT2 TY "TL")

(setq TB2 (textbox (entget (entlast)))

di2 (distance (car TB2) (cadr TB2))

)

(setq di (max di1 di2)

DT3 (polar DT 0 (+ di (* 0.5 caotxt)))

)

(TS:MakePline (list D1 DT DT3))

)

(progn

(setq DT1 (list (- (car DT) (* 0.5 caotxt)) (+ (cadr DT) (* 0.25 caotxt)) 0.0)

DT2 (list (- (car DT) (* 0.5 caotxt)) (- (cadr DT) (* 0.25 caotxt)) 0.0)

)

(TS:MakeText DT1 TX "R")

(setq TB1 (textbox (entget (entlast)))

di1 (distance (car TB1) (cadr TB1))

)

(TS:MakeText DT2 TY "TR")

(setq TB2 (textbox (entget (entlast)))

di2 (distance (car TB2) (cadr TB2))

)

(setq di (max di1 di2)

DT3 (polar DT pi (+ di (* 0.5 caotxt)))

)

(TS:MakePline (list D1 DT DT3))

)

(setq i (+ i 1))

)

(command "Undo" "End")

(setvar "cmdecho" 1)

(princ)

)

Chúc mọi người làm việc zui zẻ !

Tháng 11 26, 2015

Rất cảm ơn anh Tr.cong sơn. em đã text rất ok, anh cho em hỏi nếu em muốn thay đổi tọa độ X,Y thi thay đổi ở dòng lệnh nào.

Tháng 11 26, 2015

Rất cảm ơn anh Tr.cong sơn. em đã text rất ok, anh cho em hỏi nếu em muốn thay đổi tọa độ X,Y thi thay đổi ở dòng lệnh nào.

Bạn tìm dòng này nhé: (dòng 98 trong lisp):

(setq TX (strcat "X=" (rtos (car D1) 2 3))

TY (strcat "Y=" (rtos (cadr D1) 2 3))

stt (append stt (list i))

)

Muốn đổi X thành Y (tức là X xuống dưới,Y lên trên) thì đổi thành:

(setq TX (strcat "Y=" (rtos (cadr D1) 2 3))

TY (strcat "X=" (rtos (car D1) 2 3))

stt (append stt (list i))

)

là được bạn ak

Chúc thành công !

Chỉnh sửa Tháng 11 26, 2015 theo Tr.CongSon

Tháng 11 26, 2015

Bạn thử mở file này,chèn block có tên TOADO vào các điểm trên màn hình,

tọa độ X, Y của điểm sẽ được cập nhật vào TEXT trong block.

Với block này, bạn không cần lisp.

block_toado.dwg

Tháng 11 26, 2015

Bạn thử mở file này,chèn block có tên TOADO vào các điểm trên màn hình,

tọa độ X, Y của điểm sẽ được cập nhật vào TEXT trong block.

Với block này, bạn không cần lisp.

block_toado.dwg

Tuyệt vời a Hoành ơi ..

Anh dùng Field cập nhật tọa độ tự động hay thật.^^

@chủ thớt: Sau khi copy block của a Hoành thì bạn nhớ Regen bản vẽ mới cập nhật tạo độ nhé !

Tháng 11 27, 2015

Cảm ơn mọi người rất nhiều.Tiện thể cho em hỏi trong quá trình insert Block thông số như hình em đính kèm chỉnh ở chỗ nào.

Tháng 11 27, 2015

Cảm ơn mọi người rất nhiều.Tiện thể cho em hỏi trong quá trình insert Block thông số như hình em đính kèm chỉnh ở chỗ nào.

Cái này mình nghĩ bản vẻ chứa Block của bạn ở hệ Inches

Bạn chuyển bản vẽ chứa Block sang hệ Milimeters là được !

P/s: Cảm ơn bằng nút thanks có ý nghĩa hơn bạn ơi ^^

Tháng 11 28, 2015

nút thanks nằm ở góc nào vây anh :mellow:

Tháng 11 28, 2015

nút thanks nằm ở góc nào vây anh :mellow:

Hề hề hề,

Ở cái mũi tên chỉ thượng màu xanh , góc bên phải phía dưới bài viết.

Tháng 12 1, 2015

ah, thank anh, thì ra là cái đó

Tháng 6 12, 2019

Block của anh Hoành em dùng bị ngược X, Y, có ai giúp em sửa lại với được không ạ

Tháng 9 20, 2020

(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"))
(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 2) " >:")))
(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 3)
y (rtos (cadr D1) 2 3)
   TX (strcat "Y:"(rtos (Car D1) 2 3))
   TY (strcat "X:"(rtos (Cadr D1) 2 3))
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" 5
       "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" 1
       "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))
   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" 4 "line" p1 p2 "" "line" p3 p4 "" "CECOLOR" 4
    "text" "m" p11 h 0 "STT"
    "text" "m" p22 h 0 "Täa ®é Y"
    "text" "m" p33 h 0 "Täa ®é X"
    "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" 4
   "text" "m" PTD h 0 tstt
"text" "m" PTX h 0 xx
"text" "m" PTY h 0 yy
   "CECOLOR" 4
"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" 4
   "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 toado

tdn ghi toa do.lsp

Đăng nhập

Lisp Ghi Chú Tọa Độ Từng Điểm Khi Pick

Các bài được khuyến nghị

namgiangduy89 19

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tr.CongSon 42

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

namgiangduy89 19

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

namgiangduy89 19

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Nguyen Hoanh 4.663

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

namgiangduy89 19

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hainguyen2014 12

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

namgiangduy89 19

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hainguyen2014 12

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hainguyen2014 12

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

namgiangduy89 19

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tr.CongSon 42

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

namgiangduy89 19

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tr.CongSon 42

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

namgiangduy89 19

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tr.CongSon 42

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Nguyen Hoanh 4.663

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tr.CongSon 42

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

namgiangduy89 19

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tr.CongSon 42