[ yêu cầu ] lisp lọc các đối tượng trên bản vẽ.

[hg_aum 2]

em chào tất cả các bác,em đang làm bản đồ địa chính và có vấn đề mong các bác giúp em.Trên bản  vẽ của em có các txt cùng một lớp,cùng màu giờ em muốn tự động chọn tất cả chúng, rồi đưa về các lớp theo yêu cầu.Các đối tượng trên có cùng một cấu trúc như sau(không phải là khối):
12
LUC
Nguyễn Văn A
Thôn 3
22
ý nghĩa và yêu cầu
12                   :là số thửa trong bản vẽ nó chạy từ 1 đến n.em muốn chọn chúng rồi đưa vào lớp                                                                                                                      "so thua" trên bản vẽ.
LUC                : là loại đất trên bản vẽ sẽ có nhiều loại nhưng ta sẽ có một danh sách ký hiệu của                                                 chúng(LUC,LUK,LNK....)   và em muốn chọn rồi chuyển                                                                                                        chúng vào lớp "loai dat" trên bản vẽ.
Nguyễn Văn A:  là họ tên người sử dụng đất,em muốn chọn rồi chúng về lớp"chu su dung"trên bản vẽ.
Thôn 3           : là địa chỉ ,tất cả đều giống nhau chỉ khác là số 3 hay 1...ta sẽ chọn và đưa chúng                                                                                                                                      về lớp"dia chi"
22                 :số tờ bản đồ,trong cùng một bản vẽ nó đều giống nhau là 22 tùy vào số tờ bản đồ và                                                                                                                ta sẽ xóa bỏ đối tượng này.

Sau khi  ta đưa được các đối tượng về lớp"so thua" lop"loai dat" lop"dia chi" và xóa bỏ các số 22 thì các txt còn lại chính là lớp"chu su dung" ta có thể chuyển bằng tay.Rất mong  các bác giúp đỡ,em xin chân thành cảm ơn!http://www.cadviet.com/upfiles/3/63415_loc_du_lieu.dwghttp://www.cadviet.com/upfiles/3/63415_danh_sach_loai_dat.txt

[Tue_NV 3.912]

em chào tất cả các bác,em đang làm bản đồ địa chính và có vấn đề mong các bác giúp em.Trên bản  vẽ của em có các txt cùng một lớp,cùng màu giờ em muốn tự động chọn tất cả chúng, rồi đưa về các lớp theo yêu cầu.Các đối tượng trên có cùng một cấu trúc như sau(không phải là khối):

12

LUC

Nguyễn Văn A

Thôn 3

22

.......

 

Chào bạn!

Việc lọc đối tượng với Lisp thì dễ, nhưng khó ở chổ là dựa vào đâu để Lisp nhận dạng 1 cách chính xác thôi

Ví dụ: Số thửa là 22, số tờ bản đồ cũng là 22. Vậy Lisp sẽ dựa vào cái gì để phân biết đâu là số thửa? đâu là số tờ bản đồ??

[hg_aum 2]

Chào bạn!

Việc lọc đối tượng với Lisp thì dễ, nhưng khó ở chổ là dựa vào đâu để Lisp nhận dạng 1 cách chính xác thôi

Ví dụ: Số thửa là 22, số tờ bản đồ cũng là 22. Vậy Lisp sẽ dựa vào cái gì để phân biết đâu là số thửa? đâu là số tờ bản đồ??

cảm ơn anh đã để ý đến vấn đề của em.vấn đề số tờ  bản đồ không quan trọng.Vì trong một bản vẽ  chỉ có một số tờ bản đồ ví dụ là 22.thì tất cả phía dưới các cụm từ đều là số 22 nên ta sẽ không cần dùng lisp nữa,ta sẽ xóa thủ công bằng lệnh Find anh ạ như thế chỉ mất một số thửa là 22 trùng với số tờ bản đồ bị xóa đi thôi ạ.Quan trọng lọc và đưa các số thửa,loại đất,chủ sử dụng và địa chỉ về đúng lớp là ok rồi anh ạ

[quansla 259]

cảm ơn anh đã để ý đến vấn đề của em.vấn đề số tờ  bản đồ không quan trọng.Vì trong một bản vẽ  chỉ có một số tờ bản đồ ví dụ là 22.thì tất cả phía dưới các cụm từ đều là số 22 nên ta sẽ không cần dùng lisp nữa,ta sẽ xóa thủ công bằng lệnh Find anh ạ như thế chỉ mất một số thửa là 22 trùng với số tờ bản đồ bị xóa đi thôi ạ.Quan trọng lọc và đưa các số thửa,loại đất,chủ sử dụng và địa chỉ về đúng lớp là ok rồi anh ạ

Bạn thử Code này xem nào, trình độ viết lisp của mình còn dở lắm về thuật toán thì chắc là rất ngớ ngẩn trước hết cứ đáp ứng nhu cầu của bạn đã, bạn gõ lệnh "THU" (thử) rồi dùng chuột quét chọn hình chữ nhật bao lấy một "cụm Text" mẫu (là cụm gồm đủ 5 Text như bạn đưa ra trên ảnh ý) sau đó nhấn Enter và kiểm tra kết quả.

Chú ý

•  
• Để thay đổi bộ lọc của số hiệu đất bạn tạo một file txt mới với nội dung là : mỗi dòng một loại mã hiệu đất (3 ký tự) và lưu lại vào đâu đó khi sử dụng lisp Ngay bước đầu tiên khi Lisp hỏi bạn là hãy quét chọn  Hình chữ nhật bao bộ lọc thi bạn không chọn điểm nữa mà ấn "S" / enter 
• Cũng ở phần chọn hình chữ nhật bao bộ lọc bạn ấn E lisp sẽ tự thoát 
• Mẹo: để lisp xử lý triệ để nhất bạn hãy chọn hình bao bộ lọc bao toàn bộ Text mẫu (hoặc bao trùm hẳn ra ngoài Text dài nhất là tốt nhất) vì trong Lisp của mình chỉ xử lý các đối tượng nằm trong khung bằng khung chữ nhật quét ban đầu thôi.

hixx, trình độ văn của mình kém lắm lại đang buồn ngủ, nếu quá khó hiểu bạn cmm lại mình làm video sau. Chúc bạn thành công.

Code

(defun c:thu (/ Setlist_dat newlayer  dis dt enti flag1 i loc ls ls1 N p0 p1 p2 pA pB ss ssdt Tvalue x

     *myerr ang1 ang2 dis1 dis2 enti flag1 i line ls olderr p1 p10 p2 ss0 ssdt Tvalue x)

  (defun *myerr (msg);

    (princ "Error: ")(princ msg)

    (princ)

    (if olderr (setq *error* olderr))

    (princ))

 

  (defun newlayer ( a b c d)

(if (not (tblsearch "layer" a))

(command "-layer" "n" a "c" b a "l" c a "lw" d a "")

;(command "-layer" "s" a "c" b a "l" c a "lw" d a "")

)

  )

 

  

  (defun Setlist_dat (/ duondan f ls)

    (setq duondan (getfiled "\nChon file chua danh sach Ma dat" "" "txt" 2)

 ls (list))

    (setq f (open duondan "r"))

    (while (setq line (read-line f))

      (setq ls (append (list line) ls))

      )

    (close f)

    (setq flag1 T)

    (setq #ls ls)

    ls    

    )

  ;;nhap vl-load,tao bo loc "loc" va khoi tao layer can thiet

  (vl-load-com)

  (setq olderr *error* *error* *myerr)

  (newlayer "so thua" 1 "Continuous " 0)

  (newlayer "loai dat" 2 "Continuous " 0)  

  (newlayer "chu su dung" 3 "Continuous " 0)

  (newlayer "dia chi" 4 "Continuous " 0)

  

  (or #ls (setq #ls '("DXH" "PNK" "DNL" "DBV" "SON" "TON" "DCS" "BCS" "ONT" "ODT" "DGD" "NTD" "SKK"

    "SKX" "MVT" "CQP" "DDT" "DTL" "DGT" "TSC" "RPK" "RDT" "RPT" "RST" "RDN" "RPN"

    "RSN" "MNC" "TSN" "TSL" "SKC" "COC" "SKS" "LNK" "LNQ" "LNC" "DVH" "BHK" "DYT"

    "CAN" "DCH" "TSK" "LMU" "TIN" "DTT" "LUK" "LUC" "LUN")))

  (setq ls #ls)

  (setq loc (mapcar '(lambda (x)(cons 1 x))ls))

  (setq loc (append '(( -4 . "<AND"))

   '((0 . "TEXT,MTEXT"))

   '(( -4 . "<OR"))

   loc

   '(( -4 . "OR>"))

   '(( -4 . "AND>"))))

  ;;;ket thuc khoi tao

 

 

  

  (setq flag1 nil)

  (while (null flag1)

      (initget "Setting Exit")

      (setq p1 (getpoint "\nQuet Hinh chu nhat bao bo loc or [setting Exit] <Select>"))

      (cond

( (= p1 "Setting")(setq ls (SETLIST_DAT )))

( (= p1 "Exit")(exit))

( (= 'LIST (type p1))

(progn

  

  (if (setq p2 (getcorner p1)

    ss (acet-ss-to-list(ssget

 "_w"

 p1

 p2

 loc

 ))

    ss0 (car ss))     

    (progn

      (setq flag1 T)

      (setq ang1 (angle (setq p10 (cdr(assoc 10 (entget ss0)))) p1)

    ang2 (angle p10 p2)

    dis1 (distance p10 p1)

    dis2 (distance p10 p2))

      (princ)

      )

    (alert "\nBan da chon vung khong co KH mau dat phu hop\n"))

))

(T (setq flag1 nil)(prompt "\nBan da chon vung khong co DATA phu hop reSected or Exit\n")(princ)))

      )

  (if flag1

    (if (setq ss (acet-ss-to-list(ssget "X" loc)))

      (mapcar '(lambda (x / p10 p1 p2 ssdt)

(setq p10 (cdr(assoc 10 (entget x)))

      p1 (polar p10 ang1 dis1)

      p2 (polar p10 ang2 dis2)

      ssdt (acet-ss-to-list(ssget "_W" p1 p2)))

(foreach i ssdt

  (setq Tvalue (cdr(assoc 1 (setq enti (entget i)))))

  (cond

    ( ( wcmatch Tvalue "Th*#") (entmod(subst (cons 8 "dia chi") (assoc 8 enti) enti)))

    ( (> (atoi Tvalue) 0) (entmod(subst (cons 8 "so thua") (assoc 8 enti) enti)))

    ( (and (= (strlen Tvalue) 3) (member (car(list Tvalue)) ls))

     (entmod(subst (cons 8 "loai dat") (assoc 8 enti) enti)))

    (T (entmod(subst (cons 8 "chu su dung") (assoc 8 enti) enti)))

    )

  ))

     ss)

      )

    )

  (command "_change" "_all" "" "p" "co" "bylayer" "")

  (if olderr (setq *error* olderr))

  (princ)

  )

 

 

[hg_aum 2]

thank bạn Quansla nhé,mình thử lisp rồi,tuy tốc độ hơi chậm với tờ bản đồ có khoảng hơn 700 cụm txt nhưng vậy cũng được rồi.Chỉ cố vấn đề là khi mình chọn cả tờ bản đồ luôn thì có nhưng cụm vẫn bị sai,thôn 3 vẫn vào lớp "chu su dung" .Mình gửi lại file mình đã thực hiện bạn kiểm tra lại và có khoang chỗ sai, bạn xem giúp mình nhé.http://www.cadviet.com/upfiles/3/63415_loi_csd.rar 

quansla

[quansla 259]

Nhờ bác nào giúp chủ pic, giúp luôn em hoàn thành vấn đề chủ pic với, Các bác cứ viết lại hoàn toàn hoặc sửa thuật toán cho líp e cũng được. Máy em hiện đang bị hỏng bàn phím. đánh mấy dòng này toàn bằng bàn phím ảo KIS, hix

[hg_aum 2]

lisp của bạn chưa ổn nên mình đành làm bo thành nhều lần vậy.Khi nào rảnh bạn hoàn thiện giúp mình với nhé,thank bạn nhiều1

[phamthanhbinh 3.146]

lisp của bạn chưa ổn nên mình đành làm bo thành nhều lần vậy.Khi nào rảnh bạn hoàn thiện giúp mình với nhé,thank bạn nhiều1

Hề hề hề,

Gửi bạn lisp này để bạn dùng thử. Nếu ưng mình sẽ hoàn thiện tiếp.

Lisp mới chỉ phân loại các đối tượng theo đúng cấu trúc của nhòm đối tượng mà bạn đã gửi bản vẽ mẫu lên. Trường hợp các nhónm đối tượng có cấu trúc không đúng như file bạn gửi,( chẳng hạn mỗi nhóm không đúng 5 đối tượng, vị trí tương đối của các text trong mỗi nhóm không tương ứng, góc text thay đổi, căn lề của mỗi text thay đổi, các text không cùng trên layer 52 và cùng có màu 7 .... ) thì lisp sẽ phân loại sai. Đó chính là lý do mà mình không làm hoàn chỉnh lisp này ngay vì chưa hiểu cái bạn cần có hoàn toàn đúng như mẫu bạn gửi hay không.

Kết quả của lisp này chỉ mới là chuyển màu các đối tượng cùng một phân loại về cùng một màu để bạn dễ nhận biết mà thôi.

Lisp chưa được test trên các bản vẽ đồ sộ với hàng trăm hàng ngàn nhóm text như bạn nói song với bản vẽ bạn gửi lên chỉ gồm hai nhóm text thì nó chưa bị lỗi. Có thể sẽ phát sinh lỗi nếu như trên bản vẽ của bạn có quá nhiều nhóm text có vị trí tương đối quá gần nhau. Điều này mình nghĩ là hiếm có vì các thửa đất đều phải đủ rộng để các text có chỗ ngồi và dữ liệu cho mỗi thửa thường phải được nhập cùng nhau để tránh nhầm lẫn. Hy vọng mình đoán đúng và lisp đáp ứng được yêu cầu của bạn.

http://www.cadviet.com/upfiles/3/5194_locdulieutext.lsp

[ndtnv 481]

Trong bản vẽ phải có đủ 5 layer trong list ll

Bạn thêm vào các hàm tạo layer, bẫy lỗi ...

 

(defun Dxf(n e) (cdr (assoc n e)))
(defun ModDxf(n v e)
    (if (Dxf n e)
        (entmod (subst (cons n  v) (assoc n e) e))
        (entmod (append e (list (cons n  v))))
    )
)

(defun c:plt (/ g h i l5 ll ls p x y) ; Phan Loai Text
    (setq fz 0.1) ; sai so
     (setq ll '("so thua" "loai dat" "chu su dung" "dia chi" "to ban do"))
     (setq ls (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list '(0 . "TEXT")
   (cons 1 (strcat "DXH,PNK,DNL,DBV,SON,TON,DCS,BCS,ONT,ODT,DGD,NTD,SKK,SKX,MVT,CQP,"
   "DDT,DTL,DGT,TSC,RPK,RDT,RPT,RST,RDN,RPN,RSN,MNC,TSN,TSL,SKC,COC,SKS,"
   "LNK,LNQ,LNC,DVH,BHK,DYT,CAN,DCH,TSK,LMU,TIN,DTT,LUK,LUC,LUN")))))))) ; Liet ke cac loai dat
    ;(setq t1 (getvar "Millisecs"))

    (foreach e ls
        (setq g (entget e) p (dxf 11 g) h (dxf 40 g) x (car p) y (cadr p))
        (setq l5 (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex    (ssget "C" (list (- x h) (- y (* 4.5 h))) (list (+ x h) (+ y h h))
                                             (list '(-4 . "<AND") '(0 . "TEXT")  '(-4 . ">") (cons 11 (list (- x fz) 0 0) ) '(-4 . "<") (cons 11 (list (+ x fz) 0 0) ) '(-4 . "AND>")))))    )
                                                (function (lambda (e1 e2) (> (cadr (dxf 11 (entget e1))) (cadr (dxf 11 (entget e2))))))))
        (if (and (= 5 (length l5 )) (= 1(vl-position e l5)))
            (progn (setq i 0)
                (foreach f l5
                    (ModDxf 8 (nth i ll)(entget f))
                    (setq i (1+ i)))
                )
             (entmake (list (cons 0 "CIRCLE") (cons 10 p) (cons 40 (* 5 h)) (cons 62 6) )) ; Danh dau vi tri sai
            )
        )
    ;(/ (- (getvar "Millisecs") t1) 1000.)
)

[hg_aum 2]

bạn phamthanhbinh và bạn ndtnv ơi.bạn hiểu đúng ý của mình rồi đấy bạn hãy hoàn thiện lisp giúp mình với nhé.Mình muốn bạn thêm lisp của bạn ndtnv vào trước để mình kiểm tra dữ liệu trước,rồi mới thực hiện lệnh lọc bạn nhé.

[phamthanhbinh 3.146]

bạn phamthanhbinh và bạn ndtnv ơi.bạn hiểu đúng ý của mình rồi đấy bạn hãy hoàn thiện lisp giúp mình với nhé.Mình muốn bạn thêm lisp của bạn ndtnv vào trước để mình kiểm tra dữ liệu trước,rồi mới thực hiện lệnh lọc bạn nhé.

Hề hề hề,

Mình thấy cách lấy nhóm text của bác ndtnv hay hơn cách làm của mình nên mình chỉ bổ sung vào lisp của bác ấy phần check và tạo layer mới nếu chưa có cũng như xác định màu cho các layer để bạn dễ kiểm soát mà thôi. Bạn dùng thử xem đã hài lòng chưa nhé.

http://www.cadviet.com/upfiles/3/5194_plt.lsp

[hg_aum 2]

cám ơn bạn phamthanhbinh và ndtnv vì lisp plt nhé,mình dùng thấy rất  ok!

[Black_Cat_ 6]

Vào lúc 29/9/2013 tại 01:30, quansla đã nói:

Bạn thử Code này xem nào, trình độ viết lisp của mình còn dở lắm về thuật toán thì chắc là rất ngớ ngẩn trước hết cứ đáp ứng nhu cầu của bạn đã, bạn gõ lệnh "THU" (thử) rồi dùng chuột quét chọn hình chữ nhật bao lấy một "cụm Text" mẫu (là cụm gồm đủ 5 Text như bạn đưa ra trên ảnh ý) sau đó nhấn Enter và kiểm tra kết quả.

Chú ý

•  
• Để thay đổi bộ lọc của số hiệu đất bạn tạo một file txt mới với nội dung là : mỗi dòng một loại mã hiệu đất (3 ký tự) và lưu lại vào đâu đó khi sử dụng lisp Ngay bước đầu tiên khi Lisp hỏi bạn là hãy quét chọn  Hình chữ nhật bao bộ lọc thi bạn không chọn điểm nữa mà ấn "S" / enter 
• Cũng ở phần chọn hình chữ nhật bao bộ lọc bạn ấn E lisp sẽ tự thoát 
• Mẹo: để lisp xử lý triệ để nhất bạn hãy chọn hình bao bộ lọc bao toàn bộ Text mẫu (hoặc bao trùm hẳn ra ngoài Text dài nhất là tốt nhất) vì trong Lisp của mình chỉ xử lý các đối tượng nằm trong khung bằng khung chữ nhật quét ban đầu thôi.

hixx, trình độ văn của mình kém lắm lại đang buồn ngủ, nếu quá khó hiểu bạn cmm lại mình làm video sau. Chúc bạn thành công.

Code

 

(defun c:thu (/ Setlist_dat newlayer  dis dt enti flag1 i loc ls ls1 N p0 p1 p2 pA pB ss ssdt Tvalue x

     *myerr ang1 ang2 dis1 dis2 enti flag1 i line ls olderr p1 p10 p2 ss0 ssdt Tvalue x)

  (defun *myerr (msg);

    (princ "Error: ")(princ msg)

    (princ)

    (if olderr (setq *error* olderr))

    (princ))

 

  (defun newlayer ( a b c d)

(if (not (tblsearch "layer" a))

(command "-layer" "n" a "c" b a "l" c a "lw" d a "")

;(command "-layer" "s" a "c" b a "l" c a "lw" d a "")

)

  )

 

  

  (defun Setlist_dat (/ duondan f ls)

    (setq duondan (getfiled "\nChon file chua danh sach Ma dat" "" "txt" 2)

 ls (list))

    (setq f (open duondan "r"))

    (while (setq line (read-line f))

      (setq ls (append (list line) ls))

      )

    (close f)

    (setq flag1 T)

    (setq #ls ls)

    ls    

    )

  ;;nhap vl-load,tao bo loc "loc" va khoi tao layer can thiet

  (vl-load-com)

  (setq olderr *error* *error* *myerr)

  (newlayer "so thua" 1 "Continuous " 0)

  (newlayer "loai dat" 2 "Continuous " 0)  

  (newlayer "chu su dung" 3 "Continuous " 0)

  (newlayer "dia chi" 4 "Continuous " 0)

  

  (or #ls (setq #ls '("DXH" "PNK" "DNL" "DBV" "SON" "TON" "DCS" "BCS" "ONT" "ODT" "DGD" "NTD" "SKK"

    "SKX" "MVT" "CQP" "DDT" "DTL" "DGT" "TSC" "RPK" "RDT" "RPT" "RST" "RDN" "RPN"

    "RSN" "MNC" "TSN" "TSL" "SKC" "COC" "SKS" "LNK" "LNQ" "LNC" "DVH" "BHK" "DYT"

    "CAN" "DCH" "TSK" "LMU" "TIN" "DTT" "LUK" "LUC" "LUN")))

  (setq ls #ls)

  (setq loc (mapcar '(lambda (x)(cons 1 x))ls))

  (setq loc (append '(( -4 . "<AND"))

   '((0 . "TEXT,MTEXT"))

   '(( -4 . "<OR"))

   loc

   '(( -4 . "OR>"))

   '(( -4 . "AND>"))))

  ;;;ket thuc khoi tao

 

 

  

  (setq flag1 nil)

  (while (null flag1)

      (initget "Setting Exit")

      (setq p1 (getpoint "\nQuet Hinh chu nhat bao bo loc or [setting Exit] <Select>"))

      (cond

( (= p1 "Setting")(setq ls (SETLIST_DAT )))

( (= p1 "Exit")(exit))

( (= 'LIST (type p1))

(progn

  

  (if (setq p2 (getcorner p1)

    ss (acet-ss-to-list(ssget

 "_w"

 p1

 p2

 loc

 ))

    ss0 (car ss))     

    (progn

      (setq flag1 T)

      (setq ang1 (angle (setq p10 (cdr(assoc 10 (entget ss0)))) p1)

    ang2 (angle p10 p2)

    dis1 (distance p10 p1)

    dis2 (distance p10 p2))

      (princ)

      )

    (alert "\nBan da chon vung khong co KH mau dat phu hop\n"))

))

(T (setq flag1 nil)(prompt "\nBan da chon vung khong co DATA phu hop reSected or Exit\n")(princ)))

      )

  (if flag1

    (if (setq ss (acet-ss-to-list(ssget "X" loc)))

      (mapcar '(lambda (x / p10 p1 p2 ssdt)

(setq p10 (cdr(assoc 10 (entget x)))

      p1 (polar p10 ang1 dis1)

      p2 (polar p10 ang2 dis2)

      ssdt (acet-ss-to-list(ssget "_W" p1 p2)))

(foreach i ssdt

  (setq Tvalue (cdr(assoc 1 (setq enti (entget i)))))

  (cond

    ( ( wcmatch Tvalue "Th*#") (entmod(subst (cons 8 "dia chi") (assoc 8 enti) enti)))

    ( (> (atoi Tvalue) 0) (entmod(subst (cons 8 "so thua") (assoc 8 enti) enti)))

    ( (and (= (strlen Tvalue) 3) (member (car(list Tvalue)) ls))

     (entmod(subst (cons 8 "loai dat") (assoc 8 enti) enti)))

    (T (entmod(subst (cons 8 "chu su dung") (assoc 8 enti) enti)))

    )

  ))

     ss)

      )

    )

  (command "_change" "_all" "" "p" "co" "bylayer" "")

  (if olderr (setq *error* olderr))

  (princ)

  )

 

 

 

@quansla Bạn ơi bạn có thể giúp mình sửa lại cái lisp trên theo dữ liệu 4 dòng bỏ cái số 23 đi được không, mình cảm ơn bạn nhiều ( cái dòng thứ 2 thì mình sửa lại là 52 cho hết tất cả)