Jump to content
InfoFile
Tác giả: duy782006
Bài viết gốc: 191590
Tên lệnh: kthtr
lisp Phun tọa độ các điểm từ file txt vào CAD

Thực ra khi đã xuất ra được thành 3 đối tượng như bạn có thì và mục đích là muốn chỉnh kích thước text thì bài toán mình nghỉ không cần đọc file txt nửa.
-Điểm point hiện nay có cao độ vậy theo mình bài toán chỉ cần:
-Tắt 2 text trước và sau đi. (cái này bạn dùng layoff)
-Giữ nguyên point hiện có (để làm nguyên liệu cho lisp và các phần mềm can thiệp sau này).
-Lisp...
>>
Thực ra khi đã xuất ra được thành 3 đối tượng như bạn có thì và mục đích là muốn chỉnh kích thước text thì bài toán mình nghỉ không cần đọc file txt nửa.
-Điểm point hiện nay có cao độ vậy theo mình bài toán chỉ cần:
-Tắt 2 text trước và sau đi. (cái này bạn dùng layoff)
-Giữ nguyên point hiện có (để làm nguyên liệu cho lisp và các phần mềm can thiệp sau này).
-Lisp chỉ cần đọc z của point và viết ra 1 text tại point này lệch tí cũng không sao (khi in tắt luôn cái point đi).
Lúc này công việc quá đơn giản. OK?

LIsp đó như này:

(Defun c:kthtr ()
(setvar "MODEMACRO" "CHINH CAO DO HIEN TRANG")
(command "-layer" "new" "SOCAODOSUACHUA" "color" "50" "SOCAODOSUACHUA" "")
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
(Princ "\nHay chon vung :")
(setq XX (ssget '((0 . "POINT,CIRCLE"))))
(setq L 0)
(setq M (sslength XX))
(while (< L M)
(setq DT (ssname XX L))
(setq DT (entget DT))
(setq TEXT (cdr (assoc 10 DT)))
(setq x (car TEXT))
(setq y (cadr TEXT))
(setq z (caddr TEXT))
(command "-layer" "set" "SOCAODOSUACHUA" "")
(command "TEXT" "c" (list (+ x 0)(- y 0)) 1 0 (rtos Z 2 2))
(setq L (1+ L))
)
(setvar "MODEMACRO" "**CHUC BAN LAM VIEC HIEU QUA** PHAM QUOC DUY - BINH SON - QUANG NGAI")
(Princ)
)



Vui lòng tắt chế độ bắt điểm trước khi chạy lisp vì cái này trong bộ tổng hợp mình chưa sửa lưu và trả biến này nên xóa bén đi rồi.
<<

Filename: 191590_kthtr.lsp
Tác giả: gia_bach
Bài viết gốc: 191655
Tên lệnh: eraseanddisconnect linkr
LISP : Ánh xạ giá trị đối tượng (thay đổi giá trị nguồn -> Đích cập nhật theo)
Thaistreetz tham khảo lisp EraseAndDisconnect

(vl-load-com)
(defun c:EraseAndDisconnect ( / allReactorsLst obj removeLst)
(if (setq obj (vlax-ename->vla-object (car (entsel))))
(progn
(mapcar
'(lambda (a / ownLst)
(setq ownLst (vlr-owners a))
(cond
((and (member obj ownLst) (= (length ownLst) 1))
(vlr-remove a) )
((member obj ownLst)
(vlr-owner-remove a obj) ) ) )
(apply 'append...
>>
Thaistreetz tham khảo lisp EraseAndDisconnect

(vl-load-com)
(defun c:EraseAndDisconnect ( / allReactorsLst obj removeLst)
(if (setq obj (vlax-ename->vla-object (car (entsel))))
(progn
(mapcar
'(lambda (a / ownLst)
(setq ownLst (vlr-owners a))
(cond
((and (member obj ownLst) (= (length ownLst) 1))
(vlr-remove a) )
((member obj ownLst)
(vlr-owner-remove a obj) ) ) )
(apply 'append (mapcar 'cdr (vlr-reactors :vlr-object-reactor))) )
(setq allReactors (apply 'append (mapcar 'cdr (vlr-reactors))))
(mapcar 'vlr-remove allReactors) ; temporarily disable all reactors
(vla-delete obj)
(mapcar 'vlr-add allReactors) ))
(princ))
(defun c:LinkR (/ ss objlst obj_reactor); Link Radius
(if (setq ss (ssget '((0 . "CIRCLE"))) )
(setq objlst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
obj_reactor (vlr-object-reactor objlst nil '((:vlr-modified . callback)))) ) )
(defun callback (notifier-object obj_reactor parameter-list / objlist newrad)
(setq objlist (vlr-owners obj_reactor))
(setq newrad (vla-get-radius notifier-object))
(foreach obj objlist
(if (/= (vla-get-radius obj)newrad)
(vla-put-radius obj newrad) ) ) )

<<

Filename: 191655_eraseanddisconnect_linkr.lsp
Tác giả: ssg
Bài viết gốc: 13516
Tên lệnh: mcp rcp
Viết Lisp theo yêu cầu


1) Về logic thì thế này:
Thay file A bằng file B?
- Rename A thành A0
- Copy B -> A

Trả lại nguyên trạng?
- Delete A
- Rename A0 thành A

2) Bạn lật Developer Help - Autolisp Reference - V-functions ra xem. Các họ functions dạng vl-file-xxxx có đủ "đồ chơi" cho các mục đích tương tự như trên. Mỗi function đều có ví dụ mẫu, bạn đọc là hiểu ngay.

3) Một ví...
>>

1) Về logic thì thế này:
Thay file A bằng file B?
- Rename A thành A0
- Copy B -> A

Trả lại nguyên trạng?
- Delete A
- Rename A0 thành A

2) Bạn lật Developer Help - Autolisp Reference - V-functions ra xem. Các họ functions dạng vl-file-xxxx có đủ "đồ chơi" cho các mục đích tương tự như trên. Mỗi function đều có ví dụ mẫu, bạn đọc là hiểu ngay.

3) Một ví dụ cụ thể: giả sử bạn có file cấu hình theo ý thích lưu ở D:\acad.pgp
Lệnh MCP thiết lập cấu hình theo ý thích, RCP trả lại nguyên trạng. Bạn đọc comments ở các dòng code sẽ hiểu rõ. Chương trình được lập ở dạng đơn giản nhất để bạn dễ đọc. Ngoài ra, bạn tự đặt thêm các điều kiện để hoàn thiện tiếp chương trình. Ví dụ: nếu không tìm thấy file thì xử lý thế nào?

<<

Filename: 13516_mcp_rcp.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 14916
Tên lệnh: inc
Viết Lisp theo yêu cầu


click đúp thì lisp rất khó làm được.
Nhưng sử dụng lệnh inc dưới đây sẽ giúp bạn làm được điều đó:


Filename: 14916_inc.lsp
Tác giả: ssg
Bài viết gốc: 16165
Tên lệnh: ob
Viết Lisp theo yêu cầu


Bạn dùng thử lisp này, lệnh OB, select vào block là nó open file tương ứng.
Yếu cầu: bản vẽ chính và các bản vẽ chi tiết phải nằm chung thư mục và không cần thiết lập Support File Search Path (SFSP).
Theo mình, không nên lạm dụng SFSP vì nếu số lượng project tăng lên theo thời gian (nếu bạn thiết kế thường xuyên chừng vài năm thì số lượng project tăng lên đáng kể) thì cái list...
>>

Bạn dùng thử lisp này, lệnh OB, select vào block là nó open file tương ứng.
Yếu cầu: bản vẽ chính và các bản vẽ chi tiết phải nằm chung thư mục và không cần thiết lập Support File Search Path (SFSP).
Theo mình, không nên lạm dụng SFSP vì nếu số lượng project tăng lên theo thời gian (nếu bạn thiết kế thường xuyên chừng vài năm thì số lượng project tăng lên đáng kể) thì cái list SFSP cứ nối dài mãi à? Nhiều quá có vẻ không ổn chút nào. Ví dụ: 2 project khác nhau nhưng có 2 file trùng tên. Nếu không chỉ định chính xác path có khả năng sẽ gây ra nhầm lẫn.



Vấn đề còn tồn tại:
Nếu file bản vẽ chi tiết đã open rồi nhưng user không nhớ và dùng tiếp OB, chương trình không có phản ứng gì cả, có thể làm cho user bối rối. Lẽ ra, chương trình phải có 1 trong 2 cách hành xử:
- Ra thông báo, kiểu như "File này đã được mở"
- Không cần thông báo, chuyển focus sang file bản vẽ đã chỉ định
Bạn nào có thể bổ sung giúp chỗ này? Cụ thể, làm thế nào để lấy được list các bản vẽ đang được open (bấm vào Menu - Window -> có 1 list các file *.dwg ở dưới cùng ấy). Lấy được list này sẽ xử được tồn tại trên.
<<

Filename: 16165_ob.lsp
Tác giả: ssg
Bài viết gốc: 16316
Tên lệnh: ob
Viết Lisp theo yêu cầu

1) Bạn sửa như vậy, bắt buộc phải thiết lập Support File Search Path (SFSP). Nếu không sẽ không chạy được. Đây không phải là giải pháp hay như mình đã phân tích ở bài trên.

2) Dùng "start" đúng là bị nhược điểm về dấu space trong filename như bạn nói

3) Bạn dùng thử lisp này. Mình đã thử, chạy đúng trong mọi trường hợp, không cần thiết lập SFSP. Nếu file bản vẽ...
>>

1) Bạn sửa như vậy, bắt buộc phải thiết lập Support File Search Path (SFSP). Nếu không sẽ không chạy được. Đây không phải là giải pháp hay như mình đã phân tích ở bài trên.

2) Dùng "start" đúng là bị nhược điểm về dấu space trong filename như bạn nói

3) Bạn dùng thử lisp này. Mình đã thử, chạy đúng trong mọi trường hợp, không cần thiết lập SFSP. Nếu file bản vẽ đã open, nó sẽ open tiếp ở dạng ReadOnly.


<<

Filename: 16316_ob.lsp
Tác giả: ssg
Bài viết gốc: 16316
Tên lệnh: ob2
Viết Lisp theo yêu cầu

1) Bạn sửa như vậy, bắt buộc phải thiết lập Support File Search Path (SFSP). Nếu không sẽ không chạy được. Đây không phải là giải pháp hay như mình đã phân tích ở bài trên.

2) Dùng "start" đúng là bị nhược điểm về dấu space trong filename như bạn nói

3) Bạn dùng thử lisp này. Mình đã thử, chạy đúng trong mọi trường hợp, không cần thiết lập SFSP. Nếu file bản vẽ...
>>

1) Bạn sửa như vậy, bắt buộc phải thiết lập Support File Search Path (SFSP). Nếu không sẽ không chạy được. Đây không phải là giải pháp hay như mình đã phân tích ở bài trên.

2) Dùng "start" đúng là bị nhược điểm về dấu space trong filename như bạn nói

3) Bạn dùng thử lisp này. Mình đã thử, chạy đúng trong mọi trường hợp, không cần thiết lập SFSP. Nếu file bản vẽ đã open, nó sẽ open tiếp ở dạng ReadOnly.


<<

Filename: 16316_ob2.lsp
Tác giả: ssg
Bài viết gốc: 16375
Tên lệnh: ob
Viết Lisp theo yêu cầu

Không mở được? Ssg đã test rất kỹ trên máy mình! Bạn thử dùng lại lisp sau:



Yêu cầu:
1) AutoCAD đời 2002 trở đi (mình đã test trên 2002 và 2007)
2) Phải thiết lập SFSP cho thư viện các bản vẽ chi tiết
3) Bỏ tất cả các chương trình chạy thử mấy hôm nay đi
4) Thử vô hiệu hoá toàn bộ các lisp khác có thể đang thiết lập chế độ autoLoad trên máy...
>>

Không mở được? Ssg đã test rất kỹ trên máy mình! Bạn thử dùng lại lisp sau:



Yêu cầu:
1) AutoCAD đời 2002 trở đi (mình đã test trên 2002 và 2007)
2) Phải thiết lập SFSP cho thư viện các bản vẽ chi tiết
3) Bỏ tất cả các chương trình chạy thử mấy hôm nay đi
4) Thử vô hiệu hoá toàn bộ các lisp khác có thể đang thiết lập chế độ autoLoad trên máy bạn (loại trừ khả năng có function nào đó trùng tên)

Bạn đáp ứng 4 yêu cầu trên, chắc chắn phải chạy được. Nếu vẫn không chạy được thì ssg... cũng bó tay!

P/S:
Chuỗi S = "(strcat "acadapplication.documents.open \"" fn "\",FALSE"))" không phải tạo đường dẫn.
Khi thư viện đã khai báo SFSP thì kết quả (setq fn (findfile (strcat bln ".dwg"))) đã là Full Filename của bản vẽ block rồi.
Cú pháp (vl-cmdf "vbastmt" S) là gọi một thủ tục VBA bằng lisp, với S là cú pháp của VBA. Bạn không chạy được cũng có thể là do sự khác biệt về version của Cad dẫn đến khác biệt version của VBA.
<<

Filename: 16375_ob.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 17212
Tên lệnh: dong
Viết Lisp theo yêu cầu


lệnh DONG dưới đây sẽ làm điều bạn muốn:

Filename: 17212_dong.lsp
Tác giả: ssg
Bài viết gốc: 17567
Tên lệnh: dong2
Viết Lisp theo yêu cầu

Xin phép anh Hoành, ssg thêm mấy dòng giải thích cho bạn namng:
1) Biểu thức (entget ent) lấy data của pline
2) Trong đám data đó, cái nào có car bằng 10 là các đỉnh pline. Hàm if lọc bỏ những cái không thoả điều kiện này.
3) (list 11 (cadr x) py) là điểm có cùng hoành độ với điểm đang xét, tung độ là py
4) Entmake tạo 1 line tương ứng với 2 điểm vừa đề cập
5) Lambda là...
>>

Xin phép anh Hoành, ssg thêm mấy dòng giải thích cho bạn namng:
1) Biểu thức (entget ent) lấy data của pline
2) Trong đám data đó, cái nào có car bằng 10 là các đỉnh pline. Hàm if lọc bỏ những cái không thoả điều kiện này.
3) (list 11 (cadr x) py) là điểm có cùng hoành độ với điểm đang xét, tung độ là py
4) Entmake tạo 1 line tương ứng với 2 điểm vừa đề cập
5) Lambda là hàm khuyết danh, với argument x.
6) Mapcar thực hiện lambda lần lượt cho tất cả các thành phần của data. Kết hợp với if, nó chỉ thực hiện với các thành phần chứa toạ độ các đỉnh của pline.
Nếu bạn chưa thoả mãn với các giải thích trên thì có lẽ crazylisp có lý! Bạn nên "luyện công" với các kỹ thuật đơn giản hơn.
Ví dụ như cái này, hy vọng là bạn hiểu được:


Cung cách hoạt động của 2 chương trình trên giống y chang nhau, chỉ khác ở cách viết. Bạn hiểu DONG2 thì có thể hiểu được DONG của anh Hoành.
<<

Filename: 17567_dong2.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 18065
Tên lệnh: ruleline
Viết Lisp theo yêu cầu


Lệnh RuleLine (vì giống lệnh RuleSurf của ACAD) dưới đây sẽ giúp bạn:


Filename: 18065_ruleline.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 22348
Tên lệnh: t2pl
Viết Lisp theo yêu cầu

Đây là mã lisp đã được sửa đổi Y trước X sau:

Filename: 22348_t2pl.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 23188
Tên lệnh: qmx qmy
Viết Lisp theo yêu cầu

lệnh QMX, QMY (quick mirror) dưới đây sẽ giúp bạn:

Filename: 23188_qmx_qmy.lsp
Tác giả: Snowman
Bài viết gốc: 23338
Tên lệnh: qmx qmy
Viết Lisp theo yêu cầu
Có lẽ đoạn code đơn giản quá nên bác Hoành lỡ "quên" mất các chế độ bắt điểm. Xin mạn phép bác Hoành sửa lại đoạn code như sau:


Em thêm vào đoạn code tắt chế độ bắt điểm trước khi thực thi lệnh mirror để tránh gây lỗi. (bác nào thích bắt điểm chính xác lại phải gõ thêm vậy )

Filename: 23338_qmx_qmy.lsp
Tác giả: Snowman
Bài viết gốc: 23339
Tên lệnh: qmx qmy
Viết Lisp theo yêu cầu
Em lại đưa ra một phương án khác tối ưu hơn một chút :mellow:

Sorry vì đã post 2 bài với nội dung ...na ná nhau (em tư duy hơi bị ...chậm, các bác thông cảm nhé!)

Filename: 23339_qmx_qmy.lsp
Tác giả: cuongtk2
Bài viết gốc: 23932
Tên lệnh: catdt
Viết Lisp theo yêu cầu


Bạn dùng code này sẽ cho phép cắt 2 đường LINE

Filename: 23932_catdt.lsp
Tác giả: ssg
Bài viết gốc: 24532
Tên lệnh: slt
Viết Lisp theo yêu cầu

Chương trình như hiện tại của bạn không lỗi khi LTSC = 1, nhưng nó không nhân với "Tỷ lệ phóng" như ý bạn muốn.
Bạn thử với code này xem. Mình đã thử, kết quả đúng trong mọi trường hợp. Còn về tốc độ thì... không biết! Mình đã cố tinh giản code đến mức thấp nhất có thể.
Nói chung, trong các vòng lặp phải xử lý một số lượng lớn đối tượng, các lưu ý sau sẽ làm...
>>

Chương trình như hiện tại của bạn không lỗi khi LTSC = 1, nhưng nó không nhân với "Tỷ lệ phóng" như ý bạn muốn.
Bạn thử với code này xem. Mình đã thử, kết quả đúng trong mọi trường hợp. Còn về tốc độ thì... không biết! Mình đã cố tinh giản code đến mức thấp nhất có thể.
Nói chung, trong các vòng lặp phải xử lý một số lượng lớn đối tượng, các lưu ý sau sẽ làm chương trình chạy nhanh hơn:
- Giảm số lượng biến phải sử dụng
- Giảm số lượng thao tác mà chương trình phải làm trong vòng lặp (cái nào có thể thì nên đưa nó ra ngoài vòng lặp)
- Thay các phép tính phức tạp bằng các phép tính đơn giản hơn
- Nếu có thể, "chơi" luôn cả ss là nhanh nhất. Chỉ xử lý từng entity trong trường hợp bắt buộc.

<<

Filename: 24532_slt.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 5163
Tên lệnh: mtp
move text với dấu chấm thập phân


Lệnh là MTP (move text point).
Chương trình yêu cầu bạn nhập text và point (lẫn lộn). Chương trình sẽ tự động phân loại, những text không có dấu chấm sẽ bị loại bỏ. Với mỗi một text có dấu chấm, chương trình tìm điểm point nào gần với điểm chèn của text nhất để di chuyển dấu chấm đến.


Filename: 5163_mtp.lsp
Tác giả: nataca
Bài viết gốc: 30984
Tên lệnh: das
Viết Lisp theo yêu cầu

Tự động xoá sau 1 giây thì khó nhưng nếu chờ ấn Enter để xoá như thế này thì hoàn toàn làm được. Theo bạn có được không?

Filename: 30984_das.lsp
Tác giả: lonzthjeura
Bài viết gốc: 191528
Tên lệnh: rft
lisp Phun tọa độ các điểm từ file txt vào CAD
Có bác nào giúp em chỉnh sửa lisp của bác Gia_Bach http://www.cadviet.c.../80142_rft2.lsp

;; free lisp from cadviet.com
(defun c:RFT(/ data f h line pt pXY spc str ten val);Read File Txt
;| By : Gia Bach, gia_bach @ www.CadViet.com |;
(vl-load-com)
(defun Split (Str Char / Lst pos)
(while (setq pos (vl-string-search Char Str))
(if (null Lst)
(setq Lst (list (substr Str 1 pos)))
(setq Lst (append Lst (list...
>>
Có bác nào giúp em chỉnh sửa lisp của bác Gia_Bach http://www.cadviet.c.../80142_rft2.lsp

;; free lisp from cadviet.com
(defun c:RFT(/ data f h line pt pXY spc str ten val);Read File Txt
;| By : Gia Bach, gia_bach @ www.CadViet.com |;
(vl-load-com)
(defun Split (Str Char / Lst pos)
(while (setq pos (vl-string-search Char Str))
(if (null Lst)
(setq Lst (list (substr Str 1 pos)))
(setq Lst (append Lst (list (read (substr Str 1 pos))))))
(setq Str (substr Str (+ pos 2)) ))
(setq Lst (append Lst (list (read Str)))))

(if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))
(progn
(or (tblsearch "layer" "Point") (command "-layer" "n" "Point" "") )
(or (tblsearch "layer" "Sothutu") (command "-layer" "n" "Sothutu" "c" 3 "Sothutu" "") )
(or (tblsearch "layer" "Caodo") (command "-layer" "n" "Caodo" "c" 4 "Caodo" "") )
(setq spc (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-Acad-Object))))
(setq h 2);(* (getvar "dimtxt")(getvar "dimscale")))
(setq f (open (findfile ten) "r"))
(while (setq Line (read-line f))
(if (vl-string-search "\t" Line)
(progn
(setq data (split Line "\t" )
val (car data)
pt (cdr data))
(if (not(vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point pt)))
(progn
(setq pXY (list (car pt)(cadr pt)))
(vla-put-Layer (vla-addpoint spc (vlax-3d-point pXY)) "Point")
(vla-put-Layer (setq str (vla-addtext spc val (vlax-3d-point pXY) h)) "Sothutu")
(vla-put-Alignment str 8)
(vla-put-TextAlignmentPoint str (vlax-3d-point pXY))
(vla-put-Layer (vla-addtext spc (caddr pt) (vlax-3d-point pXY) h) "Caodo") ))))) ))
(princ))

với yêu cầu:
- File text dạng : SST,Y,X,Z,Code
- Độ cao Z có dấu chấm ở hàng thập phân nằm đúng vào vị trí tọa độ (X,Y) của điểm đó .
Em xin cảm ơn trước.
<<

Filename: 191528_rft.lsp

Trang 78/330

78