Jump to content
InfoFile
Tác giả: hdg2318
Bài viết gốc: 100317
Tên lệnh: bfind%3B
Find và Replace trong nhiều bản vẽ
hôm trước lang thang trên mạng, tìm được cái Lisp của Lee McDonnell, thấy hay quá, tuy nhiên, do bản vẽ nơi mình làm việc, dung toàn tiếng anh nên chưa gặp vấn đề gì. còn với các bản vẽ có tiếng việt, các bạn thử test xem nhé. Lisp có rất nhiều tùy chọn.


Filename: 100317_bfind%3B...............................................................................%3B.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 113902
Tên lệnh: tdt
Viết lisp theo yêu cầu [phần 2]


Chào bạn Phamvanthiet108,
Bạn thử dùng cái này nhé. Mình cải tạo thêm từ chính cái lisp bạn đã post lên. Lưu ý rằng ở lisp này mình chỉ giải quyết đến mức độ đảo nhỏ cấp 1 thôi nhé. Nghĩa là nếu trong vùng chọn của bạn có vùng trống trong đảo cấp một là sẽ bị sai đó. Việc tổ hợp đảo và vùng trống nhiều cấp hiện tại mình chưa nghĩ ra giải pháp nào hợp lý cả. Lisp...
>>

Chào bạn Phamvanthiet108,
Bạn thử dùng cái này nhé. Mình cải tạo thêm từ chính cái lisp bạn đã post lên. Lưu ý rằng ở lisp này mình chỉ giải quyết đến mức độ đảo nhỏ cấp 1 thôi nhé. Nghĩa là nếu trong vùng chọn của bạn có vùng trống trong đảo cấp một là sẽ bị sai đó. Việc tổ hợp đảo và vùng trống nhiều cấp hiện tại mình chưa nghĩ ra giải pháp nào hợp lý cả. Lisp đã được chạy thử trên file bạn đã boundary xong chứ không phải file chưa tạo boundary bạn nhé. Việc tạo Boundary mình chưa giải quyết được.
Việc ghi diện tích ra file hay vẽ lên bản vẽ mình không làm do thiết nghĩ không phải quá khó đối với bạn.
Hy vọng bạn sẽ hài lòng dùng tạm.


Chúc bạn vui.
<<

Filename: 113902_tdt.lsp
Tác giả: hakhoailang
Bài viết gốc: 216550
Tên lệnh: ttd
[ nhờ chỉnh sửa ] lisp xuất tọa độ

em sưu tầm dc cái lisp tính tọa độ trên cad việt rất hay . nhưng chưa phục vụ dc nhu cầu làm việc vì em là dân cầu đường . tọa độ của máy toàn đạc hay vn2000 nó ngược với tọa độ của cad . nên em post bài này mong anh em chỉnh sửa dùm để cho đúng mục đích sử dụng .
1 ) tọa độ x của cad thành tọa độ Y của vn2000
2 ) tọa độ Y của cad thành tọa độ Y của vn 2000
3 ) sửa...
>>
em sưu tầm dc cái lisp tính tọa độ trên cad việt rất hay . nhưng chưa phục vụ dc nhu cầu làm việc vì em là dân cầu đường . tọa độ của máy toàn đạc hay vn2000 nó ngược với tọa độ của cad . nên em post bài này mong anh em chỉnh sửa dùm để cho đúng mục đích sử dụng .
1 ) tọa độ x của cad thành tọa độ Y của vn2000
2 ) tọa độ Y của cad thành tọa độ Y của vn 2000
3 ) sửa vòng tròn bao quanh số thứ tự thành hình elip , và hình elip này tự phóng to theo chiều dàu của text nằm trong nó
4 ) bảng tọa độ khi xuất ra text bị đè lên nhau , nhờ các anh chỉnh lại cho nó nằm trong ô . bảng thống kê này cũng có XY ngược với cad .

cảm ơn anh em .
;; free lisp from cadviet.com
(prompt"\n - THONG KE TOA DO\n")
----------------------------------------------
(defun C:TTD ()
(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? <" 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? <" 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\n")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
);DONG toa do

http://www.cadviet.com/upfiles/3/71598_1_1.png
<<

Filename: 216550_ttd.lsp
Tác giả: xuandao0708
Bài viết gốc: 65131
Tên lệnh: ve0
Viết Lisp theo yêu cầu

Em xin nói lại yêu cầu của em:
- Đoạn lisp 1 của Bác SSG dùng để vẽ bảng Toạ Độ Góc Ranh có lệnh : vc

---Yêu cầu 1: thêm hình tròn có tô hatch tại các đỉnh ( nếu được thì mong Bác có thể cho người dùng nhập đường kính vòng tròn)
---Yêu cầu 2: chuyển lại font chữ giũa kích thước và số TT ( số TT cho font chữ nghiêng và kích thước cho font chữ thẳng và tô...
>>

Em xin nói lại yêu cầu của em:
- Đoạn lisp 1 của Bác SSG dùng để vẽ bảng Toạ Độ Góc Ranh có lệnh : vc

---Yêu cầu 1: thêm hình tròn có tô hatch tại các đỉnh ( nếu được thì mong Bác có thể cho người dùng nhập đường kính vòng tròn)
---Yêu cầu 2: chuyển lại font chữ giũa kích thước và số TT ( số TT cho font chữ nghiêng và kích thước cho font chữ thẳng và tô đậm)
---Yêu cầu 3: mong Bác có thể cho người dùng được chọn save lại hay không save lại bảng TĐGR ngay tại thư mục đã mở bản vẽ ra bằng file excel từng cột để cần thì có thể phục vụ cho công tác sau này.
Dưới đây là đường link file mẫu:

http://www.cadviet.com/upfiles/Mau_2_2.dwg

Do hôm nay Upload file len cadviet ko được nên nếu bài có dài quá thì mong các Bác thông cảm, do em chưa biết cách cho bài vào box
<<

Filename: 65131_ve0.lsp
Tác giả: thiep
Bài viết gốc: 65292
Tên lệnh: plrev
Viết Lisp theo yêu cầu

Đây là lisp PLREV.LSP:

Khoadung tạo Linetype, Thiep gợi ý: nên nghiên cứu tạo 2 kiểu đường: + và -. Có nghĩa là kiểu CHIEUSANG+ và CHIEUSANG-. Khi đó: nếu vẽ đường từ phải sang trái thì dùng kiểu CHIEUSANG+, nếu vẽ đường từ trái sang phải thì dùng kiểu CHIEUSANG-

Filename: 65292_plrev.lsp
Tác giả: q288
Bài viết gốc: 65343
Tên lệnh: sca
Viết Lisp theo yêu cầu


Chắc bạn bức xúc lắm hay sao mà xài chữ vừa to vừa đỏ thế.
Bạn thử cái này xem sao. Mình chưa nghĩ ra cái gì hay nên xài tạm cái này nhé.

Filename: 65343_sca.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 217027
Tên lệnh: reverse
[ xin lisp ] đổi chiều đối tượng ( đường cong , thẳng , gấp khúc )
Lisp đổi chiều đối tượng (sưu tầm).

Filename: 217027_reverse.lsp
Tác giả: ketxu
Bài viết gốc: 217133
Tên lệnh: banthichdatgithidat
Yêu cầu lisp thay thế nhiều Hatch đã chọn bằng Hatch có sẵn (pick chuột)-ko dùng Ma


(defun c:banthichdatgithidat(/ ss tm)
(if
(and (setq ss (ssget (list (cons 0 "HATCH"))))
(setq tm (car (entsel "\nHatch mau :")))
(= (cdr (assoc 0 (entget tm))) "HATCH")
)
(command ".MATCHPROP" tm ss "" ^C)
))

Filename: 217133_banthichdatgithidat.lsp
Tác giả: Tue_NV
Bài viết gốc: 66172
Tên lệnh: scd
Viết Lisp theo yêu cầu

Chào dienlicogi và xuantran
Đoạn Code sau Tue_NV đã cải thiện theo ý của dienlicogi và xuantran
Các bạn dùng thử và cho ý kiến :

:s_big:
Tick Thanksss thay lời nói cảm ơn :blink:
>>

Chào dienlicogi và xuantran
Đoạn Code sau Tue_NV đã cải thiện theo ý của dienlicogi và xuantran
Các bạn dùng thử và cho ý kiến :

:s_big:
Tick Thanksss thay lời nói cảm ơn :blink: :blink: :blink: :cry: :)
<<

Filename: 66172_scd.lsp
Tác giả: Tue_NV
Bài viết gốc: 66250
Tên lệnh: scd
Viết Lisp theo yêu cầu

1. Không thể loại bỏ những đường gióng có cao độ gần như nhau được. Vì khi chạy Lisp sẽ hiểu là chạy từ đầu đỉnh đến cuối đỉnh của Pline
Lisp này Tue_NV đã chỉnh lại :


PS : Tue_NV không thích gọi bằng "cậu". Hãy tôn trọng


@Xuantran : Tue_NV không hiểu file của bạn bị lỗi gì nữa. Bạn hãy lấy file này của Tue_NV test thử.
File test thử...
>>

1. Không thể loại bỏ những đường gióng có cao độ gần như nhau được. Vì khi chạy Lisp sẽ hiểu là chạy từ đầu đỉnh đến cuối đỉnh của Pline
Lisp này Tue_NV đã chỉnh lại :


PS : Tue_NV không thích gọi bằng "cậu". Hãy tôn trọng


@Xuantran : Tue_NV không hiểu file của bạn bị lỗi gì nữa. Bạn hãy lấy file này của Tue_NV test thử.
File test thử đây : http://www.cadviet.com/upfiles/Coc.dwg
Chiều cao chữ bạn chọn khoảng bằng 2 tronh hình vẽ thôi nhé
:s_big:
<<

Filename: 66250_scd.lsp
Tác giả: npham
Bài viết gốc: 121393
Tên lệnh: cvs
Xuất dữ liệu cad sang EXCEL lần lượt
có thể là như thế này chẳng hạn


Filename: 121393_cvs.lsp
Tác giả: ketxu
Bài viết gốc: 217315
Tên lệnh: linhtinh
[ yêu cầu ] lisp đo khoảng cách dán bào block att
Ng­ười ta yêu cầu như thế nào chỉ mần vậy thui các bác :)

(defun c:linhtinh(/ a)(vl-load-com)
(vla-put-textstring
(vlax-ename->vla-object (car(nentsel "\nThay gia tri vao dau day ?")))
(rtos (distance (setq a (getpoint "\nP1 :"))(getpoint a "\nP2 :")) 2 2)
)
(command...
>>
Ng­ười ta yêu cầu như thế nào chỉ mần vậy thui các bác :)

(defun c:linhtinh(/ a)(vl-load-com)
(vla-put-textstring
(vlax-ename->vla-object (car(nentsel "\nThay gia tri vao dau day ?")))
(rtos (distance (setq a (getpoint "\nP1 :"))(getpoint a "\nP2 :")) 2 2)
)
(command "regen")
)

<<

Filename: 217315_linhtinh.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 217294
Tên lệnh: ha
Tác giả: Doan Van Ha
Bài viết gốc: 217439
Tên lệnh: xtxt
Tác giả: q288
Bài viết gốc: 65423
Tên lệnh: vc
Viết Lisp theo yêu cầu


Nếu vậy bạn dùng cái này. Cái này dùng cho line và pline 2d kín.
Sau khi lập bảng xong, CT hỏi có save ko? nếu ko save thì enter, save thì nhấn Y.

Filename: 65423_vc.lsp
Tác giả: Tue_NV
Bài viết gốc: 60231
Tên lệnh: scd
Viết Lisp theo yêu cầu

Chào bạn thuyvan0210. Đây là Code mà Tue_NV viết theo ý của bạn. Hy vọng bạn hài lòng :

Filename: 60231_scd.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 217754
Tên lệnh: test
Tác giả: phamngoctukts
Bài viết gốc: 106703
Tên lệnh: exbl
Viết lisp theo yêu cầu [phần 2]

Cám ơn bạn phamthanhbinh đã chỉ giáo
mình viết code thế này có đúng không vậy bạn

Bạn cũng cho mình hỏi thêm phát
làm thế nào để explode thằng block đã scale théo trục x,y mà trong thằng đó có block.
Có code nào thay thế lệnh align không. code của mình viết nó toàn báo lỗi khi sử dụng 4 lần lệnh align.

Filename: 106703_exbl.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 217912
Tên lệnh: ha
Tác giả: gia_bach
Bài viết gốc: 67592
Tên lệnh: clt
Viết Lisp theo yêu cầu

Chào Phiphi-
Gửi bạn lisp chuyển các đối tuợng về Layer mới có tên LINETYLE+COLOR
ex :
- các đối tuợng có LineType= Center và Color=5 sẽ chuyển sang Layer Center5
- các đối tuợng có LineType= Hidden và Color=3 sẽ chuyển sang Layer Hidden3
- các đối tuợng có LineType=ByLayer hay ByBlock giữ nguyên (không thay đổi)

Filename: 67592_clt.lsp

Trang 107/304

107