| Info | File |
Tác giả: phamthanhbinh
Bài viết gốc: 228296
Tên lệnh: lent |
Cho hỏi về lệnh kéo nhiều đường thẳng không bằng nhau thành bằng nhau
Chào các bạn.Mình xin hỏi một tí về lệnh mà có thể dùng để kéo cùng một lúc nhiều đoạn thẳng có kích thước không bằng nhau thành bằng nhau tại một điểm bất kì(chứ không phải đường thẳng lầm biên giống như lệnh Ex) trên màn hình mà mình chọn.Chỉ một lệnh duy nhất và không phải lệnh S và Ex .Cảm...
>>
Chào các bạn.Mình xin hỏi một tí về lệnh mà có thể dùng để kéo cùng một lúc nhiều đoạn thẳng có kích thước không bằng nhau thành bằng nhau tại một điểm bất kì(chứ không phải đường thẳng lầm biên giống như lệnh Ex) trên màn hình mà mình chọn.Chỉ một lệnh duy nhất và không phải lệnh S và Ex .Cảm ơn nhé các bạn.
Hề hề hề,
Dùng lệnh lengthen của CAD coi sao nhé.
Nếu thich lisp cho oai thì nó đây nè:
<<
|
|
Filename: 228296_lent.lsp
|
|
Tác giả: duy782006
Bài viết gốc: 3791
Tên lệnh: nd |
Viết Lisp theo yêu cầu
Mình có cái này hồi xưa thấy trong CD bán ngoài thị trường chẳng biết của ai viết nhưng đúng ý của bạn nè.
Tên lệnh là ND
Chọn chử muốn chỉnh trước rồi chọn chử làm mẫu sau. Chúc vui !!!!!!
|
Tác giả: KangKung
Bài viết gốc: 229897
Tên lệnh: lg12 lg13 |
Offset, chuyện cũ với yêu cầu mới
Mình lại có việc làm phiền mọi người đây.
Mình làm quy hoạch, thường xuyên phải vẽ các tuyến đường 12m, 13m, 16m,.... nên nhờ mọi người viết 1 lisp về lệnh Offset để làm việc này.
Yêu cầu cụ thể như sau:
Từ 1 đường line (or pline, arc, spline) là tim đường ta gõ lệnh LG12, Cad sẽ tự động...
>>
Mình lại có việc làm phiền mọi người đây.
Mình làm quy hoạch, thường xuyên phải vẽ các tuyến đường 12m, 13m, 16m,.... nên nhờ mọi người viết 1 lisp về lệnh Offset để làm việc này.
Yêu cầu cụ thể như sau:
Từ 1 đường line (or pline, arc, spline) là tim đường ta gõ lệnh LG12, Cad sẽ tự động làm các việc như sau:
* Từ tim offset qua 2 bên, khoảng cách mỗi bên là 3 và chuyển 2 đường mới tạo ra này vào layer "00_Mep duong" sẵn có, nếu chưa có thì tạo mới layer này.
* Từ tim offset qua 2 bên, khoảng cách mỗi bên là 6 và chuyển 2 đường mới tạo ra này vào layer "00_Mep he" sẵn có, nếu chưa có thì tạo mới layer này.
Tương tự,
Từ 1 đường line (or pline) là tim đường ta gõ lệnh LG13, Cad sẽ tự động làm các việc như sau:
* Từ tim offset qua 2 bên, khoảng cách mỗi bên là 3,5 và chuyển 2 đường mới tạo ra này vào layer "00_Mep duong" sẵn có, nếu chưa có thì tạo mới layer này.
* Từ tim offset qua 2 bên, khoảng cách mỗi bên là 6,5 và chuyển 2 đường mới tạo ra này vào layer "00_Mep he" sẵn có, nếu chưa có thì tạo mới layer này.
....
Mời ae xem file đính kèm sẽ rõ hơn.
http://www.cadviet.com/upfiles/3/31951_offset_duong.dwg
Cái này rất hữu ích cho dân quy hoạch nên mong ae giúp dùm mình!
Thanks tất cả ae diễn đàn Cadviet!
Lisp của bác đây:
;========LISP OFFSET==========
;====KANGKUNG 28/03/2013======
(defun C:LG12()
(command "UNDO" "BE")
(setq os(getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq dt (car(entsel)) i (/ pi 2))
(repeat 2
(setq pt (polar (vlax-curve-getPointAtDist dt 0) (+ (angle (vlax-curve-getPointAtDist dt 0) (vlax-curve-getPointAtDist dt (+ 0 0.1))) i) 1))
(of "3" pt "00_Mep duong")
(of "6" pt "00_Mep he")
(setq i (/ pi -2))
)
(setvar "OSMODE" os)
(command "UNDO" "END")
)
(defun C:LG13()
(command "UNDO" "BE")
(setq os(getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq dt (car(entsel)) i (/ pi 2))
(repeat 2
(setq pt (polar (vlax-curve-getPointAtDist dt 0) (+ (angle (vlax-curve-getPointAtDist dt 0) (vlax-curve-getPointAtDist dt (+ 0 0.1))) i) 1))
(of "3.5" pt "00_Mep duong")
(of "6.5" pt "00_Mep he")
(setq i (/ pi -2))
)
(setvar "OSMODE" os)
(command "UNDO" "END")
)
(defun of(di pt la)
(command "offset" di dt pt "")
(if (= (tblsearch "Layer" la) nil)
(progn
(command "LAYER" "N" la "")
(vla-put-layer (vlax-ename->vla-object (entlast)) la))
(vla-put-layer (vlax-ename->vla-object (entlast)) la)))
(princ "\n Written By KangKung - 28/03/2013\n")
<<
|
|
Filename: 229897_lg12_lg13.lsp
|
|
Tác giả: phamthanhbinh
Bài viết gốc: 81839
Tên lệnh: mmn |
Viết lisp theo yêu cầu [phần 2]
Chào bạn tieu_ngu_nhi_43,
Theo cái yêu cầu của bạn thì thực ra không nhất thiết phải dùng lisp đâu. Tuy nhiên nếu bạn vẫn thấy thích dùng lisp thì nó đây:
|
Tác giả: KangKung
Bài viết gốc: 229914
Tên lệnh: kk |
Nhờ viết lisp lọc các đối tượng là text trong một vùng kín xuất ra Excel
Nhờ các bác viết hộ em lisp lọc các đối tượng là text trong một vùng kín (pline kín) sau đó xuất ra excel. Em cảm ơn các bác.
Lisp của bạn đây. Vùng kín hay hở đều chơi hết.File xuất ra gồm có STT X Y và nội dung Text
;========LISP OUTPUT TEXT BEN TRONG...
>> Nhờ các bác viết hộ em lisp lọc các đối tượng là text trong một vùng kín (pline kín) sau đó xuất ra excel. Em cảm ơn các bác.
Lisp của bạn đây. Vùng kín hay hở đều chơi hết.File xuất ra gồm có STT X Y và nội dung Text
;========LISP OUTPUT TEXT BEN TRONG PLINE==========
;=============KANGKUNG 28/03/2013==================
(defun C:KK()
(setq plst (acet-geom-vertex-list (car (entsel "\n Select pline:\n"))))
(setq plst1 (vl-sort plst '(lambda (e1 e2) (if (/= (car e1) (car e2)) (< (car e1) (car e2)) (< (cadr e1) (cadr e2))))))
(setq X_min(car (nth 0 plst1))
X_max(car (last plst1)))
(setq plst2 (vl-sort plst '(lambda (e1 e2) (if (/= (cadr e1) (cadr e2)) (< (cadr e1) (cadr e2)) (< (car e1) (car e2))))))
(setq Y_min(cadr (nth 0 plst2))
Y_max(cadr (last plst2)))
(command "ZOOM" (list X_min Y_min) (list X_max Y_max))
(setq taphop (ssget "CP" plst '((0 . "TEXT"))))
(if (not Path) (setq Path(getvar "dwgprefix")))
(setq file(getfiled "Output File" Path "csv" 11) Path file)
(setq file_out(open file "W"))
(setq index 0)
(while (< index (sslength taphop))
(setq TEXT (entget (ssname taphop index)))
(if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0)
(setq InsertPoint(cdr(assoc 10 TEXT)))
(setq InsertPoint(cdr(assoc 11 TEXT))))
(setq String(cdr(assoc 1 TEXT)))
(write-line (strcat (rtos (+ index 1) 2 0) "," (rtos (car InsertPoint) 2 3) "," (rtos (cadr InsertPoint) 2 3) "," String) file_out)
(setq index (+ index 1))
)
(close file_out)
(alert "Well done!")
)
(princ "\n Written By KangKung - 28/03/2013\n")
(princ "\n Nhap KK de chay chuong trinh\n")
<< |
Tác giả: KangKung
Bài viết gốc: 229945
Tên lệnh: sl |
Xin Lisp chọn nhanh đối tượng cùng layer
Lisp đây bác ơi
(defun C:SL()
(setq lay(cdr (assoc 8 (entget (car (entsel "\n Chon doi tuong mau:\n"))))))
(setq taphop(ssget (list (cons 8 lay))))
(sssetfirst nil taphop))
|
Tác giả: KangKung
Bài viết gốc: 229956
Tên lệnh: kk |
[yêu cầu] lisp xoay block theo hướng pline cho trước
Tặng bạn cái Lisp như yêu cầu
;========LISP XOAY BLOCK THEO HUONG TUYEN==========
;=============KANGKUNG 28/03/2013==================
(defun C:KK()
(command "UNDO" "BE")
(setq tuyen nil)
(while (= (setq tuyen (car (entsel "\n Chon tuyen:\n"))) nil))
(setq taphop(ssget '((0 . "INSERT"))))
(setq index 0)
(while (< index (sslength taphop))
(setq block(entget (ssname taphop index)))
(setq insertpoint(cdr (assoc 10...
>> Tặng bạn cái Lisp như yêu cầu
;========LISP XOAY BLOCK THEO HUONG TUYEN==========
;=============KANGKUNG 28/03/2013==================
(defun C:KK()
(command "UNDO" "BE")
(setq tuyen nil)
(while (= (setq tuyen (car (entsel "\n Chon tuyen:\n"))) nil))
(setq taphop(ssget '((0 . "INSERT"))))
(setq index 0)
(while (< index (sslength taphop))
(setq block(entget (ssname taphop index)))
(setq insertpoint(cdr (assoc 10 block)))
(if (= (vlax-curve-getDistAtPoint tuyen (vlax-curve-getClosestPointTo tuyen insertpoint)) (vla-get-length (vlax-ename->vla-object tuyen)))
(entmod (subst (cons 50 (+ pi (angle (vlax-curve-getClosestPointTo tuyen insertpoint) ( vlax-curve-getPointAtDist tuyen (+ (vlax-curve-getDistAtPoint tuyen (vlax-curve-getClosestPointTo tuyen insertpoint)) -0.001))))) (assoc 50 block) block))
(entmod (subst (cons 50 (+ pi (angle ( vlax-curve-getPointAtDist tuyen (+ (vlax-curve-getDistAtPoint tuyen (vlax-curve-getClosestPointTo tuyen insertpoint)) 0.001)) (vlax-curve-getClosestPointTo tuyen insertpoint)))) (assoc 50 block) block))
)
(setq index (+ index 1)))
(command "UNDO" "END")
)
(princ "\n Written By KangKung - 28/03/2013\n")
(princ "\n Nhap KK de chay chuong trinh\n")
<< |
Tác giả: Tue_NV
Bài viết gốc: 110155
Tên lệnh: l2f | |
Tác giả: nguyentuyen6
Bài viết gốc: 116699
Tên lệnh: hcn hv ht | |
Tác giả: phamthanhbinh
Bài viết gốc: 228436
Tên lệnh: edo |
sửa giúp Lisp thay đổi Text override của Dimension
Lệnh Find&Replace chỉ áp dụng cho Text trong Override còn Override có định dạng thì ko thay được. Nếu được các bạn thử làm xem http://www.cadviet.com/upfiles/3/116734_drawing6.dwg.
Mình cần sửa tất cả các ký tự Φ nét đậm thành các ký tự Φ nét mảnh
Cám ơn nhiều, nếu nhận được sự giúp đỡ của các bạn!
Hề hề hề,
Cái ni chửa biết có đúng ý bạn không. Tuy nhiên test với bản vẽ bạn gửi thì nó OK.
Bạn khỏi cần cám ơn nếu như nó làm bạn không vui.
(defun c:edo ( / ssd els txt n )
(vl-load-com)
(command "undo" "be")
(setq ssd (acet-ss-to-list (ssget "x" (list (cons 0 "dimension")))))
(foreach dm ssd
(setq els (entget dm)
txt (cdr (assoc 1 els))
n (strlen txt)
)
(if (and (> n 4)
(= (substr txt 1 (- n 4))
"{\\fAIGDT|b0|i0;\\H17.5000;\\ln\\f\\M+1826C\\M+18272 \\M+18353\\M+18356\\M+18362\\M+1834E|b0|i0;\\H17.5000;}")
)
(entmod (subst (cons 1 (strcat "%%c" (substr txt (- n 3)))) (assoc 1 els) els))
)
)
(command "undo" "e" )
(princ)
)
Chúc bạn vui. << |
Tác giả: phamthanhbinh
Bài viết gốc: 228190
Tên lệnh: vh |
Các cao thủ giúp em. (Nhập dữ liệu từ excel, vẽ hình bên cad)
Xin các cao thủ giúp em với.
Em đang pha cắt vật tư là thép tấm cho dự án. Mà vẽ từng hình bên cad thì rất lâu (mỗi hình 1 file)..
Nay em muốn nhập thông số : tên tấm mã, kích thước dài và rộng.
Ví dụ : Bên excel em nhập thông số sau.
P1 200 300
P2 400 500
P3 200 300
{P1...
>>
Xin các cao thủ giúp em với.
Em đang pha cắt vật tư là thép tấm cho dự án. Mà vẽ từng hình bên cad thì rất lâu (mỗi hình 1 file)..
Nay em muốn nhập thông số : tên tấm mã, kích thước dài và rộng.
Ví dụ : Bên excel em nhập thông số sau.
P1 200 300
P2 400 500
P3 200 300
{P1 là tên tấm mã. 200 300 là kích thước bao}
Sau đó khi xuất qua cad thì có file P1.dxf hoặc P1.dwg có hình chữ nhật kích thước 200x300 (không cần ghi kích thước); tương tự vậy xuất ra file P2.dxf và P3.dxf
Rất mong các cao thủ quan tâm.
Hề hề hề,
Bạn dùng thử cái này coi sao với lưu ý sau:
1/- File dữ liệu excel bạn chuyển về file *.txt
2/- Các file được tạo thành thực chất là các block file lưu tại thư mục mặc định của CAD khi lưu file. Nếu muốn bạn có thể chỉ định thư mục để lisp lưu file vào đó.
3/- Trong trường hợp bạn muôn sử dụng với file excel thì bạn phải chuyển file này về file *.csv và thay đổi một chút trong code như sau:
+ Tại dòng code :(setq fn (getfiled "Select Data File" "" "txt" 0) thay csv vào vị trí txt
+ Tại dòng code: (setq txl (separate str "\t")) thay "," vào vị trí "\t"
4/- Nếu vẫn muốn giữ nguyên file excel gốc thì vấn đề sẽ phức tạp hơn, code sẽ rắc rốii hơn nhiều và công dụng cũng chả khác là bao nên bạn hãy sử dụng tạm một trong hai phương án trên cho nó đỡ nhức đầu. Khi nào rảnh rỗi mình sẽ viết cho excel sau.
http://www.cadviet.com/upfiles/3/5194_vehinhfromexl.lsp
Chúc bạn vui.
<<
|
Tác giả: HoangSon614
Bài viết gốc: 67609
Tên lệnh: stext |
Viết Lisp theo yêu cầu
Bạn lưu file daucat.dwg này vào trong ổ C: của bạn thì nó mới chạy nhé :
file đây : http://www.cadviet.com/upfiles/daucat.dwg
Và chạy file Lisp này nữa :
Làm phiền bạn tý nha. Cảm ơn bạn nhiều
|
|
Filename: 67609_stext.lsp
|
|
Tác giả: HoangSon614
Bài viết gốc: 68872
Tên lệnh: dstt |
Viết Lisp theo yêu cầu
Còn nếu bạn muốn thì Tue_NV sẽ thêm vào Code cho bạn
:cheers:
Tue_NV giúp mình tý nha.
Mình nhờ bạn viết thêm vào lisp trên cho mình như sau:
1. gán giá trị text là Vni-helve, cao chữ 2.5
2. Vẫn lisp đó nhưng mình muốn thêm vào nội dung ký hiệu bản vẽ trước khi lisp hỏi đánh số bắt đầu và đánh số tổng (cái này mình dùng để đánh ký hiệu bản vẽ), cụ thể... >> Còn nếu bạn muốn thì Tue_NV sẽ thêm vào Code cho bạn
:cheers:
Tue_NV giúp mình tý nha.
Mình nhờ bạn viết thêm vào lisp trên cho mình như sau:
1. gán giá trị text là Vni-helve, cao chữ 2.5
2. Vẫn lisp đó nhưng mình muốn thêm vào nội dung ký hiệu bản vẽ trước khi lisp hỏi đánh số bắt đầu và đánh số tổng (cái này mình dùng để đánh ký hiệu bản vẽ), cụ thể như:
Khi thực hiện lệnh:
dstt -> nhập ký hiệu bản vẽ (VD - KC hoặc KT...) -> đánh số bắt đầu -> đánh số tổng -> OK (VD: KC: 01/3...KC: 03/3; KT: 01/3....KT:03/3)
gán giá trị text là Vni-helve, cao chữ 2.5
Nghe bạn nói dạo này bạn rất bận, khi nào rãnh cố gắng xem giúp mình. Cảm ơn bạn nhiều, mình chờ tin bạn << |
Tác giả: ketxu
Bài viết gốc: 172610
Tên lệnh: test+nil | |
Tác giả: KangKung
Bài viết gốc: 230193
Tên lệnh: kk |
lisp vẽ đường thẳng trên 2 layer trên bản vẽ
Lisp của bạn đây
;========LISP VE DUONG THANG TREN 2 LAYER==========
;=============KANGKUNG 30/03/2013==================
(defun C:KK()
(command "PLINE")
(while (> (getvar 'cmdactive) 0) (command pause))
(KK))
(defun *error* (msg) (KK))
(defun kk()
(vla-put-layer (vlax-ename->vla-object (entlast)) "duong")
(vla-put-color (vlax-ename->vla-object (entlast)) "3")
(command "COPY" (entlast) "" "0,0" "0,0")
(vla-put-layer...
>> Lisp của bạn đây
;========LISP VE DUONG THANG TREN 2 LAYER==========
;=============KANGKUNG 30/03/2013==================
(defun C:KK()
(command "PLINE")
(while (> (getvar 'cmdactive) 0) (command pause))
(KK))
(defun *error* (msg) (KK))
(defun kk()
(vla-put-layer (vlax-ename->vla-object (entlast)) "duong")
(vla-put-color (vlax-ename->vla-object (entlast)) "3")
(command "COPY" (entlast) "" "0,0" "0,0")
(vla-put-layer (vlax-ename->vla-object (entlast)) "muong"))
(princ "\n Written By KangKung - 30/03/2013\n")
(princ "\n Nhap KK de chay chuong trinh\n")
<< |
Tác giả: phamthanhbinh
Bài viết gốc: 230230
Tên lệnh: xpt |
Nhờ viết lisp lọc các đối tượng là text trong một vùng kín xuất ra Excel
Cám ơn bạn KangKung về Lisp trên,
Mính có một file tọa độ điểm gồm : lớp điểm ( dạng point ) là tọa độ x,y ; lớp Số thứ tụ điểm, lớp cao độ , lớp code dạng ghi chú về điểm đó ( dạng text),
Xin nhờ Bạn giúp mình Lisp xuất : điểm point , text ra excel theo từng điểm...
>>
Cám ơn bạn KangKung về Lisp trên,
Mính có một file tọa độ điểm gồm : lớp điểm ( dạng point ) là tọa độ x,y ; lớp Số thứ tụ điểm, lớp cao độ , lớp code dạng ghi chú về điểm đó ( dạng text),
Xin nhờ Bạn giúp mình Lisp xuất : điểm point , text ra excel theo từng điểm theo hàng như sau : Số thứ tụ điểm đó - tọa độ X - tọa độ Y - Ghi chú. ( X,Y theo điểm point ).
File gởi kèm
http://www.cadviet.com/upfiles/3/114381_xuat_ra_excel.dwg
Cám ơn
Hề hề hề,
Mình đã xem bản vẽ của bạn và có một vài ý kiến như sau:
1/- Một cụm point của bạn gồm có 4 đối tượng là; 1 text trên lớp "Dh_Caodo", 1 point trên lớp "Dh_Point", 1 text trên lớp "Dh_stt" và 1 text trên lớp "Dh_Code". Vì sao bạn không nhóm cả 4 đối tượng này vào một block thuộc tính để dễ dàng truy xuất nó mà để rời rạc như vậy. Điều này gây khó khăn cho việc chọn đối tượng cần truy xuất do khá nhiều điểm của bạn nằm liền kề nhau và có chung các thuộc tính chọn lựa.
2/- Với 4 đối tượng trong nhóm nhưng bạn chỉ cần truy xuất hai đối tượng là text trên lớp "Dh_stt" và point tên lớp "Dh_Point" thôi ư?? Các đối tượng khác có cần quan tâm không?? Nếu có thì nhét chúng vào đâu???
3/- Việc viết lisp này tuy không quá khó, nhưng trên diễn đàn cũng có khá nhiều lisp tương tự với yêu cầu của bạn rồi, sao bạn không thử tìm kiếm và lấy về dùng thử. Nếu có lisp nào bạn thấy gần phù hợp nhất với yêu cầu của bạn thì post lên để mọi người chỉnh giúp chỉnh sửa cho phù hợp, như vậy sẽ nhanh hơn nhiều là việc làm mới bạn ạ. Bạn cũng nên thông cảm với các lisper trên diễn đàn vì thời gian và sự kiên nhẫn hạn chế bạn ạ.
Hề hề hề,...
Và đây là lisp theo yêu cầu của bạn:
(defun c:xpt ( / oldos fn f ssc p1 p2 txt )
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(setq fn (getfiled "Select Data File" "" "csv" 0)
f (open fn "w")
ssc (acet-ss-to-list (ssget "w" (setq p1 (getpoint "\n Chon diem goc tren ben trai vung chon"))
(setq p2 (getpoint p1 "\n Chon diem goc duoi ben phai vung chon"))
(list (cons 0 "point") (cons 8 "Dh_Point"))))
txt "" )
(foreach po ssc
(setq txt (strcat (cdr (assoc 1 (entget (car (acet-ss-to-list (ssget "w" p1 p2
(list (cons 0 "text") (cons 11 (cdr (assoc 10 (entget po)))) (cons 8 "Dh_stt"))))))))
(chr 44) (rtos (cadr (assoc 10 (entget po))) 2 2)
(chr 44) (rtos (caddr (assoc 10 (entget po))) 2 2)))
(write-line txt f)
)
(close f)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)
Chúc bạn vui
Khuyến mãi cho bạn một lisp khác đơn giản hơn với cách dùng như cụ:
(defun c:xpt1 ( / oldos fn f ssc p1 p2 txt )
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(setq fn (getfiled "Select Data File" "" "csv" 0)
f (open fn "w")
ssc (acet-ss-to-list (ssget "w" (setq p1 (getpoint "\n Chon diem goc tren ben trai vung chon"))
(setq p2 (getpoint p1 "\n Chon diem goc duoi ben phai vung chon"))
(list (cons 0 "text") (cons 8 "Dh_stt"))))
txt "" )
(write-line "STT diem , Toa do X , Toa do Y , Ghi chu" f)
(foreach tex ssc
(setq txt (strcat (cdr (assoc 1 (entget tex))) (chr 44) (rtos (cadr (assoc 11 (entget tex))) 2 2)
(chr 44) (rtos (caddr (assoc 11 (entget tex))) 2 2)) )
(write-line txt f)
)
(close f)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)
<< |
Tác giả: KangKung
Bài viết gốc: 230420
Tên lệnh: kk |
Xuất điểm theo Block thuộc tính qui định bởi tên
Lisp của bạn đây. Trước khi chạy thì copy 4 file trong file zip dưới đây vào thư mục Support của CAD nhé
http://www.cadviet.com/upfiles/3/71162_block_attribute.zip
;========LISP DUA DIEM KHONG CHE VAO CAD THEO CODE=========
;================KANGKUNG 01/04/2013=======================
(defun C:KK()
(command "UNDO" "BE")
(setq os(getvar...
>> Lisp của bạn đây. Trước khi chạy thì copy 4 file trong file zip dưới đây vào thư mục Support của CAD nhé
http://www.cadviet.com/upfiles/3/71162_block_attribute.zip
;========LISP DUA DIEM KHONG CHE VAO CAD THEO CODE=========
;================KANGKUNG 01/04/2013=======================
(defun C:KK()
(command "UNDO" "BE")
(setq os(getvar "OSMODE"))
(setvar "OSMODE" 0)
(if (not Path) (setq Path(getvar "dwgprefix")))
(setq file(getfiled "Select File:" Path "txt" 2) Path file file_in(open file "R"))
(while(setq txt(read-line file_in))
(if (/= txt nil)
(progn
(setq lst (read (strcat "(" txt ")" )))
(setq Code(substr txt 1 (- (vl-string-search (rtos (fix (nth (- (length lst) 3) lst)) 2 0) txt) 1)))
(cond ((= (strcase(substr Code 1 2)) "TM") (in "TM"))
((= (strcase(substr Code 1 3)) "GPS") (in "GPS"))
((= (strcase(substr Code 1 3)) "DCI") (in "DCI"))
((= (strcase(substr Code 1 4)) "DCII") (in "DCII"))
))))
(close file_in)
(setvar "OSMODE" os)
(command "UNDO" "END")
)
(defun in(ten)
(command "INSERT" ten (list (nth (- (length lst) 2) lst) (nth (- (length lst) 3) lst) (nth (- (length lst) 1) lst)) "1" "1" "0" Code (rtos (nth (- (length lst) 1) lst) 2 3)))
(princ "\n Written By KangKung - 01/04/2013\n")
(princ "\n Nhap KK de chay chuong trinh\n")
<< |
Tác giả: duy782006
Bài viết gốc: 2736
Tên lệnh: tht | |
Tác giả: ketxu
Bài viết gốc: 230470
Tên lệnh: test+nil |
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)
;;------------------=={ UCS Aligned ssget }==-----------------;;
;; ;;
;; Provides the user with a selection interface akin to ;;
;; those options provided by ssget, but aligned to the ;;
;; active UCS ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ...
>>
;;------------------=={ UCS Aligned ssget }==-----------------;;
;; ;;
;; Provides the user with a selection interface akin to ;;
;; those options provided by ssget, but aligned to the ;;
;; active UCS ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; msg - prompt to be displayed ;;
;; filter - optional SelectionSet filter ;;
;;------------------------------------------------------------;;
;; Returns: SelectionSet, else nil ;;
;;------------------------------------------------------------;;
(defun LM:UCS-ssget
(
msg filter /
*error* _redrawss _getitem _getwindowselection
acgrp e express g1 g2 gr grp i mss multiplemode pick pt removemode singlemode ss str
)
(defun *error* ( msg )
(_redrawss ss 4)
(if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(defun _redrawss ( ss mode / i )
(if ss
(repeat (setq i (sslength ss))
(redraw (ssname ss (setq i (1- i))) mode)
)
)
)
(defun _getitem ( collection item )
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply 'vla-item (list collection item))
)
)
)
item
)
)
(defun _getwindowselection ( msg p1 filter flag / gr p2 p3 p4 lst )
(princ msg)
(while (not (= 3 (car (setq gr (grread t 13 0)))))
(cond
( (= 5 (car gr))
(redraw)
(setq p3 (cadr gr)
p2 (list (car p3) (cadr p1) (caddr p3))
p4 (list (car p1) (cadr p3) (caddr p3))
)
(grvecs
(setq lst
(list
(cond
( (eq "_C" flag) -256)
( (eq "_W" flag) 256)
( (minusp (- (car p3) (car p1))) -256)
( 256 )
)
p1 p2 p1 p4 p2 p3 p3 p4
)
)
)
t
)
( (princ (strcat "\nInvalid Window Specification." msg)) )
)
)
(redraw)
(ssget (cond ( flag ) ( (if (minusp (car lst)) "_C" "_W") )) p1 p3 filter)
)
(setq express
(and (vl-position "acetutil.arx" (arx))
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function (lambda nil (acet-sys-shift-down)))
)
)
)
)
)
(setq acdoc (cond ( acdoc ) ( (vla-get-activedocument (vlax-get-acad-object)) ))
acgrp (vla-get-groups acdoc)
)
(if
(not
(and
(= 1 (getvar 'PICKFIRST))
(setq ss (cadr (ssgetfirst)))
)
)
(setq ss (ssadd))
)
(setq str "")
(sssetfirst nil nil)
(princ msg)
(while
(progn
(setq gr (grread t 13 2)
g1 (car gr)
g2 (cadr gr)
)
(_redrawss ss 3)
(cond
( (= 5 g1) )
( (= 3 g1)
(cond
( RemoveMode
(if
(and
(setq pick (ssget g2 filter))
(setq pick (ssname pick 0))
)
(if (ssmemb pick ss)
(progn (ssdel pick ss) (redraw pick 4))
)
(if (setq pick (_getwindowselection "\nSpecify Opposite Corner: " g2 filter nil))
(repeat (setq i (sslength pick))
(if (ssmemb (setq e (ssname pick (setq i (1- i)))) ss)
(progn (ssdel e ss) (redraw e 4))
)
)
)
)
(princ msg)
)
( MultipleMode
(if
(and
(setq pick (ssget g2 filter))
(setq pick (ssname pick 0))
)
(ssadd pick mss)
)
t
)
( t
(if
(and
(setq pick (ssget g2 filter))
(setq pick (ssname pick 0))
)
(if (and express (acet-sys-shift-down))
(if (ssmemb pick ss)
(progn (ssdel pick ss) (redraw pick 4))
)
(ssadd pick ss)
)
(if (setq pick (_getwindowselection "\nSpecify Opposite Corner: " g2 filter nil))
(if (and express (acet-sys-shift-down))
(repeat (setq i (sslength pick))
(if (ssmemb (setq e (ssname pick (setq i (1- i)))) ss)
(progn (ssdel e ss) (redraw e 4))
)
)
(repeat (setq i (sslength pick))
(ssadd (ssname pick (setq i (1- i))) ss)
)
)
)
)
(princ msg)
(not SingleMode)
)
)
)
( (= 2 g1)
(cond
( (member g2 '(32 13))
(cond
( (zerop (strlen str))
nil
)
( t
(if mss
(progn
(repeat (setq i (sslength mss))
(ssadd (ssname mss (setq i (1- i))) ss)
)
(setq mss nil)
)
)
(cond
( (wcmatch (setq str (strcase str)) "R,REMOVE")
(setq
MultipleMode nil
SingleMode nil
RemoveMode T
)
)
( (wcmatch str "M,MULTIPLE")
(setq
RemoveMode nil
SingleMode nil
MultipleMode T
mss (ssadd)
)
)
( (wcmatch str "A,ADD,AUTO")
(setq
MultipleMode nil
RemoveMode nil
SingleMode nil
)
t
)
( (wcmatch str "SI,SINGLE")
(setq
MultipleMode nil
RemoveMode nil
SingleMode T
)
)
( (wcmatch str "G,GROUP")
(while
(progn (setq grp (getstring t "\nEnter group name: "))
(cond
( (eq "" grp)
nil
)
( (setq grp (_getitem acgrp grp))
(vlax-for obj grp
(if (not (ssmemb (setq e (vlax-vla-object->ename obj)) ss))
(ssadd e ss)
)
)
nil
)
( (princ "\nInvalid group name.") )
)
)
)
t
)
( (or
(eq str "ALL")
(wcmatch str "P,PREVIOUS")
(wcmatch str "L,LAST")
)
(princ
(strcat "\n"
(if
(setq pick
(ssget
(cond
( (eq str "ALL") "_X")
( (wcmatch str "P,PREVIOUS") "_P")
( (wcmatch str "L,LAST") "_L")
)
filter
)
)
(progn
(repeat (setq i (sslength pick))
(ssadd (ssname pick (setq i (1- i))) ss)
)
(itoa (sslength pick))
)
"0"
)
" found"
)
)
t
)
( (or
(eq str "BOX")
(wcmatch str "W,WINDOW")
(wcmatch str "C,CROSSING")
)
(princ
(strcat "\n"
(if
(and
(setq pt (getpoint "\nSpecify first corner: "))
(setq pick
(_getwindowselection "\nSpecify opposite corner: " pt filter
(cond
( (eq str "BOX") nil)
( (wcmatch str "W,WINDOW") "_W")
( (wcmatch str "C,CROSSING") "_C")
)
)
)
)
(progn
(repeat (setq i (sslength pick))
(ssadd (ssname pick (setq i (1- i))) ss)
)
(itoa (sslength pick))
)
"0"
)
" found"
)
)
t
)
( (wcmatch str "U,UNDO")
(if pick
(cond
( (eq 'ENAME (type pick))
(ssdel pick ss)
(redraw pick 4)
)
( (eq 'PICKSET (type pick))
(repeat (setq i (sslength pick))
(setq e (ssname pick (setq i (1- i))))
(ssdel e ss)
(redraw e 4)
)
)
)
)
t
)
( (eq "?" str)
(princ
(strcat
"\nExpects a point or"
"\nWindow/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon"
"/Group/Add/Remove/Multiple/Previous/Undo/AUto/SIngle"
)
)
)
( (princ "\n** Invalid Keyword **") )
)
(setq str "")
(princ msg)
)
)
)
( (< 32 g2 127)
(setq str (strcat str (princ (chr g2))))
)
( (= g2 8)
(if (< 0 (strlen str))
(progn
(princ (vl-list->string '(8 32 8)))
(setq str (substr str 1 (1- (strlen str))))
)
)
t
)
( t )
)
)
)
)
)
(_redrawss ss 4)
ss
)
;; Test function
(defun c:test nil
(sssetfirst nil (LM:UCS-ssget "\nSelect Objects: " nil))
(princ)
)
- Cần thêm Opt gì bạn tiếp tục ^^
<<
|
|
Filename: 230470_test+nil.lsp
|
|
Tác giả: jikibo
Bài viết gốc: 433
Tên lệnh: w2 |
Ứng dụng LISP để vẽ bản vẽ kiến trúc (phần cơ bản)
Nhanh quá! Cái lisp NN kia giúp tôi đỡ được bao nhiêu công khi phải BO line thanh PLINE.
Giờ đến vễ cửa, cửa đi, cửa sổ... nhiều quá. Copy từ thư viện ra thì lại phải SCALE rồi làng nhằng LAYER không đúng với bản vẽ của mình ! Vậy thì co cách nào không nhỉ?
Bài 5: Vẽ cửa đi
Có 2 lệnh trong lisp này.
w1: vẽ cửa sổ kiểu 1
w2: vẽ cửa sổ... >> Nhanh quá! Cái lisp NN kia giúp tôi đỡ được bao nhiêu công khi phải BO line thanh PLINE.
Giờ đến vễ cửa, cửa đi, cửa sổ... nhiều quá. Copy từ thư viện ra thì lại phải SCALE rồi làng nhằng LAYER không đúng với bản vẽ của mình ! Vậy thì co cách nào không nhỉ?
Bài 5: Vẽ cửa đi
Có 2 lệnh trong lisp này.
w1: vẽ cửa sổ kiểu 1
w2: vẽ cửa sổ kiểu 2 << |
