Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
namgiangduy89

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

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

Tr.CongSon    41

133575_td.png

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 !

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

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:

 

 

 

 

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


;; 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

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

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
  • Vote giảm 1

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    41

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???

......

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    41

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ẻ !

  • Vote tăng 1

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    41

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 theo Tr.CongSon

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

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

  • Vote tăng 5

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    41

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é !

  • Vote tăng 1

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    41

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.133575_hoi.png

 

 

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 ^^

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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×