| Info | File |
Tác giả: dragontalon0802
Bài viết gốc: 187442
Tên lệnh: h2 |
Lisp hatch nhanh.
(defun c:h2 () (command "_layer" "Set" "--5-DUYTUAN-HATCH" "")
(setvar "cmdecho" 0)
(initget "P S")
(setq ansp (getkword "\n Chon kieu pick diem hay chon doi tuong < P/S > :"))
(setq p nil dt t)
;(WHILE (or (not p) (not dt))
(progn
(setq ten "SOLID" )
(if (= ansp "P")
(progn
(while (setq p (getpoint "\n Chon 1 diem trong vung... >>
(defun c:h2 () (command "_layer" "Set" "--5-DUYTUAN-HATCH" "")
(setvar "cmdecho" 0)
(initget "P S")
(setq ansp (getkword "\n Chon kieu pick diem hay chon doi tuong < P/S > :"))
(setq p nil dt t)
;(WHILE (or (not p) (not dt))
(progn
(setq ten "SOLID" )
(if (= ansp "P")
(progn
(while (setq p (getpoint "\n Chon 1 diem trong vung can hatch :"))
(lh1 p ten sc ang)
)
)
(progn
(princ "\n Chon doi tuong can hatch :")
(while (setq dt (ssget) )
(lh dt ten sc ang)
)
)
)
)
 ;WHILE
(princ)
)
;;;;;;;;
(defun lh1(p name tle goc)
(setvar "hpgaptol" 50.0)
(vl-cmdf "bhatch" "P" name tle goc p "")
)
;;;;;;;;;;
(defun lh(dt name tle goc)
(setvar "hpgaptol" 50.0)
(vl-cmdf "bhatch" "P" name tle goc "S" dt "" "")
)
Tình hình là lisp này lúc dùng được lúc không, nó hiện ra thông báo
"this area has already been specified"
Em không biết gì về lisp và cái trên là em tự chắp vá nên không hiểu nguyên lý lắm (sau khi bị bác Thanh Bình mắng nên mặc cảm, tự mò)
Nhờ các cao thủ sửa giúp ạ. Em xin cảm ơn. <<
|
Tác giả: only102
Bài viết gốc: 187432
Tên lệnh: laycur 5%09 |
LISP Cập nhật đối tượng vào layer hiện hành
Mình có lisp này, khi thực hiện lệnh, sẽ cập nhật đối tượng vào layer hiện hành. Nhưng nó chỉ cho phép chuyển layer, còn màu sắc của đối tượng vẫn không thay đổi. Mình muốn thêm phần tự động chuyển màu về bylayer khi thực hiện lệnh này. Mong các bạn sửa giúp mình!
Cảm ơn rất nhiều!
;;; ================== Cap nhat doi tuong vao layer hien hanh ==================
(Defun LAYCUR (/ SS CNT... >> Mình có lisp này, khi thực hiện lệnh, sẽ cập nhật đối tượng vào layer hiện hành. Nhưng nó chỉ cho phép chuyển layer, còn màu sắc của đối tượng vẫn không thay đổi. Mình muốn thêm phần tự động chuyển màu về bylayer khi thực hiện lệnh này. Mong các bạn sửa giúp mình!
Cảm ơn rất nhiều!
;;; ================== Cap nhat doi tuong vao layer hien hanh ==================
(Defun LAYCUR (/ SS CNT LAY) (setvar "cmdecho" 0)
(if (not (setq SS (ssget "i")))
(progn (prompt "\nChon doi tuong cap nhat vao layer hien hanh: ")
(setq SS (ssget)) ) )
(if SS (progn
(setq CNT (sslength SS)) (princ (strcat "\n" (itoa CNT) " Doi tuong tim thay.")) (command "_.move" SS "")
(if (> (getvar "cmdactive") 0)
(progn
(command "0,0" "0,0") (setq SS (ssget "p") CNT (- CNT (sslength SS)) ) )
(setq SS nil) ) (if (> CNT 0)
(princ (strcat "\n" (itoa CNT) " Doi tuong tren layer LOCK.")) ) ) )
(if SS (progn
(setq LAY (getvar "CLAYER")) (command "_.chprop" SS "" "_la" LAY "")
(if (= (sslength SS) 1)
(prompt (strcat "\n1 doi tuong da cap nhat vao layer : " LAY " (layer hien hanh)."))
(prompt (strcat "\n" (itoa (sslength SS)) " doi tuong da cap nhat vao layer : " LAY " (layer hien hanh).")) ) )) (princ) );end
(defun c:LAYCUR () (laycur)) (defun c:5 () (laycur))
<<
|
|
Filename: 187432_laycur_5%09.lsp
|
|
Tác giả: npham
Bài viết gốc: 121607
Tên lệnh: input |
Xuất dữ liệu cad sang EXCEL lần lượt
Chào cả nhà !
Thấy mấy bác cũng có hứng thú với đề tài này nên mình " chế " lại 1 chút cho vui. Chủ yếu là để tham khảo học hỏi lẫn nhau.
Code dưới đây thực hiện công việc ghi dwx liệu nhập ra file, nhưng trước khi ra file nó được ghi vào list_box để quan sát trước.
Ưu điểm:
- Số TT twj gia tăng
- nhập liệu bằng TAB-ENter, sau khi enter con trỏ quay về code, thuận tiện... >> Chào cả nhà !
Thấy mấy bác cũng có hứng thú với đề tài này nên mình " chế " lại 1 chút cho vui. Chủ yếu là để tham khảo học hỏi lẫn nhau.
Code dưới đây thực hiện công việc ghi dwx liệu nhập ra file, nhưng trước khi ra file nó được ghi vào list_box để quan sát trước.
Ưu điểm:
- Số TT twj gia tăng
- nhập liệu bằng TAB-ENter, sau khi enter con trỏ quay về code, thuận tiện cho người nhập, đồng thời reset các ô nhập liệu (trừ stt)
- Nút getdistance (theo ý tưỏng của bác gì đó)
- Quan sát được toàn bộ du liêu trươc khi ghi
Tồn tại: (cần bổ sung)
- Kiểm tra tính hợp lệ dwx liệu, loại bỏ dữ liệu rỗng
- Nút thêm, xoá, swả dw liệu trên list_box
- Cần phải hỏi lại trước khi đóng mà không ghi
Mấy bác có hứng thú thì phát triển tiếp nhé . Để chơi thôi chứ không biết có cần để làm gì không nwã. Hehe
minh hoạ:
http://www.cadviet.com/upfiles/3/input.png
Code:
<<
|
|
Filename: 121607_input.lsp
|
|
Tác giả: amateurday
Bài viết gốc: 187565
Tên lệnh: fff |
Lỗi lisp
Các bác cho em hỏi đoạn code sau em copy từng dòng vào cad để chạy thì ok, nhưng khi copy toàn bộ paste cùng lúc thì lại báo lỗi:
error: bad function: (<Entity name: 7efab0c8> (65.7159 19.2102 0.0))
(setq blockmau (entsel "\nChon Block mau:"))
(setq nhomtenblockmau (assoc 2 (entget (car blockmau))))
(setq Blkname (cdr nhomtenblockmau))
(setq doituong (cdr (last (tblsearch "Block" Blkname))))
(setq... >> Các bác cho em hỏi đoạn code sau em copy từng dòng vào cad để chạy thì ok, nhưng khi copy toàn bộ paste cùng lúc thì lại báo lỗi:
error: bad function: (<Entity name: 7efab0c8> (65.7159 19.2102 0.0))
(setq blockmau (entsel "\nChon Block mau:"))
(setq nhomtenblockmau (assoc 2 (entget (car blockmau))))
(setq Blkname (cdr nhomtenblockmau))
(setq doituong (cdr (last (tblsearch "Block" Blkname))))
(setq doituongcon (entnext doituong))
(setq DXFdoituongcon (entget doituongcon))
Em hỏi thêm nữa là đoạn code sau tại sao chạy lại bị lỗi: error: bad argument type: lentityp nil sau khi kết thúc lệnh while nhỉ
(defun C:fff()
(setq blockmau (entsel "\nChon Block mau:"))
(setq nhomtenblockmau (assoc 2 (entget (car blockmau))))
(setq Blkname (cdr nhomtenblockmau))
(setq doituong (cdr (last (tblsearch "Block" Blkname))))
(setq doituongcon (entnext doituong))
(setq DXFdoituongcon (entget doituongcon))
(princ "\n")
(setq DXFdoituong (entget doituong))
(princ "\n†††††††††††††††††††††††Bang ma DXF cua doi tuong nhu sau:")
(foreach tungphantu DXFdoituong
(princ "\n")
(princ tungphantu)
)
(princ "\n")
(princ "\n†††††††††††††††††††††††Bang ma DXF cua doi tuong nhu sau:")
(foreach tungphantu DXFdoituongcon
(princ "\n")
(princ tungphantu)
)
(while (/= doituongcon nil)
(setq doituongcon (entnext doituongcon))
(setq DXFdoituongcon (entget doituongcon))
(princ "\n")
(princ "\n†††††††††††††††††††††††Bang ma DXF cua doi tuong nhu sau:")
(foreach tungphantu DXFdoituongcon
(princ "\n")
(princ tungphantu)
)
)
(princ)
)
<< |
Tác giả: amateurday
Bài viết gốc: 187659
Tên lệnh: fff |
Thoát vòng lặp while có nhiều att
Trong Block att có 2 att trở lên, em muốn dùng vòng lặp để tìm đúng att trong block được chọn bằng nentsel, nhưng em không thoát ra khỏi while được. Các bác giúp em nhé
(defun c:fff()
(setq att (nentsel "Chon att1"))
(setq dxfatt (entget(car att1)))
(setq tagatt (cdr(assoc 2 dxfatt)))
(setq Blockchon (car(entsel "\nChon Block:")))
(setq DXFBlockchon(entget Blockchon))
(setq attblock... >> Trong Block att có 2 att trở lên, em muốn dùng vòng lặp để tìm đúng att trong block được chọn bằng nentsel, nhưng em không thoát ra khỏi while được. Các bác giúp em nhé
(defun c:fff()
(setq att (nentsel "Chon att1"))
(setq dxfatt (entget(car att1)))
(setq tagatt (cdr(assoc 2 dxfatt)))
(setq Blockchon (car(entsel "\nChon Block:")))
(setq DXFBlockchon(entget Blockchon))
(setq attblock (entnext Blockchon))
(setq DXFattblock(entget attblock))
(while (= (cdr(assoc 0 DXFattblock)) "ATTRIB")
(if (= (cdr(assoc 2 DXFattblock)) tagatt)
(princ DXFattblock)
)
)
)
<< |
Tác giả: hungdlcm
Bài viết gốc: 104289
Tên lệnh: dpl |
Xem giúp đoạn lisp của mình vẽ pline có nhập chiều dài và góc
Ý tưởng của mình là viết 1 đoạn lisp để cad vẽ 1 đường PLINE, yêu cầu người dùng nhập vào: điểm đầu của đường thẳng, chiều dài đường thẳng và góc mà đường thẳng đó hợp với phương mặt phẳng ngang.
Ví dụ: đoạn thẳng cần vẽ có chiều dài là 100 và hướng theo 1 góc xéo 45 độ. Bình thường nếu vẽ trong cad phải thao tác như sau:
- gõ lệnh pline
- click chọn... >> Ý tưởng của mình là viết 1 đoạn lisp để cad vẽ 1 đường PLINE, yêu cầu người dùng nhập vào: điểm đầu của đường thẳng, chiều dài đường thẳng và góc mà đường thẳng đó hợp với phương mặt phẳng ngang.
Ví dụ: đoạn thẳng cần vẽ có chiều dài là 100 và hướng theo 1 góc xéo 45 độ. Bình thường nếu vẽ trong cad phải thao tác như sau:
- gõ lệnh pline
- click chọn điểm đầu tiên (first point)
- sau đó ở dòng lệnh second point nhập vào: @100<45
Và dưới đây là đoạn lisp mà mình viết nhưng không cho ra kết quả như mong muốn mà cho kết quả là "UNKNOW DPL..." (lệnh mà mình viết là DPL):
Mình biết chắc là đoạn lisp trên có sai nhưng mình không biết sửa như thế nào! Mình chỉ mới tìm hiểu lisp trên diễn đàn CADVIET thui nên chưa rành lắm. Mong các bác có kinh nghiệm chỉ bảo giủp. Nếu được thì bác nào hướng dẫn cho cách viết đoạn lisp để thực hiện ý tưởng trên.
CẢM ƠN CÁC BÁC RẤT RẤT NHIỀU! << |
Tác giả: Doan Van Ha
Bài viết gốc: 187717
Tên lệnh: vx | |
Tác giả: phamngoctukts
Bài viết gốc: 110226
Tên lệnh: taob |
TÁCH BLOCK TỪ FILE!
Của bạn đây. Mình không dành về loại block này lắm nên khi nó xử lí đến thằng block này thì nó bị dừng lại. Bán cứ ấn enter để tiếp tục đến khi kết thúc.
|
|
Filename: 110226_taob.lsp
|
|
Tác giả: nhimret
Bài viết gốc: 187768
Tên lệnh: 0 | |
Tác giả: ketxu
Bài viết gốc: 187770
Tên lệnh: test |
Chỉnh LinetypeScale
- Phiên bản nhân LTS của các đối tượng với 1 hệ số nào đó
|
|
Filename: 187770_test.lsp
|
|
Tác giả: Doan Van Ha
Bài viết gốc: 187720
Tên lệnh: ha | |
Tác giả: tymap
Bài viết gốc: 187794
Tên lệnh: test |
Lisp linetype scale
Đây là đoạn lisp ma anh Ketxu đã viết cho mình:
(defun C:test (/)
(cond
((ssget "X" (list (cons 0 "*LINE,ARC,CIRCLE,HATCH")))
(vl-load-com)
(or #n (setq #n 1))
(setq #n (cond ((getdist (strcat "\nHe so nhan Linetype Scale <" (vl-princ-to-string #n) ">: ")))(#n)))
(vlax-for obj (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
... >> Đây là đoạn lisp ma anh Ketxu đã viết cho mình:
(defun C:test (/)
(cond
((ssget "X" (list (cons 0 "*LINE,ARC,CIRCLE,HATCH")))
(vl-load-com)
(or #n (setq #n 1))
(setq #n (cond ((getdist (strcat "\nHe so nhan Linetype Scale <" (vl-princ-to-string #n) ">: ")))(#n)))
(vlax-for obj (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-put-LinetypeScale obj (* (vla-get-LinetypeScale obj) #n))
)))
(princ))
Tuy nhiên lisp này ko tác động vào các đối tượng nằm trong block. Nhờ các bạn trên diễn đàn sửa giúp mình. Mình xin cảm ơn. <<
|
|
Filename: 187794_test.lsp
|
|
Tác giả: amateurday
Bài viết gốc: 187670
Tên lệnh: fff |
Thoát vòng lặp while có nhiều att
OK, em làm được rồi, Thanks bác
(defun c:fff()
(setq att (nentsel "Chon att"))
(setq dxfatt (entget(car att)))
(setq tagatt (cdr(assoc 2 dxfatt)))
(setq Blockchon (car(entsel "\nChon Block:")))
(setq DXFBlockchon(entget Blockchon))
(setq attblock (entnext Blockchon))
(setq DXFattblock(entget attblock))
(while (= (cdr(assoc 0 DXFattblock)) "ATTRIB")
(if (= (cdr(assoc 2 DXFattblock))... >> OK, em làm được rồi, Thanks bác
(defun c:fff()
(setq att (nentsel "Chon att"))
(setq dxfatt (entget(car att)))
(setq tagatt (cdr(assoc 2 dxfatt)))
(setq Blockchon (car(entsel "\nChon Block:")))
(setq DXFBlockchon(entget Blockchon))
(setq attblock (entnext Blockchon))
(setq DXFattblock(entget attblock))
(while (= (cdr(assoc 0 DXFattblock)) "ATTRIB")
(if (= (cdr(assoc 2 DXFattblock)) tagatt)
(princ DXFattblock)
)
(setq attblock (entnext attblock))
(setq DXFattblock(entget attblock))
(princ)
)
)
<< |
Tác giả: thiep
Bài viết gốc: 82750
Tên lệnh: blp hl |
Viết lisp theo yêu cầu [phần 2]
Gởi bác Phiphi:
Lisp này không cần LWPOLYLINE có sẵn, chỉ cần pick các tâm lỗ đục (nếu dùng lệnh HL). Pick các điểm đầu của BEND LINE (nếu dùng lệnh BLP)
heicell = 1.5*tHt
Tự động điền số thứ tự của lỗ đục, hay các điểm đầu cuối của Bend line
Happy Christmas!
|
|
Filename: 82750_blp_hl.lsp
|
|
Tác giả: Tue_NV
Bài viết gốc: 187884
Tên lệnh: tl3 | |
Tác giả: Doan Van Ha
Bài viết gốc: 186738
Tên lệnh: dimblk |
Lisp dim các block không thẳng hàng!
Bác PTB xui quá, lần nào up bài thì CV cũng bị lỗi. Tôi sửa giùm cho bác luôn để giúp bạn Hoavien nhé!
@Hoavien: dùng lisp sửa lỗi của bác ấy xem sao.
|
|
Filename: 186738_dimblk.lsp
|
|
Tác giả: Tue_NV
Bài viết gốc: 94127
Tên lệnh: thw |
Làm cân đối lại Text khi Scale 1 chiều ??
Bạn có thể sử dụng lệnh MO -> Bảng Properties để chỉnh. Nhưng nếu quá nhiều thì có thể sử dụng code Lisp sau :
Của bạn sử dụng như sau :
Command: thw -> gõ lệnh thw
Select objects: Specify opposite corner: 425 found -> Quét chọn toàn bộ đối tượng và khai báo các hệ số như dưới đây
Select objects:
he so tang chieu cao cua chu theo phuong X :2
he... >>
Bạn có thể sử dụng lệnh MO -> Bảng Properties để chỉnh. Nhưng nếu quá nhiều thì có thể sử dụng code Lisp sau :
Của bạn sử dụng như sau :
Command: thw -> gõ lệnh thw
Select objects: Specify opposite corner: 425 found -> Quét chọn toàn bộ đối tượng và khai báo các hệ số như dưới đây
Select objects:
he so tang chieu cao cua chu theo phuong X :2
he so tang do rong cua chu theo phuong X :0.5
he so tang chieu cao cua chu theo phuong Y :0.5
he so tang do rong cua chu theo phuong Y :2
Chúc thành công << |
Tác giả: Doan Van Ha
Bài viết gốc: 188001
Tên lệnh: ha |
TÍNH ĐỘ DÓC
Đây bạn! Chú ý: vị trí và kích cỡ mũi tên tôi chỉ tạm thiết kế theo 1 tỉ lệ với chiều cao text, bạn có thể sửa lại theo ý mình.
|
Tác giả: Doan Van Ha
Bài viết gốc: 188045
Tên lệnh: ha |
TÍNH ĐỘ DÓC
Đây bạn! Pick chọn đối tượng để lấy chiều dài là ý ban đầu của bạn.
|
Tác giả: gia_bach
Bài viết gốc: 121468
Tên lệnh: cvs |
Xuất dữ liệu cad sang EXCEL lần lượt
Chào các bác.
Tiếp sức cùng bác Bình, "mình làm thử cái này hơi thừa vì chưa chắc có ai cần dùng ?"
Đề bài vẫn là của bạn Trang72 và ý tuởng từ LISP của bác Bình, đáp án thì có khác chút đỉnh với nguyên bản ..
Sử dụng file "NHAPLIEU.dcl" của bác Bình.
Môt số cải tiến :
- gán giá trị mặc định cho hộp thoại
- STT tự động tăng lên 1 sau mỗi lần nhấn... >> Chào các bác.
Tiếp sức cùng bác Bình, "mình làm thử cái này hơi thừa vì chưa chắc có ai cần dùng ?"
Đề bài vẫn là của bạn Trang72 và ý tuởng từ LISP của bác Bình, đáp án thì có khác chút đỉnh với nguyên bản ..
Sử dụng file "NHAPLIEU.dcl" của bác Bình.
Môt số cải tiến :
- gán giá trị mặc định cho hộp thoại
- STT tự động tăng lên 1 sau mỗi lần nhấn OK
- chức năng của button ZOOM đuợc đổi thành GET_Distance (đo khoảng cách 2 điểm trên CAD)
<< |
lệnh là 0