vanlam6408
-
Số lượng nội dung
48 -
Đã tham gia
-
Lần ghé thăm cuối
Bài đăng được đăng bởi vanlam6408
-
-
Vào lúc 27/2/2021 tại 22:26, Doan Nguyen Van đã nói:Mai nhé, mình để ở máy tính rồi
bác @Doan Nguyen Van đã có thời gian chưa ạ bác oi
-
6 giờ trước, ngokiet đã nói:-
ff.lsp
-
(defun c:ff(/ e1 e2 p1 p2 break) (defun break(en / lp n) (setq ob (vlax-ename->vla-object en) p1 (vlax-curve-getparamatpoint ob (vlax-curve-getclosestpointto ob (trans p1 1 0))) p2 (vlax-curve-getparamatpoint ob (vlax-curve-getclosestpointto ob (trans p2 1 0)))) (If (> p1 p2) (mapcar 'set '(p1 p2) (list p2 p1))) (setq p1 (1+ (fix p1)) p2 (fix p2)) (if (eq p1 p2) (command "breaK" (list en (setq p1 (vlax-curve-getpointatparam ob p1))) p1) (progn (command "breaK" (list en (setq p2 (vlax-curve-getpointatparam ob p2))) p2) (command "breaK" (list en (setq p1 (vlax-curve-getpointatparam ob p1))) p1)))) (if (and (mapcar 'set '(e1 p1) (entsel "Chon 1:")) (mapcar 'set '(e2 p2) (entsel "Chon 2:"))) (progn (command "Fillet" p1 p2) (if (null (entget e1)) (break e2) (if (null (entget e2)) (break e1))) (princ))))
Viết nhanh theo kiểu bác Đoàn. Làm sơ sơ nên nếu 2 đối tượng khác màu / layer nhau thì sẽ mất 1 đối tượng.
hìhì,em thấy về mục tiêu cốt lõi là fillet nhưng không cho 2 đối tượng nó khắc nhập vào nhau thì lisp bác viết cũng đã làm chuẩn rồi ạ,nhưng chắc bác viết vội nên chưa hilight được đối tượng được chọn như lệnh fillet,với nếu mà chọn đối tượng không chính xác sau 2 lượt lựa chọn thì sẽ game over,đây chắc là những điểm khác so với lệnh fillet gốc trong lisp bác viết.Kính chúc bác buổi tối tốt lành ạ!
-
-
51 phút trước, Doan Nguyen Van đã nói:Thuật toán là nối 2 đường xong kiểm tra vị trí các điểm của pline mới tạo ra, rồi phát nổ tại điểm nối
bác có thể chia sẻ lisp này không ạ?cảm ơn bác nhiều ạ
-
38 phút trước, Doan Nguyen Van đã nói:Thuật toán là nối 2 đường xong kiểm tra vị trí các điểm của pline mới tạo ra, rồi phát nổ tại điểm nối
hi,thuật toán đơn giản chỉ có một dòng nhưng chắc thực hiện được ý tưởng đó cũng không hề đơn giản bác nhỉ
-
4 giờ trước, Doan Nguyen Van đã nói:Thế này ổn không bạn nhỉ
ồ,hay quá!đúng rồi đó bác ạ!chưa được test thực tế nhưng trông có vẻ ổn đó bác ạ!bác làm sao mà làm được thế ạ?
-
3 giờ trước, DuongTrungHuy đã nói:Chào Bạn.
À trong chương trình vừa rồi mình chỉ viết để chamffer cho 2 Poly đơn thôi chứ đường gấp khúc thì phải đi tiếp nữa Bạn à.
Nó sẽ rất dài dòng mà tình huống của Bạn có vẻ hơi cá biệt sợ ít gặp trong thực tế, nên tính phổ biến của chương trình sẽ ko cao ít được người dùng.
Hì, Chào nhé!
hi,cái này là em lấy bất kì 2 đường poly nên tổng quát hơn trường hợp của 2 đường poly đơn nhưng để làm được trường hợp tổng quát này em thấy nó cũng phức tạp do đó bài toán khắc xuất khắc nhập đường poly khi sử dụng lệnh fillet nếu mà đi đến cùng em nghĩ có vẻ không đơn giản
-
1
-
-
4 giờ trước, DuongTrungHuy đã nói:dạ,em cảm ơn bác đã code lại ạ!em đã thử lại lisp của bác cũng như thử lại lisp của bác @cuongtk2 cho trường hợp 2 đường pl đơn thì kết quả là fillet được 2 đường đơn này,nhưng so với lệnh fillet thì lisp chưa fillet được trong trường hợp một đường pl và một đường line,với trong phiên bản này vẫn bị mất hết bắt điểm khi dùng lisp,việc chọn đối tượng cũng không hilight như cách chọn đối tượng ban đầu nữa bác ạ.Nhưng đó có vẻ chưa phải là vấn đề lớn nhất,em thử dùng lisp của 2 bác vào một trường hợp đường pl gấp khúc bất kì thì fillet không còn đúng nữa.Như hình dưới,nếu trong đường ABCDEF ta chọn đoạn CD để fillet với đoạn B1C1 thì kết quả của lệnh fillet sẽ ra như hình ABCGC1D1E1,trong lúc lisp của mình lại ra kết quả các đường lại đồng quy như hình bên dưới.Như thế,tùy việc mình chọn đoạn nào trong các đường gấp khúc đó để fillet thì sẽ ra kết quả khác nhau,do đó nếu mà tìm điểm giao của 2 đối tượng sau đó break tại điểm này để tách hai đối tượng ra thì sẽ rat nhiều trường hợp phải xét đi kèm với đó là thời gian của người viết lisp sẽ mất rất nhiều.Em không biết code lisp,nhưng em nghĩ có thể nào đi theo hướng cứ cho dòng commad fillet trước,chọn đối tượng gì đó cũng để cho lênh fillet nó chọn thao tác, cho cad nó fillet thoải mái trước như thế sẽ không phải xét các trường hợp nó cắt ở đâu cho đỡ đau đầu và mất thời gian code,đợi nó fillet xong thì sẽ sinh ra một đối tượng mới.Nếu mà cad có thể ghi nhận sự thay đổi sinh ra đối tượng mới này (chính là đường ABCGC1D1E1) cùng với điểm G mới sinh ra thì ta tóm lấy đối tượng mới này và lại command break tại điểm G.Em nghĩ như thế nhưng không biết cad có làm được không và có mất nhiều thời gian của các bác không?
-
24 phút trước, DuongTrungHuy đã nói:Chào!
Hì vậy nghĩa là bạn muốn 1 lệnh như fillet nhưng đừng đính lại với nhau.
Vậy mình sẽ tiếp tục theo hướng đó. Nó mất công thêm 1 chút.
dạ,đúng như thế bác ạ!
-
6 giờ trước, DuongTrungHuy đã nói:Chào Bạn!
Bạn có định dùng cái Lisp này ko. Thực tình mình viết vì thấy vấn đề cũng hay hay. Mình viết để vỡ vấn đề ra đấy thôi, còn sử dụng thì thêm thắt vài thứ như Bạn nói.
Chỗ mà Bạn "thiến" vì chưa đủ điều kiện ban đầu nên mình chưa dám xoá vì ko biết lấy đoạn nào, hơn nữa thấy người yêu cầu ko mặn mà lắm nên thôi :)
Nếu bạn cũng cần cái lisp này trong công việc thì mình sẽ đi tiếp.
Chào nhé.
hi,lisp này em thấy bác viết rất hay bác ạ,mong bác đừng dừng lại.Vì đây là chủ đề của bạn chủ thớt nên em cũng ngại khi lấn sân sâu quá,song cá nhân em thì thấy lisp này là hữu dụng đối với em.Nếu em mà là chủ thớt thì em mong nó làm việc như lệnh fillet,có điều làm sao khi fillet rồi thì nó không dính hết vào nhau như lệnh fillet khi có một đối tượng là polyline trong đó.Cá nhân em mà dùng lisp này thì em mong nó cứ "thiến" hết như fillet ạ.Cảm ơn bác đã xem xét ạ!
-
1
-
-
2 giờ trước, DuongTrungHuy đã nói:Chào Bạn!
Cái mình đã đưa là phần cốt lõi của bài toán. Để trở thành chuyên nghiệp, sản phẩm thị trường hơn cần làm như Bạn nói. Thông thường nhưng chuyện đó ko phức tạp lắm, Mình sửa theo y/c của Bạn
-Chọn Poly
-Chỉ lấy 2 obj
-Có Undo.
Cám ơn đã ý kiến (Mình định để người yêu cầu xem xét rồi chỉnh sửa luôn).
Bạn tham khảo nhé!
cảm ơn bác đã cân nhắc ạ,thật ngại quá bác ạ,đáng ra cái này chủ thớt báo lại với bác để nhờ bác chỉnh sửa cho diễn đàn có một lisp hoàn chỉnh nhưng chắc bạn ấy cũng chưa thực nghiệm kĩ.Em thì hay tò mò về lisp nên em thực nghiệm em thấy có một số chỗ lisp có thể còn thiếu em xin mạn phép góp ý cùng bác và bạn chủ thớt ạ
1)khi em chạy lisp thì phải đánh cả lệnh (cchh) hả bác?(khi appload xong lisp nó ra chọn đối tượng luôn,sau đó muốn dùng thì em phải đánh cả cụm (cchh) có vẻ hơi dài hơi kiểu đánh tên lệnh truyền thống bác nhỉ?)
2)chạy xong lisp nó lại mất hết bắt điểm luôn bác ạ
3)so với lệnh fillet thì fillet cắt hết các đoạn thừa luôn,còn lisp của mình thì như hình dưới nó vẫn chưa thiến luôn được đoạn AB bác ạ
-
3 giờ trước, DuongTrungHuy đã nói:Chào Bạn.
Hì có sự động viên mình viết. Các Bạn rãnh góp ý nhé!
(defun cChh(/ dse1 dse2 ss1 dga dgb d1a d1b d2a d2b ds1ci ds2cu e1 e2)
(setvar "osmode" 0)(Setvar "orthomode" 0)
(Princ "\nBao chon 2 Poly: ")
(setq ss1 (ssget) e1 (ssname ss1 0) e2 (ssname ss1 1)
ds1 (acet-geom-vertex-list e1) ds2 (acet-geom-vertex-list e2)
d1a (car ds1) d1b (cadr ds1) d2a (car ds2) d2b (cadr ds2)
dga (Inters d1a d1b d2a d2b) dgb (Inters d1a d1b d2a d2b F)
)
;(print (list d1a d1b d2a d2b dga dgb))
(If dga
(progn
(command "break" e1 dga dga) (command "break" e2 dga dga)
)
(progn
(setq l1 (distance d1a d1b) l2 (distance d2a d2b) dse1 (entget e1) dse2 (entget e2) d1c d1b d2c d2b
dsmoi (list 10 (car dgb) (cadr dgb))
)
(If (< (distance dgb d1a) (distance dgb d1b))(setq d1c d1a))
(If (< (distance dgb d2a) (distance dgb d2b))(setq d2c d2a))
(If (< (+ (distance dgb d1a) (distance dgb d1b)) l1) (command "break" e1 dgb dgb)
(setq ds1cu (list 10 (car d1c) (cadr d1c)) dse1 (subst dsmoi ds1cu dse1) oo (entmod dse1))
)
(If (< (+ (distance dgb d2a) (distance dgb d2b)) l2) (command "break" e2 dgb dgb)
(setq ds2cu (list 10 (car d2c) (cadr d2c)) dse2 (subst dsmoi ds2cu dse2) oo (entmod dse2))
)
)
)
)em thấy lisp của bác @DuongTrungHuy viết rất hay,chọn nhanh được đối tượng,nhưng nếu mà lỡ tay chọn nhầm làm lisp bị lỗi(như chọn đối tượng không phải là polyline,chọn quá 2 đường polyline,chọn 1 đường line và 1 đường polyline ....) thì lisp sẽ xóa luôn các đối tượng được chọn,và lần sau dùng lại cũng bị xóa luôn.Bác có thể chỉnh lại chỗ này một chút để mà quét chọn nhầm thì nó vẫn không bị xóa( hoặc báo lỗi để còn biết mà sửa) chứ không xóa hẳn luôn được không ạ,nghĩa là lisp không yêu xin đừng nói lời cay đắng ý ạ
-
1
-
-
18 giờ trước, naturooo đã nói:Đã chế lại màu lọc theo True Color (màu hiển thị). Bạn thử xem có lỗi gì k nhé!
-
qf.lsp
-
;; List Box - Lee Mac ; Displays a DCL list box allowing the user to make a selection from the supplied data. ; msg - [str] Dialog label ; lst - [lst] List of strings to display ; bit - [int] 1=allow multiple; 2=return indexes ; Returns: [lst] List of selected items/indexes, else nil (defun LM:listbox (msg lst bit / dch des tmp rtn) (cond ((not (and (setq tmp (vl-filename-mktemp nil nil ".dcl")) (setq des (open tmp "w")) (write-line (strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select=" (if (= 1 (logand 1 bit)) "true" "false" ) ";width=50;height=15;}spacer;ok_cancel;}" ) des ) (not (close des)) (< 0 (setq dch (load_dialog tmp))) (new_dialog "listbox" dch) ) ) (prompt "\nError Loading List Box Dialog.") ) (t (start_list "list") (foreach itm lst (add_list itm)) (end_list) (setq rtn (set_tile "list" "0")) (action_tile "list" "(setq rtn $value)") (setq rtn (if (= 1 (start_dialog)) (if (= 2 (logand 2 bit)) (mapcar '(lambda (x) (nth x lst)) (read (strcat "(" rtn ")")) ) (read (strcat "(" rtn ")")) ; (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")"))) ) ) ) ) ) (if (< 0 dch) (unload_dialog dch) ) (if (and tmp (setq tmp (findfile tmp))) (vl-file-delete tmp) ) rtn ) ;====================================Main Lisp: Quick Filter (QF) Update 19/08/2020 Loc theo "True Color"====================================== (defun C:QF (/ ss ss1 ob lyrname colr blkname txth txtn lstQF lstDCL lstidx lstfi a c d l ) (setq ss1 (entsel "\nSelect Object: ")) (while (or (null ss1) (= "" (cdr (assoc 0 (entget (car ss1))))) ) (setq ss1 (entsel "\nSelect Object Again: ")) ) (setq ss (entget (car ss1))) (setq ob (cdr (assoc 0 ss))) (setq lstQF (list (cons 0 ob))) (if (= "INSERT" ob) (setq lstDCL (list (strcat "Object : " "Block"))) (setq lstDCL (list (strcat "Object : " ob))) );endif (setq lyrname (cdr (assoc 8 ss))) (setq lstQF (append lstQF (list (cons 8 lyrname)))) (setq lstDCL (append lstDCL (list (strcat "Layer : " lyrname)) ) ) (setq c (cond ((cdr (assoc 62 ss))) ((abs (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 ss))))) ) ) ) ) (while (setq d (tblnext "LAYER" (null d))) (if (= c (abs (cdr (assoc 62 d)))) (setq l (cons "," (cons (cdr (assoc 2 d)) l))) ) ) (setq lstQF (append lstQF (list "True Color"))) (setq lstDCL (append lstDCL (list (strcat "True Color : " (rtos c 2 0))) ) ) (if (= 2 (car (assoc 2 ss))) (progn (setq blkname (cdr (assoc 2 ss))) (setq lstQF (append lstQF (list (cons 2 blkname)))) (setq lstDCL (append lstDCL (list (strcat "Block Name : " blkname)) ) ) );end progn );end if (if (= 40 (car (assoc 40 ss))) (progn (setq txth (cdr (assoc 40 ss))) (setq lstQF (append lstQF (list (cons 40 txth)))) (setq lstDCL (append lstDCL (list (strcat "Text Height : " (rtos txth))) ) ) );end progn );end if (if (= 7 (car (assoc 7 ss))) (progn (setq txtn (cdr (assoc 7 ss))) (setq lstQF (append lstQF (list (cons 7 txtn)))) (setq lstDCL (append lstDCL (list (strcat "Text Style Name : " txtn)) ) ) );end progn );end if (setq lstidx (LM:listbox "Selection to Filter:" lstDCL 1)) (if lstidx (progn (foreach a lstidx (if (= "True Color" (nth a lstQF)) (if l (setq lstfi (append lstfi (list (cons -4 "<OR") (cons 62 c) (cons -4 "<AND") (cons 62 256) (cons 8 (apply 'strcat (cdr l))) (cons -4 "AND>") (cons -4 "OR>") ) )) (setq lstfi (append lstfi (list (cons 62 c)) )) ) (setq lstfi (append lstfi (list (nth a lstQF)))) ) ) (sssetfirst nil (ssget lstfi)) ) ) (Print "Write by: NghiaKieu") (princ) )
hôm nay mới vào diễn đàn test thử hàng mới của bác ạ!Lisp chuẩn rồi bác ạ!cảm ơn bác đã cho em và diễn đàn một lisp mới thật là hay ạ!
-
1
-
-
12 giờ trước, naturooo đã nói:-
selectbycolour.lsp
-
(defun c:SelectByColour ( / c d e l ) (if (setq e (car (entsel))) (progn (setq c (cond ( (cdr (assoc 62 (entget e))) ) ( (abs (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 (entget e))))))) ) ) ) (while (setq d (tblnext "LAYER" (null d))) (if (= c (abs (cdr (assoc 62 d)))) (setq l (cons "," (cons (cdr (assoc 2 d)) l))) ) ) (sssetfirst nil (ssget "_X" (if l (list (cons -4 "<OR") (cons 62 c) (cons -4 "<AND") (cons 62 256) (cons 8 (apply 'strcat (cdr l))) (cons -4 "AND>") (cons -4 "OR>") ) (list (cons 62 c)) ) ) ) ) ) (princ) )
Mình tìm thấy cái chọn màu kể cả By layer của Lee Mac đây. Để lúc nào m thêm tuỳ chọn chọn cả theo màu của layer xem sao :)
vâng,mong là qf sẽ sớm được hoàn thiện nhất.hi
-
-
53 phút trước, naturooo đã nói:Lọc theo màu mà có màu đặt theo By layer thì khoai quá. Mình thì các nét toàn để By layer hết nên ít khi lọc theo màu lắm. Không biết các cao thủ trên có giải quyết được món này không? (Mình cũng Beginner :D)
vâng.hi
-
5 phút trước, naturooo đã nói:Mã 256 là By layer mà. Màu khác nhau nhưng để By layer thì nó chọn cả (Filter mặc định cũng vậy). Ý thứ 2 của bạn cũng như vậy.
à vâng,ra thế,em tưởng nó có thể phân biệt được các màu khác nhau cả trong trường hợp by layer thì tốt quá
-
10 giờ trước, naturooo đã nói:Thay vì lệnh Filter (FI) mặc định chọn rồi xoá xoá. Lisp Quick Filter (QF) này sẽ chọn một số thuộc tính thông dụng để lọc, giảm bớt vài thao tác thừa không cần thiết:
-
qf.lsp
-
;; List Box - Lee Mac ; Displays a DCL list box allowing the user to make a selection from the supplied data. ; msg - [str] Dialog label ; lst - [lst] List of strings to display ; bit - [int] 1=allow multiple; 2=return indexes ; Returns: [lst] List of selected items/indexes, else nil (defun LM:listbox ( msg lst bit / dch des tmp rtn ) (cond ( (not (and (setq tmp (vl-filename-mktemp nil nil ".dcl")) (setq des (open tmp "w")) (write-line (strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select=" (if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}" ) des ) (not (close des)) (< 0 (setq dch (load_dialog tmp))) (new_dialog "listbox" dch) ) ) (prompt "\nError Loading List Box Dialog.") ) ( t (start_list "list") (foreach itm lst (add_list itm)) (end_list) (setq rtn (set_tile "list" "0")) (action_tile "list" "(setq rtn $value)") (setq rtn (if (= 1 (start_dialog)) (if (= 2 (logand 2 bit)) (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")"))) (read (strcat "(" rtn ")")) ; (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")"))) ) ) ) ) ) (if (< 0 dch) (unload_dialog dch) ) (if (and tmp (setq tmp (findfile tmp))) (vl-file-delete tmp) ) rtn ) ;====================================Main Lisp: Quick Filter (QF)====================================== (defun C:QF (/ ss ss1 ob lyrname colr blkname txth txtn lstQF lstDCL lstidx lstfi a) (setq ss1 (entsel "\nSelect Object: ")) (while (or (null ss1) (= "" (cdr (assoc 0 (entget (car ss1))))) ) (setq ss1 (entsel "\nSelect Object Again: ")) ) (setq ss (entget (car ss1))) (setq ob (cdr (assoc 0 ss))) (setq lstQF (list (cons 0 ob))) (if (= "INSERT" ob) (setq lstDCL (list (strcat "Object : " "Block"))) (setq lstDCL (list (strcat "Object : " ob))) );endif (setq lyrname (cdr (assoc 8 ss))) (setq lstQF (append lstQF (list (cons 8 lyrname)))) (setq lstDCL (append lstDCL (list (strcat "Layer : " lyrname)))) (if (= 62 (car (assoc 62 ss))) (progn (setq colr (cdr (assoc 62 ss))) (setq lstQF (append lstQF (list(cons 62 colr)))) (setq lstDCL (append lstDCL (list (strcat "Color : " (rtos colr 2 0))))) );progn (progn (setq lstQF (append lstQF '((62 . 256)))) (setq lstDCL (append lstDCL (list (strcat "Color : " "256")))) ) );end if (if (= 2 (car (assoc 2 ss))) (progn (setq blkname (cdr (assoc 2 ss))) (setq lstQF (append lstQF (list (cons 2 blkname)))) (setq lstDCL (append lstDCL (list (strcat "Block Name : " blkname)))) );end progn );end if (if (= 40 (car (assoc 40 ss))) (progn (setq txth (cdr (assoc 40 ss))) (setq lstQF (append lstQF (list (cons 40 txth)))) (setq lstDCL (append lstDCL (list (strcat "Text Height : " (rtos txth))))) );end progn );end if (if (= 7 (car (assoc 7 ss))) (progn (setq txtn (cdr (assoc 7 ss))) (setq lstQF (append lstQF (list (cons 7 txtn)))) (setq lstDCL (append lstDCL (list (strcat "Text Style Name : " txtn)))) );end progn );end if (setq lstidx (LM:listbox "Selection to Filter:" lstDCL 1)) (foreach a lstidx (setq lstfi (append lstfi (list (nth a lstQF)))) ) (sssetfirst nil (ssget lstfi)) (Print "Write by: NghiaKieu") (princ) )
lisp hay nhưng chọn màu còn bị lỗi rồi bác ơi,em test thử thấy cùng một màu 256 mà màu trắng với màu đỏ nó đều chọn hết,cùng một mã màu xanh mà cái thì nó chọn cái nó lại không chọn,những cái khác chưa test hết ạ
-
-
11 phút trước, Doan Van Ha đã nói:Đó mới chỉ giải quyết color. Còn Linetype và Lineweight cũng có bylayer và byblock.
hi,chắc là em chưa hiểu rõ ý bác thật rùi.Em test lại vẫn thấy đúng bác ợ
-
4 giờ trước, Doan Van Ha đã nói:Ngoài color còn vài thứ bylayer và byblock nữa mà?
em không hiểu ý bác lắm ạ.Em thấy bylayer với byblock cũng được giải quyết rùi mà bác?
-
2 giờ trước, NTHAHT đã nói:Mình thêm LinetypeScale:
(defun c:cpv (/ cc ss)
(if (setq ss (ssget))
(mapcar '(lambda (x)
(mapcar '(lambda (p v) (vlax-put x p v))
'(Color Layer Linetype LineWeight LinetypeScale)
(cons (cond ((eq (setq cc (getvar 'CECOLOR)) "BYLAYER") 256)
((eq cc "BYBLOCK") 0)
(cc))
(mapcar 'getvar '(CLAYER CELTYPE CELWEIGHT CELTSCALE)))))
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))))
(princ))Lần này thì tuyệt vời 100% rồi bác ạ!Em cảm ơn bác nhiều ạ!Chúc bác mọi điều tốt lành ạ!
-
1 giờ} trướ}c, ngokiet đã nói:À mình mới thử. Thấy đúng. string hay int đều được.
@vanlam6408 Hình như bác ít test bằng Console trong vlide.
Bác vào vlide nhấn F6. Cửa sổ dòng lệnh hiện ra thì bác có thể test thoải mái mà.
Ví dụ như đánh
(vla-put-color (vlax-ename->vla-object(car(entsel))) "2")
Thì nó sẽ cho chọn object và set color là 2.
Hay nhấn (getvar "CECOLOR") là nó trả lới giá trị của cecolor.
Vì vậy bạn có thể test nhanh lệnh nào sai để sửa lại cho đúng. Lệnh gộp cũng có thể tách ra test thử.
Hy vọng bác có thể nhanh viết lisp được riêng cho mình.
Mình không thích vla nhiều mà thích lisp thường hơn. Nó nhanh hơn dùng vla vì khi sài vla nó sửa từng lần 1 trong bản vẽ. Còn entmod thì nó sửa 1 lần nên nhanh hơn. Nhất là khi vẽ mấy bãng table. Vla thích hợp khi đọc dữ liệu từ các app khác nhiều hơn.
dạ em cảm ơn bác đã chỉ cho em cách test thử lisp ạ!em mới tập tành lisp nên mấy cái này quả thật em không biết ạ,em thường xem trên file text,rồi add thẳng lisp vào cad để thử cho chạy luôn.
em cũng thích lisp thường,nhưng trong trường hợp này,theo cách viết của bác NTHAHT,cá nhân em thấy bác ấy dùng hàm vla như bác ấy viết làm lisp chạy nhanh và tổng quát hơn cả yêu cầu từ đầu của em,và nhanh hơn cách dùng hàm comman của em rất là nhiều.Hàm entmode làm một lần nên nhanh,gọn nhưng theo em được biết cần mã dxf,mà mỗi lạo đỗi tượng thì thứ tự các mã này em nghĩ có lẽ chúng khác nhau,như thế,nếu đây không là đường tròn,mà là đường khác muốn gộp vào trong một lisp thì lại phải chia trường hợp nhiều,nếu như em mà viết chắc code sẽ càng dài lắm.Một lần nữa em cảm ơn các bác nhiều ạ!
-
1 giờ trước, NTHAHT đã nói:Bác @ngokiet, của mình cũng ra string, dùng vẫn thấy bình thường...
Viết lại cho đầy đủ hơn:
(defun c:cpv (/ cc ss)
(if (setq ss (ssget))
(mapcar '(lambda (x)
(mapcar '(lambda (p v) (vlax-put x p v))
'(Color layer Linetype LineWeight)
(cons (cond ((eq (setq cc (getvar 'CECOLOR)) "BYLAYER") 256)
((eq cc "BYBLOCK") 0)
(cc))
(mapcar 'getvar '(CLAYER CELTYPE CELWEIGHT)))))
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))))
(princ))Bác test thử xem sao!
cảm ơn bác nhiều ạ!về các thuộc tính color,linetype,lineweight thì tuyệt vời rồi bác ạ.Tuy thế,bác có thể giúp em thêm một tí cho luôn cái linetype scale cho nó cùng bằng linetype hiện hành như trong bảng property nữa không hả bác.Cái này em không lường được từ đầu,tưởng đưa nó về cùng một linetype thì khoảng cách giữa các nét đứt cũng giống nhau,nhưng khi test file của bác nó thấy mới thấy rõ mỗi đồng chí đường tròn có một khoảng cách nét đứt khác nhau và cũng không bằng linetype hiện hành đang dùng để vẽ,như thế ,về sau lại phải đi tìm loc lại các đường này để điều chỉnh lại lintype scale,như là đi matchop lại từ đầu.Thì bác có thể điều chỉnh giúp em thêm chỗ này một tí không ạ?em cảm ơn bác nhiều ạ!
-
1 giờ} trướ}c, ngokiet đã nói:Mình nghĩ nó sai ở đây (vla-put-Color x (getvar "CECOLOR")) vì khi Cecolor = Bylayer hay byblock sẽ bị lỗi.
Vì vậy cần làm thêm biên cc (thêm dòng này trước lệnh mapcar)
(setq cc (if (eq (setq cc (getvar "cecolor")) "BYLAYER") 256 (if (eq cc "BYBLOCK" ) 0 (atoi cc))))
và sửa thành (vla-put-Color x cc)
Còn làm thử theo entmod
-
cadvietlisp.lsp
-
(setq ll (list (cons 8 (getvar 'clayer)) (cons 6 (getvar 'celtype)) (cons 62 (if (eq (setq ll (getvar "cecolor")) "BYLAYER") 256 (if (eq ll "BYBLOCK" ) 0 (atoi ll)))) (cons 370 (getvar 'celweight)))) (mapcar '(lambda(x) (entmod (cons (cons -1 x) ll))) (acet-ss-to-list (ssget '((0 . "CIRCLE")))))
1 giờ trước, NTHAHT đã nói:Trong đoạn màu đỏ viết đúng, nhưng bạn cần cho mọi người xem lý lịch của đồng chí này: entlst1
hìhì,cái đồng chí entlst1 nói nôm na là từng đông chí đường tròn trong tập hợp quét chọn các đồng chí ấy bác ngokiet và bác NTHAHT ạ.Em lấy nó bằng cách như thế này:
(setq ss (ssget '((0 . "CIRCLE"))))
(setq objlst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(foreach entlst1 objlst
(setq cc (if (eq (setq cc (getvar "cecolor")) "BYLAYER") 256 (if (eq cc "BYBLOCK" ) 0 (atoi cc))))
(mapcar '(lambda (x) (vla-put-layer x cc)) entlst1)
)
bác ngokiet đã bắt đúng bệnh là máy báo lỗi "by layer" tuy nhiên em cho dòng lênh (setq cc (if (eq (setq cc (getvar "cecolor")) "BYLAYER") 256 (if (eq cc "BYBLOCK" ) 0 (atoi cc)))) vào trước vẫn không khắc phục được bác ạ,máy báo lỗi " error: Automation Error. Key not found".sau đó lại bám theo dòng lệnh dùng entmod bác cho phía dưới cũng vẫn không được ạ,lần này máy lại báo lỗi "error: bad DXF group: (-1 . #<VLA-OBJECT IAcadLWPolyline 2342be54>)"
Vơi lại,dùng hàm entmode như bác em thấy chắc là nhanh và gọn,tuy nhiên có 2 vấn đề có thể xảy ra:
thứ nhất:nếu sau này mình muốn mở rộng thêm đối tượng không phải là đường tròn mà đường khác vào trong tập hợp chọn đó nữa thì có được không?
thứ hai:phía trên em dùng hàm kiểu vla,phía dưoi lại dùng entmode với các hàm khác để tác động vào mấy cái entlst1 được lấy bằng hàm vla thì có tương thích được không?có cách nào vẫn có thể tương thích không?
nếu mà không có cách nào cho nó tương thich và đơn giản hơn thì em vẫn mong các bác có thể sửa cho em code theo hướng dùng mấy cái hàm
vla-get-Color , vla-put-Color
vla-get-Linetype , vla-put-Linetype
vla-get-LineWeight , vla-put-LineWeightBiến hệ thống tương ứng:
CECOLOR , CELTYPE , CELWEIGHT
như bác ndtnv đã gợi ý ,vì như thế cho nó đồng bộ ạ.
về ngôn ngữ lisp em chưa thạo lắm chỉ cảm thấy thế nào,hình dung thế nào thì viết thế,sai chỗ nào trong diễn đạt mong các bác bỏ qua và chỉ bảo thêm cho em ạ.Em chân thành cảm ơn các bác ạ!
-
-
1 giờ} trướ}c, ngokiet đã nói:Bạn nên nghiên cứu các lệnh và biến 1 chút mới xử lý được. Xem khi biến CECOLOR , CELTYPE , CELWEIGHT khi ByLayer, ByBlock là có giá trị như thế nào?
So sánh với các hàm vla thì giá trị tương ứng là bao nhiêu vì có thể khác nhau. Mình ko trên máy nên ko test được. Mấy hàm vla mình ít sài nên ko nhớ rõ lắm.
không chừng bác dùng hàm vẽ lại circle đó rồi xoá cái cũ đi cũng dễ hơn.
dạ vâng,vì ngại làm phiền các bác nên em đã tìm hiểu kĩ lắm rồi bác ạ.Nhưng kiến thức về lisp của em còn quá ít nên không làm nổi nữa bác ạ.Với mấy cái hàm bình thường em cũng còn kém,sang đến mấy cái hàm vla- lại càng mù tịt,trên mạng em thấy ít nói đến,có nói đến lại thây chủ yếu bằng tiếng anh,em mò mẫm hết khả năng mình có thể nghĩ ra nhưng cũng không ăn thua.Không nghĩ được ra cách gì mới ,em mới lại phải nhờ đến các bác viết giúp chứ trước đó em đã mất 2-3 ngày ngồi tự tìm cách rồi,sau có tư vấn của 2 bác lại thêm một buổi trưa nữa nhưng cũng chẳng ra,mà cũng hết khả năng em có thể thử rồi ạ.hì
-
1 giờ trước, ngokiet đã nói:Bạn chuyển layer thì nó chuyển layer là đúng rồi. Còn chuyển các thứ khác thì phải dùng lệnh tương ứng. Như vla-put-color/linetype/lineweight để set thêm.
Mình thường sài entmod để chuyển 1 lần tất cả thông số thì khoẻ hơn.
1 giờ trước, ndtnv đã nói:Dùng các hàm:
vla-get-Color , vla-put-Color
vla-get-Linetype , vla-put-Linetype
vla-get-LineWeight , vla-put-LineWeightBiến hệ thống tương ứng:
CECOLOR , CELTYPE , CELWEIGHT
cảm ơn hai bác đã quan tâm ạ!sau khi có sự tư vấn của 2 bác,em tìm hiểu thêm về các hàm này nhưng em mới tập tành code nên vẫn không ra và chạy bị lỗi ạ.
em đã thử mò mẫm cho đoạn này vào :
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer")) (vla-put-Color x (getvar "CECOLOR")) (vla-put-Linetype x (getvar "CELTYPE")) (vla-put-LineWeight x (getvar "CELWEIGHT")) ) entlst1);(mapcar '(lambda (x) (vla-put-Color x (vla-get-Color (getvar "CECOLOR"))) ) entlst1) ..... nhưng nó sai hết.
trước em có thử cho câu lênh này vào : (command "change" "L" "" "p" "LA" (getvar "clayer") "c" "bylayer" "LT" "bylayer" "LW" "bylayer" "" "") nó chạy được nhưng nó chạy rất chậm ,sau đó nếu làm sai mà muốn undo lại thì nó lướt qua từng đường tròn một và phải rất lâu mới undo hết,hơn nữa chỉ viết được cho trường hợp 1 là đưa về by layer còn trường hợp 2 thì không viết được.Các bác có thể viết mẫu giup em cái code của lisp này được không ạ,chứ em cũng làm hết khả năng rồi nhưng hiểu biết còn quá ít nên khả năng là không viết nổi bằng các hàm này ạ.Em cảm ơn các bác trên diễn đàn ạ!
Hỏi về cách cài đặt dòng command line
trong Sử dụng AutoCAD
Đã đăng · Trả lời báo cáo
Diễn đàn cho em hỏi,trong cad 2012 có cách nào cài đặt cho dòng command line trong suốt không ạ?Em thấy cad đời cao có thể làm cho dòng command line trong suốt nhưng em không biết cad 2012 có thể cài đặt như thế không.em cảm ơn mọi người ạ!(hoặc có thể chỉ cho em trong cad đời cao thì vào chỗ nào để cài đặt cho dòng command line trong suốt ở các phiên bản khác cad 2012 cũng được ạ)