whatcholingon 45 Báo cáo bài đăng Đã đăng Tháng 7 31, 2013 Chào mọi người! Vấn đề của mình như sau: Trong bản vẽ của mình có 3 đối tượng text 1 là text chữ 2 là text số nguyên 3 là text số có số lẻ đằng sau 3 text này giờ đang cùng 1 layer và color giờ mình muốn tách rieng 3 text này thành 3 layer riêng biệt. Mọi người viết giúp mình lsp sau Lệnh đầu tiên để tách text chữ là : LTC Lệnh thứ 2 để tách text số nguyên là: LTN Lệnh thứ 3 để tách text số có số lẻ là: LTP ây là hình minh họa của mình Mong mọi người viết giúp mình, mình đang cần gấp! Thanks all ! Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
Tue_NV 3.912 Báo cáo bài đăng Đã đăng Tháng 7 31, 2013 Bạn dùng lệnh Find là được, cần chi lisp - Chọn và Tìm số thực thì chuỗi tìm -> Find -> nhập kí tự "." -> Select All - Chọn và Tìm CHỮ thì chuỗi tìm -> Find -> nhập kí tự "@" -> Select All - Chọn và Tìm SỐ NGUYÊN thì chuỗi tìm -> Find -> nhập kí tự "~@" -> Select All -> tiếp tục Find -> nhập kí tự "~." -> Select All Chú ý : Option trong lệnh find -> Bỏ dấu tick trong Find whole word only 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
TaiNguyen79 24 Báo cáo bài đăng Đã đăng Tháng 7 31, 2013 Chào mọi người! Vấn đề của mình như sau: Trong bản vẽ của mình có 3 đối tượng text 1 là text chữ 2 là text số nguyên 3 là text số có số lẻ đằng sau 3 text này giờ đang cùng 1 layer và color giờ mình muốn tách rieng 3 text này thành 3 layer riêng biệt. Mọi người viết giúp mình lsp sau Lệnh đầu tiên để tách text chữ là : LTC Lệnh thứ 2 để tách text số nguyên là: LTN Lệnh thứ 3 để tách text số có số lẻ là: LTP ây là hình minh họa của mình Mong mọi người viết giúp mình, mình đang cần gấp! Thanks all ! Của bạn đây : ;tach rieng chu va so (defun c:chu_so (/ SS1 LopT LopN Count Eg) (princ "\nChon cac chu ") (while (null (setq SS1 (ssget (list (cons 0 "Text"))))) (princ "\nChua chon duoc chu ")) (if (= (setq LopT (getstring "\nNhap ten lop se chua cac chu ")) "") (progn (if (null (tblsearch "layer" "so nguyen")) (command "layer" "N" "chu" "")) (setq LopT "chu"))) (if (= (setq LopN (getstring "\nNhap ten lop se chua cac so ")) "") (progn (if (null (tblsearch "layer" "so nguyen")) (command "layer" "N" "so" "")) (setq LopN "so"))) (setq Count 0) (repeat (sslength SS1) (setq Eg (entget (ssname SS1 Count))) (if (numberp (distof (cdr (assoc 1 eg)))) (setq Eg (subst (cons 8 lopN) (assoc 8 Eg) Eg)) (setq Eg (subst (cons 8 LopT) (assoc 8 Eg) Eg)));if (setq Count (1+ Count)) (entmod Eg));repeat (princ)) ;;--------------------- ;;tach lay cac chu mang gia tri la so nguyen (defun c:songuyen (/ SS1 Lopsn Count Eg) (princ "\nChon cac chu ") (while (null (setq SS1 (ssget (list (cons 0 "Text"))))) (princ "\nChua chon duoc chu ")) (if (= (setq Lopsn (getstring "\nNhap ten lop se chua cac so nguyen chon duoc : ")) "") (progn (if (null (tblsearch "layer" "so nguyen")) (command "layer" "N" "so nguyen" ""))(setq Lopsn "so nguyen")));if (setq Count 0) (repeat (sslength SS1) (setq Eg (entget (ssname SS1 Count)) ndung (cdr (assoc 1 eg))) (if (and (numberp (distof ndung)) (= (type (read ndung) ) 'INT)) (setq Eg (subst (cons 8 lopsn) (assoc 8 Eg) Eg)));end if (setq Count (1+ Count)) (entmod Eg));repeat (princ)) ;;--------------------- ;;Tach lay chu co so bat dau (defun c:chu_coso (/ SS1 LopT Count Eg) (princ "\nChon cac chu ") (while (null (setq SS1 (ssget (list (cons 0 "Text"))))) (princ "\nChua chon duoc chu ")) (if (= (setq LopT (getstring "\nNhap ten lop se chua cac chu ")) "") (progn (if (null (tblsearch "layer" "so nguyen")) (command "layer" "N" "Chu co so bat dau" "")) (setq LopT "Chu co so bat dau")));end if (setq Count 0) (repeat (sslength SS1) (setq Eg (entget (ssname SS1 Count))) (if (not (numberp (distof (cdr (assoc 1 eg))))) (if (numberp (distof (substr (cdr (assoc 1 eg)) 1 1))) (setq Eg (subst (cons 8 lopT) (assoc 8 Eg) Eg)))) (setq Count (1+ Count))(entmod Eg))(princ)) Dùng lệnh chu_so để tách riêng chữ và số. Dùng lệnh songuyen để lấy số nguyên :( Nếu muốn chọn địa chỉ thửa đất thì dùng lệnh chu_coso để tách lấy những chũ có số bắt đầu P/S : Bạn có thể cứ bấm enter không cần trả lời . chương trình sẽ tự tạo ra các lớp tạm để chứa các chữ tìm đc 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
Doan Van Ha 3.200 Báo cáo bài đăng Đã đăng Tháng 7 31, 2013 Nên gộp 3 lệnh thành 1 lệnh chung, và chỉ chọn đối tượng 1 lần cho cả 3 nhóm. 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
whatcholingon 45 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 Cám ơn mọi người đã quan tâm và giúp đỡ: - Mình làm theo Mr Tue chỉ thì chỉ tìm được các đối tượng có dấu "." và chỉ tìm từng đối tượng một chọn tất cả các đối tượng có dấu "." thif không được còn tìm số nguyên và số thực thì mình lại không hiểu lắm nên làm không được. mình có nhập @ nhưng không chọn được đối tượng nào cả. - Còn lsp của Mr TaiNguyen79 thì mình chỉ thực hiện được lệnh lọc text chữ đưa về layer riêng (chu_so) còn lệnh (songuyen) thì báo lỗi sau: ; error: bad argument value: positive 0 lệnh (chu_coso) thì thực hiện xong thì các đối tượng vẫn vậy không có thay đổi gì cả. Mong bạn kiểm tra lại mình. - Ý của Mr Ha rất hay nếu có thể đưa về 1 lệnh mà khi thực hiện Lsp hỏi cần chọn đối tượng nào thì quả là tuyệt. nếu có thể bạn viết luôn cho mình! Thanks all! Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
Tue_NV 3.912 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 Cám ơn mọi người đã quan tâm và giúp đỡ: - Mình làm theo Mr Tue chỉ thì chỉ tìm được các đối tượng có dấu "." và chỉ tìm từng đối tượng một chọn tất cả các đối tượng có dấu "." thif không được còn tìm số nguyên và số thực thì mình lại không hiểu lắm nên làm không được. mình có nhập @ nhưng không chọn được đối tượng nào cả. ....... Thanks all! Bạn đã làm công việc chú ý này chưa? ....... Chú ý : Option trong lệnh find -> Bỏ dấu tick trong Find whole word only Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
whatcholingon 45 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 Mình có kiểm tra dòng đó, trong cad của mình dòng đó trống không có đánh dấu. Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
whatcholingon 45 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 Mình nhập @ thì nó hiểu rùi ( lúc trước mình chưa tích vào ô Use wildcards) nhưng thực hiện được cũng chỉ là tìm từng đối tượng chứ nó không chọn toàn bộ và tách riêng ra thành 1 layer khác cho mình nhập tìm chữ thì nó tìm từng chữ một trong một text chữ. nhập tìm số nguyên thì nó tìm cả số thực lẫn số nguyên. bạn nhìn ở hình ảnh của mình đưa lên đó nó có 3 đối tượng riêng biệt như vậy. trong bản vẽ thì nó có nhiều đối tượng như vậy bây giờ cần phải tách từng text riêng text: loại đất là text chữ text: số nguyên là số thứ tự thửa đất text : số thực là diện tích của thửa đất. Thanks! Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
Doan Van Ha 3.200 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 Bạn gởi bản vẽ lên tớ mần cho. Và bạn thích tách thành 3 layer có tên là gì? X, Y, Z? Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
whatcholingon 45 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 File đây bạn: http://www.cadviet.com/upfiles/3/96857_a.dwg Layer text chữ là LOAIDAT Layer text số nguyên là: SOTHUA Layer text số thực là: DIENTICH Thanks! Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
Doan Van Ha 3.200 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 Lisp tách 3 đối tượng của layer thửa đất thành 3 layer khác nhau: symbol -> "LOAIDAT" ; integer -> "SOTHUA" ; real -> "DIENTICH". ;; Tach 3 doi tuong cua layer thua dat thanh 3 layer khac nhau: symbol, integer, real. ;; Doan Van Ha - CadViet.com - ngay 01/8/2013 (defun C:HA ( / MakeLayer txt) (defun MakeLayer (name color) (if (not (tblsearch "Layer" name)) (entmakex (list '(0 . "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 name) (cons 70 0) (cons 62 color))))) (mapcar '(lambda(x y) (MakeLayer x y)) (list "LOAIDAT" "SOTHUA" "DIENTICH") '(1 2 3)) (princ "\nChon cac doi tuong Text can phan lop...") (ssget '((0 . "TEXT"))) (vlax-for obj (vla-get-activeselectionset (vla-get-ActiveDocument (vlax-get-acad-object))) (if (= (setq txt (type (read (cdr (assoc 1 (entget (vlax-vla-object->ename obj))))))) 'SYM) (progn (vla-put-Layer obj "LOAIDAT") (vla-put-Color obj 1)) (if (= txt 'INT) (progn (vla-put-Layer obj "SOTHUA") (vla-put-Color obj 2)) (progn (vla-put-Layer obj "DIENTICH") (vla-put-Color obj 3)))))) 3 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
whatcholingon 45 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 cám ơn Mr Ha rất nhiều. mình không nghĩ là lsp này tuyệt vời đến vậy. chỉ cần 1 thao tác là xong. Thanks! Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
TaiNguyen79 24 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 Cám ơn mọi người đã quan tâm và giúp đỡ: - Mình làm theo Mr Tue chỉ thì chỉ tìm được các đối tượng có dấu "." và chỉ tìm từng đối tượng một chọn tất cả các đối tượng có dấu "." thif không được còn tìm số nguyên và số thực thì mình lại không hiểu lắm nên làm không được. mình có nhập @ nhưng không chọn được đối tượng nào cả. - Còn lsp của Mr TaiNguyen79 thì mình chỉ thực hiện được lệnh lọc text chữ đưa về layer riêng (chu_so) còn lệnh (songuyen) thì báo lỗi sau: ; error: bad argument value: positive 0 lệnh (chu_coso) thì thực hiện xong thì các đối tượng vẫn vậy không có thay đổi gì cả. Mong bạn kiểm tra lại mình. - Ý của Mr Ha rất hay nếu có thể đưa về 1 lệnh mà khi thực hiện Lsp hỏi cần chọn đối tượng nào thì quả là tuyệt. nếu có thể bạn viết luôn cho mình! Thanks all! Mình đã sủa lisp lại rồi.Nhưng mình không thích gộp lại để rời còn làm đc việc khác. 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
TaiNguyen79 24 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 Lisp tách 3 đối tượng của layer thửa đất thành 3 layer khác nhau: symbol -> "LOAIDAT" ; integer -> "SOTHUA" ; real -> "DIENTICH". ;; (if (= (setq txt (type (read (cdr (assoc 1 (entget (vlax-vla-object->ename obj))))))) 'SYM) Bạn DVH chú ý hàm read 1 chút nếu không những chữ mà bắt đầu bởi 1 số sẽ bị chọn thành số . Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
Doan Van Ha 3.200 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 Bạn DVH chú ý hàm read 1 chút nếu không những chữ mà bắt đầu bởi 1 số sẽ bị chọn thành số . Tôi biết. Tôi cũng hiểu cách ghi kí hiệu thửa đất nữa. Những chữ dù có số nhưng có chứa ký tự khác số thì nó không phải là số bạn ạ. Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
Tue_NV 3.912 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 Nếu như chẳng may trên bản vẽ, trong đống text có chứa chữ có "." thì lisp bác HA sẽ...... KL: Không nên dùng hàm (read....... trong TH này Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
Doan Van Ha 3.200 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 Nếu như chẳng may trên bản vẽ, trong đống text có chứa chữ có "." thì lisp bác HA sẽ...... KL: Không nên dùng hàm (read....... trong TH này Nếu như chẳng may trên bản vẽ có 1 text trời ơi "1234567890" bị chọn mà không phải số thửa? Nếu như trên bản vẽ có những text trời ơi khác? Những bài toán như thế này không có lisp tuyệt đối đúng nỗi! User phải tự xử thôi, chứ không read cũng vẫn không giải quyết triệt để. Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
TaiNguyen79 24 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 Tôi biết. Tôi cũng hiểu cách ghi kí hiệu thửa đất nữa. Những chữ dù có số nhưng có chứa ký tự khác số thì nó không phải là số bạn ạ. Dòng chứa địa chỉ thửa đất có các chữ bắt đầu bằng số đó bạn. VD read "2 Lê Lợi" = 2 (INT) Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
Doan Van Ha 3.200 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 1). Trích giải thích của chủ topic. text: loại đất là text chữ text : số thực là diện tích của thửa đất. text: số nguyên là số thứ tự thửa đất 2). Dù là "loại đất" hay "số thứ tự thửa" hay "diện tích thửa" thì cũng không thể "2 Lê Lai" được. Bạn kiếm đâu ra trên bản vẽ? Còn bạn thích giải quyết triệt để thì xin mời! Tôi chỉ có thể giải quyết được y/c của chủ top thôi, chứ bài toán tổng quát thì bó tay. Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
KangKung 250 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 Bác Hạ thay hàm read bằng distof và dùng thêm hàm if nữa là giải quyết xong bài toán. Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
Doan Van Ha 3.200 Báo cáo bài đăng Đã đăng Tháng 8 1, 2013 Lý do là không có text "2 abc" và không có text "." nên không cần thay. Còn khi có cả 2 hoặc nhiều hơn nữa thì có thay read cũng không thể giải quyết triệt để những bài toán kiểu này. Tôi hiểu tất cả những điều mà mọi người đã comment ở trên. Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
thanhduan2407 272 Báo cáo bài đăng Đã đăng Tháng 9 22, 2014 Bác Hạ thay hàm read bằng distof và dùng thêm hàm if nữa là giải quyết xong bài toán Anh KangKung hoặc các bác có thể hoàn thiện lisp này được không nhỉ? Em cũng mày mò chút nữa. :D Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
thanhduan2407 272 Báo cáo bài đăng Đã đăng Tháng 9 22, 2014 Em đã dùng cách này để tách (defun C:TTD (/ ss ss1 ss2 e1 e2 txt);;;;;TACH THUA DAT (MakeLayer_ "LOAIDAT" 1) (MakeLayer_ "SOTHUA" 2) (MakeLayer_ "DIENTICH" 3) (setq ss (ssget (list (cons 0 "TEXT")))) (setq ss2 (ChonTextSo ss)) (setq sstemp (LM:ListDifference (acet-ss-to-list ss) (acet-ss-to-list ss2))) (setq ss1 (vl-remove nil (mapcar '(lambda(x) (if (or (= (strlen (acet-dxf 1 (entget x))) 2) (= (strlen (acet-dxf 1 (entget x))) 3)) x nil)) sstemp))) (foreach e1 ss1 (vla-put-Layer (vlax-ename->vla-object e1) "LOAIDAT") ) (foreach e2 (acet-ss-to-list ss2) (setq txt (type (read (cdr (assoc 1 (entget e2)))))) (if (= txt 'INT) (vla-put-Layer (vlax-ename->vla-object e2) "SOTHUA") (vla-put-Layer (vlax-ename->vla-object e2) "DIENTICH") ) ) (princ) ) (defun ChonTextSo (ss / i ent str ss1) (progn (setq i 0 ss1 (ssadd) ) (repeat (sslength ss) (setq ent (ssname ss i) str (cdr(assoc 1 (entget ent))) i (+ 1 i) ) (if (distof str 2) (ssadd ent ss1) ) ) (if (> (sslength ss1) 0) ss1 ) ) ) (defun MakeLayer_ ( name colour /) (if (null (tblsearch "LAYER" name)) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(70 . 0) (cons 2 name) (cons 62 colour) ) ) ) ) (defun LM:ListDifference ( l1 l2 ) (if l1 (if (member (car l1) l2) (LM:ListDifference (cdr l1) l2) (cons (car l1) (LM:ListDifference (cdr l1) l2)) ) ) ) Các bác cho em lời nhận xét nhé Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
nhoclangbat 392 Báo cáo bài đăng Đã đăng Tháng 9 22, 2014 hihi ko pit anh Thanhduan2407 còn nhớ cái y/c viết lsp của nhoc hồi mới tham gia 4rum ko nhỉ, anh chê nhoc trình bày ko trong sáng đó ^^, nhìn qua y/c của bạn này thấy cũng hao hao giống y/c của nhoc hồi đó. anh Ket với anh HHVD có giúp nhoc hoàn thiện ^^. - lsp a nhoc thử nếu loai đất có số hình như nó ko hiểu nên ko chuyển được layer - lsp a Ket với HHVD giúp nhoc nó chuyễn đc lun, nhưng điểm yếu của lsp là phải xác định trước layer cần chuyển trong lsp, nên nhoc có set thêm user nhập tên layer, anh xem thử có thể kết hợp sao đó để ko cần xác định trước layer chỉ cần quyét phát hết chuyển đc lun tì tốt quá ạ :) ;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/67432-yeu-cau-lsp-tach-1-nhom-layer-thanh-nhieu-layer-khac-nhau/page-2 (defun dxf (code e) (cdr (assoc code (entget e)))) (defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES) (setq PROPERTIES (entget ENTITY)) (setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES)) (entmod PROPERTIES) ) (defun CreatLayer(MyLayer / MyColor) (if (not (tblsearch "LAYER" MyLayer)) (progn (entmakex (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 70 0) (cons 2 MyLayer) ) ) ) ) ) (defun ChangeLayer(kq / i dt type_dt) (repeat (setq i (sslength kq)) (setq dt (ssname kq (setq i (1- i)))) (setq type_dt (type (read (dxf 1 dt)))) (cond ((= type_dt 'INT) (PUT-GC "SOTHUA" 8 dt)) ((= type_dt 'REAL) (PUT-GC "DIENTICH" 8 dt)) ((= type_dt 'SYM) (PUT-GC "LOAIRUONGDAT" 8 dt)) ) ) ) (defun c:tachthua (/ ss el qa kq i as) (vl-load-com) (CreatLayer "SOTHUA") (CreatLayer "DIENTICH") (CreatLayer "LOAIRUONGDAT") (setq as (getstring "\nnhap ten layer can tach:")) (setq ss (ssget (list (cons 8 as))) kq (ssadd)) (setq qa (getvar 'QAFLAGS)) (setvar 'QAFLAGS 1) (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i)))) (setq dxf0 (dxf 0 e)) (cond ((= dxf0 "TEXT") (ssadd e kq)) ( (= dxf0 "INSERT") (progn (setq el (entlast)) (command "explode" ss "") (while (setq en (entnext el)) (if (= (dxf 0 en) "TEXT") (ssadd en kq)) (setq el en) ) ) ) ) ) (setvar 'QAFLAGS qa) (ChangeLayer kq) (princ "\nHochoaivandot - Cadviet.com") (princ) ) Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
thanhduan2407 272 Báo cáo bài đăng Đã đăng Tháng 9 22, 2014 hihi ko pit anh Thanhduan2407 còn nhớ cái y/c viết lsp của nhoc hồi mới tham gia 4rum ko nhỉ, anh chê nhoc trình bày ko trong sáng đó ^^ Không biết ngày xưa mình nói gì để bạn nhoclangbat giận mình nhỉ? Chắc là làm điều gì mang tính tiêu cực nên mình mới nói là ko trong sáng. ^^ (có thể là bịa số liệu. Hehehehe) Lisp của mình gửi lên đã làm được rồi mà, không cần chọn layer trước. Tuy nhiên thì lisp của mình và lisp của nhoclangbat đều không giải thích được vì sao quét với số lượng nhiều lại không thực hiện được. Gửi Lisp của mình và file test để bạn thử nhé! (defun C:TTD (/ ss ss1 ss2 e1 e2 txt);;;;;TACH THUA DAT (MakeLayer_ "LOAIDAT" 1) (MakeLayer_ "SOTHUA" 2) (MakeLayer_ "DIENTICH" 3) (setq ss (ssget (list (cons 0 "TEXT")))) (setq ss2 (ChonTextSo ss)) (setq sstemp (LM:ListDifference (acet-ss-to-list ss) (acet-ss-to-list ss2))) (setq ss1 (vl-remove nil (mapcar '(lambda(x) (if (or (= (strlen (acet-dxf 1 (entget x))) 2) (= (strlen (acet-dxf 1 (entget x))) 3)) x nil)) sstemp))) (foreach e1 ss1 (vla-put-Layer (vlax-ename->vla-object e1) "LOAIDAT") ) (foreach e2 (acet-ss-to-list ss2) (setq txt (type (read (cdr (assoc 1 (entget e2)))))) (cond ((= txt 'INT) (vla-put-Layer (vlax-ename->vla-object e2) "SOTHUA") ) ((= txt 'REAL) (vla-put-Layer (vlax-ename->vla-object e2) "DIENTICH") ) ) ) (princ) ) (defun ChonTextSo (ss / i ent str ss1) (progn (setq i 0 ss1 (ssadd) ) (repeat (sslength ss) (setq ent (ssname ss i) str (cdr(assoc 1 (entget ent))) i (+ 1 i) ) (if (distof str 2) (ssadd ent ss1) ) ) (if (> (sslength ss1) 0) ss1 ) ) ) (defun MakeLayer_ ( name colour /) (if (null (tblsearch "LAYER" name)) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(70 . 0) (cons 2 name) (cons 62 colour) ) ) ) ) (defun LM:ListDifference ( l1 l2 ) (if l1 (if (member (car l1) l2) (LM:ListDifference (cdr l1) l2) (cons (car l1) (LM:ListDifference (cdr l1) l2)) ) ) ) http://www.cadviet.com/upfiles/3/36665_file_test.dwg 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
