nguyentuyen6
-
Số lượng nội dung
212 -
Đã tham gia
-
Lần ghé thăm cuối
-
Ngày trúng
3
Bài đăng được đăng bởi nguyentuyen6
-
-
Bạn sửa dòng này là đc:
(command "text" "j" "mc" p2 txt 0 (rtos w 2 0) \e) ;Sá»a giúp em Ä‘oạn nà y
(command "layer" "s" "text" "")
(command "text" "j" "mc" p3 txt 0 (rtos h 2 0) \e) ;Sá»a giúp em Ä‘oạn nà y
-
2
-
-
Chào bác Phamngoctukts,Lisp của bác chạy đúng trong trường hợp các text được nhập đúng với trình tự hàng lối.
Bác nên bổ sung thêm vào hàm so sánh lambda trường hợp các text tuy có cùng tọa độ x của điểm chèn nhưng tọa độ y thay đổi không theo quy luật bác ạ.
Bác có thể tahm khảo lisp sắp xếp đối tượng của bác Hoành sẽ rõ.
Chúc bác vui.
Bác nói đúng chỗ ngứa của em. Lúc đầu em cũng định làm gộp cả toạ độ x và y mà loay hoay 1 lúc với lambda vẫn không ra. Bác cho e cái link kia với. E tim không thấy, hêh
-
Nhờ các bác viết giùm e lisp đánh số thứ tự như file e gửi sau.Chân thành cảm ơn các bác trước.Mình mới làm xong cái làm từ phải sang trái, ban dùng thử nhé:
Bạn lưu ý là điểm đặt của text phải thẳng hàng nhé, lệch 1 tí là nó ghi sai luôn, hehe
(defun c:dstt (/ i n ss lst thay stt) ;==== ;nguyentuyen6 @ CadViet (setq ss (ssget '((0 . "TEXT"))) lst (ss2ent ss) lst (vl-sort lst '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2))) ) ) ) ) ;==== (setq i 0 n 1 ) (while (< i (sslength ss)) (setq thay (itoa n) stt (nth i lst) ) (moddxf 1 thay stt) (setq i (1+ i)) (setq n (1+ n)) ) ) (defun moddxf (dxf chdxf ss) (entmod (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss)))) (defun ss2ent (ss / sodt index lstent) (setq sodt (if ss (sslength ss) 0) index 0 ) (repeat sodt (setq ent (ssname ss index) index (1+ index) lstent (cons ent lstent) ) ) ;(reverse lstent) )
Còn cái từ trái sang phải bạn thay dòng này là đc:
Thay:
(lambda (e1 e2)
(<
(cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))
Thành :
(lambda (e1 e2)
(>
(cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))
Bác nào giúp e gộp thành 1 líp với, hjx
-
1
-
-
Các bạn giúp mình một lisp tự động nối những text có vị trí gần nhau hơn một khoảng định sẵn thành 1 text không bạn ? những text gần nhau tự nối với nhau và không nối với text khác!Đại ý là:
Mình nhập lệnh gọi lip
Quét chuột toàn bộ bản vẽ
nhập khoảng cách text gần nhau dưới khoảng đó thì tự nối
enter
Vậy là text tự động được nối lại.
Ví dụ : bản vẽ của mình có rất nhiều 4 text gần nhau có dạng như: "MCB" "3P" "32A" "10kA" cùng mô tả về một thiết bị sẽ được nối thành các text "MCB 3P 32A 10kA". Sau đó mình thực hiện lisp đếm text của bạn gia_bach trên diễn đàn sẽ thống kê được số lượng và chủng loại thiết bị trong bản vẽ.
http://www.cadviet.com/upfiles/3/mcb.dwg
Thanks!:)
Mình thấy cái này nhiều text làm được chắc cũng vất vả lắm. Nó phải xét k/c từ nó đến các text còn lại. nếu có n text thì phải xét n! trường hợp,. ặc ặc
-
Đổ oan cho hàm lambda tội lắm.Lý do :
Thay dòng :
(vl-sort ltn
(function (lambda (e1 e2)
(< (car e1) (car e2)) ) )
)
Thanh dòng :
(setq ltn (vl-sort ltn
(function (lambda (e1 e2)
(< (car e1) (car e2)) ) )
)
)
Hixx. Cảm ơn 2 bác nhiều lắm!!!!
Em quên mất chưa setq cho nó, hì hì. nên lúc princ ra nó in lại cái hàm lúc chưa sắp xếp.
-
Hì. E xin đính chính lại là sắp theo trục y từ thấp đến cao. Nhưng lại có 1 vấn đề ở hàm lambda.
Ở trên là em dùng nó với 2 đối số. với chọn 2 text thì cho kq đúng. nhưng chọn nhiều hơn sẽ ra sai. Như trên là hàm lambda nó xét theo từng cặp phải ko ạ. và cách giải quyết để cái list dùng hàm vl-sort sẽ cho ra kết quả sắp xếp từ thấp đến cao????( với list nhiều hơn 2)
-
E đã thử theo bác và viết ra đc cái sắp xếp đc entname theo trục Y từ cao xuống thấp. Nhưng sao kết quả trả về lại bị in ra 2 lần vậy bác nhỉ.
(defun c:tt(/ i ltn name_textnguon diemdat dxf_tn) (setq ltn '() i 0) (setq textnguon (ssget)) (while (< i (sslength textnguon)) (setq name_textnguon (ssname textnguon i) ; lay entname dxf_tn (entget name_textnguon);lay dxf diemdat (cadr (cdr (assoc 10 dxf_tn))); lay diem dat text lst_entname_diemdat (list diemdat name_textnguon); tao list ) (setq ltn (append ltn (list lst_entname_diemdat))) (setq i (1+ i)) );while ;;;;;------- (vl-sort ltn (function (lambda (e1 e2) (< (car e1) (car e2)) ) ) ) (princ ltn) )Em thấy cái hàm vl-sort nó ghi là bỏ những kq trùng nhau mà.
-
Mong mọi người giúp em:File cad đây ạ : http://www.mediafire.com/?77zyr67zh7jfh62
Em cám ơn mấy anh trước.
Líp 1:
(defun c:ss (/ dt1 dt2 p1 p2 p3 p4 p31 p32) (command "undo" "be") (setq dt1 (car (entsel "\n Chon doan thang dau tien: ")) p1 (cdr (assoc 10 (entget dt1))) p2 (cdr (assoc 11 (entget dt1))) ) (setq dt2 (car (entsel "\n Chon doan thang thu 2: ")) p3 (cdr (assoc 10 (entget dt2))) p4 (cdr (assoc 11 (entget dt2))) ) (BatDau) (command "move" dt2 "" p3 p1) (setq p31 (cdr (assoc 10 (entget dt2))) p41 (cdr (assoc 11 (entget dt2))) ) (command "rotate" dt2 "" p31 "R" p31 p41 p2) (command "move" dt2 "" p1 p3) (KetThuc) (command "undo" "e") ) (defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0)) (defun KetThuc() (setvar "osmode" OldOs))Líp 2 : mình thấy bạn dùng lệnh copy có khi còn nhanh hơn là du`ng lisp.
-
Các bác cho em hỏi 1 câu:
Em có 1 tập chọn TEXT = hàm ssget
Làm sao để lấy được 1 list entname của tất cả text. mà trong List đó entname đc sắp xếp lần lượt từ cao xuống thấp dần của tập chọn text đó. (điểm để so sánh cao và thấp là dựa vào điểm chèn của text đó. VD: trong trường hợp từ cao đến thấp là dựa vào tọa độ Y còn từ trái sang phải là dựa vào tọa độ X)
-
Cái của bạn khá hay nhưng nếu xử lý theo cách chọn chuỗi là ok ???Thân !
MÌnh không hiểu ý bạn hỏi lắm !!!!!
-
-
xin lisp vẽ thép mũ
trong AutoLisp
Bạn posst cái file líp của bạn lên rồi mọi người sửa dum` cho. chứ nói chay thế này thì...hê hê
-
Xin chào mọi người, mình có một vấn dề cần mọi người giúp đỡ: mình cần tách 1 đoạn text gồm nhiều từ thành nhiều đoạn nhỏ, ví dụ mình có 1 câu viết bằng Dtext : "Dien dan cadviet rất hữu ích" Giờ mình muốn chia câu đó thành 3 câu riêng biệt là " Dien dan" ; "cadviet" ; "rất hữu ích"Mọi người có cách nào giúp mình với,vì mình cần tách câu với một khối lượng khổng lồ, cứ copy rồi edit chắc mình chết mất. Rất cám ơn mọi người
Mình thấy cách này thì đỡ phải viết thêm líp này.
Chọn cái DTEXT rồi dùng cái líp Convert TEXT to MTEXT của EXPRESS TOOL. Rồi vào cái mtext đấy muốn chia đến đâu thì ấn Ẻnter cho nó xuống dòng. Thấy vừa ý rồi thì dùng lệnh EXPLODE cái MTEXT ấy đi là nó biến thành Dtext rồi.
-
uhm bạn đã sừa rồi sao không up lên cho mình chứ lisp cũ của bạn mình sử dụng không được.thanks trướcMình sửa trực tiếp vào đấy luôn mà!! Bạn kiểm tra xem đã cài EXPRESS TOOL chưa nhé. Phải có mới chạy đc
-
Chào bạn nguyentuyen6,Nó báo lỗi thế nào hử bạn???
Rất cám ơn bạn về cái hàm (acet-ent-midpoint... )
HÌ em cũng đi mót như bác thôi mà. Còn cái lỗi lúc nãy chắc là em dùng thừa " " trong lissp như bác tu nói. để em kiểm tran lại trong các lissp khác của em, hì hì.
Đây là các hàm em acet mót đc:
* (acet-ent-geomextents ename): Hàm trả về 1 list có 2 tọa độ ll và ur (bên trái dưới và bên phải trên) của 1 đối tượng có tên ename, giống như hàm (vla-GetBoundingBox obj 'MinPoint 'MaxPoint) nhưng dễ sử dụng hơn vì listpoint của acet-ent-geomextents không nằm trong safearray.
* (acet-geom-list-extents lst): Hàm trả về 1 list có 2 phần tử đầu và cuối trong list lst
* (acet-layer-locked lay): Hàm kiểm tra layer "lay" có bị khóa hay không. Nếu có bị khóa, hàm trả về tên của layer này.
* (acet-explode ss)
Hàm làm nổ các đối tượng trong tập hợp chọn ss
* (acet-ss-endel ss)
Hàm xóa các đối tượng trong tập hợp chọn ss
* (acet-ss-zoom-extents ss)
Hàm zoom-extents tập hợp chọn ss và trả về listpoint của 2 điểm LL và UR của tập hợp chọn ss
* (acet-list-to-ss (list en))
Hàm trả về tên tập hợp chọn của list ename
* (acet-geom-midpoint p1 p2)
Hàm trả về tọa độ điểm giữa của 2 điểm p1 p2
* (acet-geom-vertex-list en)
Hàm trả về listpoint tọa độ các nút của LWPOLYLINE, POLYLINE. Nếu LWPOLYLINE, POLYLINE kín listpoint sẽ có thêm 1 điểm đầu ở cuối listpoint
Nếu ename là tên của đối tượng SPLINE, hàm trả về listpoint của các controlpoint
* (acet-geom-intersestwith en1 en2 flag)
Hàm trả về listpoint tọa độ các điểm giao của 2 đối tượng en1 en2.
flag là số interger, cờ quy định các kiểu giao:
- 0: không mở rộng 2 đối tượng en1 en2
- 1: mở rộng đối tượng en1, không mở rộng đối tượng en2.
- 2: không mở rộng đối tượng en1, mở rộng đối tượng en2.
- 3: mở rộng 2 đối tượng en1 en2
-
2
-
-
Hì e đã sửa!!!
-
HÌ!! bạn thử cái này xem có vừa ý không nhé
(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0)) (defun KetThuc() (setvar "osmode" OldOs)) (defun c:sct (/ OldOs OldEcho tile en pt1 pt2 mid i Rec) (setq i 0) (princ "\nChon Doi tuong Scale tai tam:") (setq ss (ssget)) (setq tile (getreal "\nChon tile Scale:")) (while (< i (sslength ss)) (setq en (ssname ss i)) (setq Rec (acet-ent-geomextents en) pt1 (nth 0 Rec);lay dinh pt2 (nth 1 Rec);lay dinh mid (acet-geom-midpoint pt1 pt2) );setq (BatDau) (command "SCALE" en "" mid tile ) (KetThuc) (setq i (1+ i)) );while (princ "\n...Done...") (princ) );defunTại cái TÂM của bạn nó khó xác định quá nên mình dùng cách này nhé!!!
Tiện đây mình hỏi luôn: cái Hàm acet-ent-geomextents tại sao nó vẫn thực hiện mà cứ báo lỗi nhỉ
Mình dùng hàm acet-ent-geomextents để xác định tâm.
Tốt nhất bạn Block từng đối tượng muốn scale vào để đc chính xác!!!
-
1
-
-
Bạn thử lại cái này nhé. hì
(defun c:tt(/ ltt i text2 el el2 text str str2 n) (setq ltt '() i 0 n 0 text2 nil) (while (and (setq textthay (car(entsel"\nChon text lay noi dung:"))) (/= textthay "")) (setq el (entget textthay) str (cdr (assoc 1 el))) (setq ltt (append ltt (list str))) (princ str) (setq n (1+ n)) ) (reverse ltt) (princ ltt) (princ (strcat "\nSo doi tuong nguon la: " (rtos n 2 0) " ")) (while (and (= text2 nil) (> n i)) (setq text2 (car(entsel"\nChon text thay:")) stt (nth i ltt);lay stt );setq ( moddxf 1 stt text2) (setq text2 nil) (setq i (1+ i)) (princ (strcat "\nBan da chon: "(rtos i 2 0) "/"(rtos n 2 0)" ")) ) (while (= n i) (alert "\n Het nguon ") (setq n nil ) ) (princ) ) (defun moddxf (dxf chdxf ss) (entmod (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))))
Làm ngược là vì mình thấy viết sẽ phức tạp hơn bạn ạ, nên đành phải như thế này, bạn thông cảm nhé!!
p/s: mình vừa thêm mấy cái thông báo theo ý của bạn.
-
2
-
-
Bạn thử cái này nhé:
(defun c:tt(/ ltt i text2 el el2 text str) (setq ltt '() i 0 text2 nil) (while (and (setq textthay (car(entsel"\nChon text lay noi dung: "))) (/= textthay "")) (setq el (entget textthay) str (cdr (assoc 1 el))) (setq ltt (append ltt (list str))) (princ str) ) (reverse ltt) (princ ltt) (while (= text2 nil) (setq text2 (car(entsel"\nChon text thay: ")) el2 (entget text2) stt (nth i ltt);lay stt );setq ( moddxf 1 stt text2) (setq text2 nil) (setq i (1+ i)) ) (princ) ) (defun moddxf (dxf chdxf ss) (entmod (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))))-
2
-
-
Em sửa đc rồi bác tue à. he. tại e ẩu quá..
-
hì hì!!!
@ bác tu:
Cách của bác hay thật. nhưng e muốn nó chạy ở bất cứ cái khung tên nào mà ko cần phải vào chỉnh trong block. Nhỡ đâu lúc có người dùng lisp này lại không biết là phải đặt cái rectang đó ở 1 layer nhất định thì nó ko chạy đc.
@bác Thanhbinh:
Thank bác nhiều lắm. Em đang gặm dở con của bác Tue.Nên cũng chưa kịp xem code của bác, Đợi xong con này em sẽ gặm nốt con của bác luôn, hehe
E đang tét thử cái này thấy nó vẽ rectang ko chuẩn, không trùng vào cái rectang đã lấy đc entname kia là sao các bác nhỉ???
(defun bigrec ( blk / plst Ld dsd Ldent blk xp s p e ) ;;Tra ve entname cua rec to nhat vao bien entrecblk (vl-load-com) (setq plst '() Ld '() ldent '()) (if (vl-cmdf "copy" blk "" '(0 0 0) "@") (setq xp (acet-explode (entlast))) ) (command ".UNDO" "BE") (setq s (cdr (assoc 2 (entget blk)))) (setq p (cdr (assoc 10 (entget blk)))) (setq e (cdr (assoc -2 (tblsearch "BLOCK" s)))) (while e (setq el (entget e)) (setq plst (append plst (list e))) (setq dsd (mapcar 'cdr (vl-remove-if '(lambda(y) (/= (car y) 10)) (entget e)))) (setq Ld '()) (FOREACH x dsd (setq Ld (append Ld (list (list (+ (car x) (car p)) (+ (cadr x) (cadr p)) )))) ) (if (and (wcmatch (cdr(assoc 0 el)) "*POLYLINE") (>= (cdr(assoc 90 el)) 3) (vlax-curve-isClosed e) (null (ssget "WP" Ld)) ) (setq Ldent (append Ldent (list e))) ) (setq e (entnext e)) ) (if (> (length Ldent) 0) (progn (setq Ldent (vl-sort Ldent '(lambda(x y) (> (vla-get-area (vlax-ename->vla-object x)) (vla-get-area (vlax-ename->vla-object y)) ) ) )) (setq entrecblk (car Ldent)) ) ) (command "erase" xp "") (command ".UNDO" "E") ) (defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0)) (defun KetThuc() (setvar "osmode" OldOs)) (defun c:fd (/ Rec blk pt1 pt2 entrecblk i OldOs OldEcho ) (vl-load-com) (setq blk (car (entsel "\nChon block khung ten:"))) (bigrec blk) (setq Rec (acet-ent-geomextents entrecblk) pt1 (nth 0 Rec);lay dinh pt2 (nth 1 Rec);lay dinh i 0);setq ;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai, ve hcn (BatDau) (command "RECTANG" pt1 pt2) ; (command "Line" pt1 pt2) (KetThuc) (princ "\n...Done...") (princ) );defunVà khi di chuyển cái block khung đấy ra chỗ khác thực hiện lại líp thì nó vẫn vẽ cái rectang ở chỗ cũ. E muốn nó chạy theo block cơ. Hjx
-
Đúng rồi bác a, đc rồi!!Lúc chiều E test rồi!!! tại khi em vào trong block dùng hàm (entsel) để xem lại cái entname của cái rectang ý thì nó lại cho khác với cái thông báo của bác. Tại sao vậy bác nhở??
-
Theo mình nghĩ thì bạn lấy entityname của cái rectang đó để lấy toạ độ đỉnh thôi đúng không. Nếu đúng thì có thể áp dụng cách thứ nhất của bác Bình sau khi đã lấy được toạ độ đỉnh thì undo lại. Nếu không phải thì bạn có thể nêu bạn lấy entity của rectang đó làm gì được không.Đúng như bác nghĩ. hehe. E muốn lấy dùng hàm acet-ent-geomextents:diem thap nhat trai va cao nhat phai
-
1.Em làm được rồi nhưng quả thật là rất chậm.Có cách nào để làm nó nhanh hơn được không bác(vẫn select all). :lol:2.Bác có thể giúp em đoạn Code chỉnh width text tất cả thành 0.8 được không.Có thể là Code riêng hoặc ghép cho em vào lisp Artxt.lsp của bác Bình cũng được.
:lol:
Mình làm cái chỉnh tất cả width_factor về 0.8 đc thôi. nhưng chỉ là TEXT thôi nhé. Mtext thì mình chưa làm.
(defun c:8 (/ ssd i el en) (setq ssd (ssget '((0 . "TEXT"))) i 0); loc text (while (< i (sslength ssd)) (setq en (ssname ssd i)) (setq el (vlax-ename->vla-object en)) (vlax-put-property el 'ScaleFactor 0.8) (setq i (1+ i)) ))
-
1
-
Bỏ số 0 đằng sau dấu phẩy khi thực hiện lisp
trong AutoLisp
Đã đăng · Trả lời báo cáo
đây bạn ah:
Bạn thay cả đoạn sau nhé:
;============================================
(setq e1 (entlast))
(prompt "_.change")
(command "_.change" e1 "" "p" "c" "3" "")
(command "offset" 7.5 e1 pause "")
(setq e2 (entlast))
(command "erase" e1 "")
(command "layer" "m" "text" "c" "7" "" "")
(command "layer" "s" "text" "" "")
(command "text" "j" "mc" p1 txt 0 ten )
(setq e3 (entlast))
(command "layer" "s" "text" "")
(command "text" "j" "mc" p2 txt 0 (rtos w 2 1) \e)
(setq e4 (entlast))
(command "layer" "s" "text" "")
(command "text" "j" "mc" p3 txt 0 (rtos h 2 1) \e)
(setq e5 (entlast))
(command "layer" "s" "text" "")
(command "text" "j" "mc" p4 txt 0 "X" )
(setq e6 (entlast))
(command "_.BLOCK" ten pt1 e2 e3 e4 e5 e6 ""
"_.INSERT" ten pt1 1 1 0)
(reset1)
(princ)
)
;-----------------------------------