Chuyển đến nội dung
Diễn đàn CADViet
thanhnhan1989

Xin được trợ giúp về lọc layer

Bởi thanhnhan1989 , trong AutoLisp

Các bài được khuyến nghị

thanhnhan1989    6

thanhnhan1989
Đã đăng

Chào tất cả anh em, Hiện tại mình có vấn đề về tách số thửa, Loại đất và diện tích nhờ anh em viết giúp 1 lisp để tách vì diện tích không có số thập phân .Nếu trường hợp là diện tích  có số thập phân mình đã có down được lisp trên diễn đàn. Em xin đính kèm file dữ liệu mẫu, Xin các sư huynh giúp em cái, em đang cần mà lọc tay đến 5 xã thì rất lâu.

image.png.e2149f9be07abfa75da24078e7ee590e.png

DC (1).dwg

  • Vote giảm 2

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

quansla    259

quansla
Đã đăng

Đọc lại quy định của diễn đàn về đăng bài đi bạn, viết như bạn bạn nghĩ có bao nhiêu người có thể hiểu yêu cầu của 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

thiep    365

thiep
Đã đăng
Vào lúc 16/3/2020 tại 22:08, thanhnhan1989 đã nói:

Chào tất cả anh em, Hiện tại mình có vấn đề về tách số thửa, Loại đất và diện tích nhờ anh em viết giúp 1 lisp để tách vì diện tích không có số thập phân .Nếu trường hợp là diện tích  có số thập phân mình đã có down được lisp trên diễn đàn. Em xin đính kèm file dữ liệu mẫu, Xin các sư huynh giúp em cái, em đang cần mà lọc tay đến 5 xã thì rất lâu.

image.png.e2149f9be07abfa75da24078e7ee590e.png

DC (1).dwg

Thật là khó hiểu khi bạn đưa ra đầu bài, đến khi Doan up hình gif lên, hiểu nôm na như thế này:

- Lọc text ghi loại đất đưa vào 1 layer (ví dụ layer "thua")

- Lọc text ghi diện tích đưa vào 1 layer (ví dụ layer "dien_tich")

- Lọc text ghi số hiệu thửa đất đưa vào 1 layer (ví dụ layer "so_hieu")

Chạy thử xem có đúng ý bạn không:

 

 

 

loc_tachlayer.lsp

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

thanhnhan1989    6

thanhnhan1989
Đã đăng
Vào lúc 20/3/2020 tại 15:04, Doan Nguyen Van đã nói:

Không biết đúng ý chủ thớt chưa ?

199147584_ezgif.com-video-to-gif(1).gif.8060f48857f16cf21784d439d4629e96.gif

Thanks bạn vì đã giúp mình, nhưng lisp chạy  chưa thật sự đúng ý, bạn có thể sữa lại giúp mình được không ? khi mình chạy nó không chia ra các loại laye

r hoặc các màu khác nhau mà chỉ ra như vậy :image.thumb.png.0ba13079e3153233be7334eeff0d1388.png

 

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 Nguyen Van    491

Doan Nguyen Van
Đã đăng 
(vl-load-com)
(defun c:te ()
  (setq ss (acet-ss-to-list (ssget (list (Cons 0 "LINE") (Cons 8 "13")))))
  (foreach ent ss
    (setq p1 (dxf 10 ent)
	  p2 (dxf 11 ent))
    (if (< (car p1)(car p2)) (setq pt1 p1 pt2 p2) (setq pt1 p2 pt2 p1))
    (setq pt0 (polar pt1 (angle pt2 pt1) 10))
    (setq pm (acet-geom-midpoint p1 p2))
    (setq pt3 (polar pm (+ (* pi 0.5) (angle p1 p2)) (/ (distance p1 p2) 4))
	  pt4 (polar pm (+ (* pi 1.5) (angle p1 p2)) (/ (distance p1 p2) 4)))
    (setq l1 (vl-sort (list pt0 pt2 pt3 pt4) '(lambda (x y) (< (car x) (car y)))))
    
    (setq x1 (car (car l1))
	  x2 (car (last l1)))
    (setq l2 (vl-sort (list pt0 pt2 pt3 pt4) '(lambda (x y) (< (cadr x) (cadr y)))))
    (setq y1 (cadr (car l2))
	  y2 (cadr (last l2)))
    (setq p1 (list x1 y1 0.0) p2 (list x2 y2 0.0))
    (vlax-invoke (vlax-get-acad-object) 'zoomwindow  p1 p2)
    (setq sst (acet-ss-to-list (ssget "_C" (trans p1 0 1) (trans p2 0 1)
				      (list (Cons 0 "TEXT") (Cons 8 "13")))))
    (if (= (length sst) 3) (progn
	(foreach e sst
	  (if (not (distof (dxf 1 e)))(progn
	    (setq et e)
	    (setq sst (vl-remove e sst))))
	  )
	(changelayer et "T1")
	(setq e1 (car sst) e2 (cadr sst))
	(if (> (cadr (dxf 10 e1)) (cadr (dxf 10 e2)))
	  (progn
	    (changelayer e1 "T2")
	    (changelayer e2 "T3") )
	  (progn
	    (changelayer e1 "T3")
	    (changelayer e2 "T2") ) )
	))
   (vla-zoomprevious (vlax-get-acad-object))
    )
  )
(defun changelayer (ent_ la_)
  (if (not (tblsearch "layer" "T1")) (COMMAND "-LAYER" "M" "T1" "C" "1" "" "" ""))
  (if (not (tblsearch "layer" "T2")) (COMMAND "-LAYER" "M" "T2" "C" "2" "" "" ""))
  (if (not (tblsearch "layer" "T3")) (COMMAND "-LAYER" "M" "T3" "C" "3" "" "" ""))
(vla-put-layer (vlax-ename->vla-object ent_) la_)
  (vla-put-color (vlax-ename->vla-object ent_) 256)
  )
(defun Dxf (Id Obj)
    (cdr (assoc Id (entget Obj)))
  )

Mấy bữa để lisp ở cty giờ mới gửi lên được

 

  • Like 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

quocmanh04tt    635

quocmanh04tt
Đã đăng
1 giờ trước, quocmanh04tt đã nói:

Lisp sẽ đơn giản hơn nhiều khi phân biệt 3 nhóm Text kia bằng Alignment.

Mình tham gia 1 cái, phân biệt bằng Alignment:

(defun c:tt  (/ a e s lays _ent)
    (setq lays (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object)))
          _ent '((n c)
                 (or (tblsearch "LAYER" n) (vla-put-color (vla-add lays n) c))
                 (entmod (list (cons -1 e) (cons 8 n) '(62 . 256)))))
    (if (setq s (ssget '((0 . "TEXT"))))
        (while (and (setq e (ssname s 0)) (ssdel e s))
            (setq a (vlax-get (vlax-ename->vla-object e) 'Alignment))
            (cond ((eq a 11) (_ent "thua" 1))
                  ((eq a 1) (_ent "sohieu_thua" 2))
                  ((eq a 7) (_ent "dien_tich" 3)))))
    (princ))

  • Like 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

thiep    365

thiep
Đã đăng
3 giờ trước, Doan Nguyen Van đã nói: 

(vl-load-com)
(defun c:te ()
  (setq ss (acet-ss-to-list (ssget (list (Cons 0 "LINE") (Cons 8 "13")))))
  (foreach ent ss
    (setq p1 (dxf 10 ent)
	  p2 (dxf 11 ent))
    (if (< (car p1)(car p2)) (setq pt1 p1 pt2 p2) (setq pt1 p2 pt2 p1))
    (setq pt0 (polar pt1 (angle pt2 pt1) 10))
    (setq pm (acet-geom-midpoint p1 p2))
    (setq pt3 (polar pm (+ (* pi 0.5) (angle p1 p2)) (/ (distance p1 p2) 4))
	  pt4 (polar pm (+ (* pi 1.5) (angle p1 p2)) (/ (distance p1 p2) 4)))
    (setq l1 (vl-sort (list pt0 pt2 pt3 pt4) '(lambda (x y) (< (car x) (car y)))))
    
    (setq x1 (car (car l1))
	  x2 (car (last l1)))
    (setq l2 (vl-sort (list pt0 pt2 pt3 pt4) '(lambda (x y) (< (cadr x) (cadr y)))))
    (setq y1 (cadr (car l2))
	  y2 (cadr (last l2)))
    (setq p1 (list x1 y1 0.0) p2 (list x2 y2 0.0))
    (vlax-invoke (vlax-get-acad-object) 'zoomwindow  p1 p2)
    (setq sst (acet-ss-to-list (ssget "_C" (trans p1 0 1) (trans p2 0 1)
				      (list (Cons 0 "TEXT") (Cons 8 "13")))))
    (if (= (length sst) 3) (progn
	(foreach e sst
	  (if (not (distof (dxf 1 e)))(progn
	    (setq et e)
	    (setq sst (vl-remove e sst))))
	  )
	(changelayer et "T1")
	(setq e1 (car sst) e2 (cadr sst))
	(if (> (cadr (dxf 10 e1)) (cadr (dxf 10 e2)))
	  (progn
	    (changelayer e1 "T2")
	    (changelayer e2 "T3") )
	  (progn
	    (changelayer e1 "T3")
	    (changelayer e2 "T2") ) )
	))
   (vla-zoomprevious (vlax-get-acad-object))
    )
  )
(defun changelayer (ent_ la_)
  (if (not (tblsearch "layer" "T1")) (COMMAND "-LAYER" "M" "T1" "C" "1" "" "" ""))
  (if (not (tblsearch "layer" "T2")) (COMMAND "-LAYER" "M" "T2" "C" "2" "" "" ""))
  (if (not (tblsearch "layer" "T3")) (COMMAND "-LAYER" "M" "T3" "C" "3" "" "" ""))
(vla-put-layer (vd_vl ent_) la_)
  (vla-put-color (vd_vl ent_) 256)
  )
(defun Dxf (Id Obj)
    (cdr (assoc Id (entget Obj)))
  )

Mấy bữa để lisp ở cty giờ mới gửi lên được

 

Lisp của Doan bị thiếu hàm con vd_vl

  • Like 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

thiep    365

thiep
Đã đăng
2 giờ trước, quocmanh04tt đã nói:

Mình tham gia 1 cái, phân biệt bằng Alignment: 

(defun c:tt  (/ a e s lays _ent _lay)
    (setq lays (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object)))
          _ent '((n) (entmod (list (cons -1 e) (cons 8 n) '(62 . 256))))
          _lay '((n c) (or (tblsearch "LAYER" n) (vla-put-color (vla-add lays n) c)) n))
    (if (setq s (ssget '((0 . "TEXT"))))
        (while (and (setq e (ssname s 0)) (ssdel e s))
            (setq a (vlax-get (vlax-ename->vla-object e) 'Alignment))
            (cond ((eq a 11) (_ent (_lay "thua" 1)))
                  ((eq a 1) (_ent (_lay "sohieu_thua" 2)))
                  ((eq a 7) (_ent (_lay "dien_tich" 3))))))
    (princ))

Công nhận quocmanh04tt viết nhiều hàm rất phức tạp, siêu tưởng. Nhưng có điều thời gian chạy nó cũng lâu hơn lisp tôi viết kiếu tách text - lớp bằng Alignment, viết thông thường dễ nhìn: chênh nhau 3/triệu giây: 

(Defun c:llo (/ *lay* ss ent_lst obj_lst d1 d2)
    (setq d1 (getvar "date"))
    (setq
        *lay* (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object)))
    )
    (mapcar '(lambda (lay col)
                 (or (tblobjname "LAYER" lay)
                     (vla-put-color (vla-add *lay* lay) col)
                 )
             )
            '("thua" "sohieu_thua" "dien_tich")
            '(1 2 3)
    )
    (if (setq ss (ssget "X" '((0 . "TEXT") )));(8 . "13")
        (progn 
               (setq ent_lst (acet-ss-to-list ss))
               (setq obj_lst (mapcar 'vlax-ename->vla-object ent_lst))
               (mapcar '(lambda (x y)
                            (setq j (acet-tjust-keyword (entget x)))
                            (cond ((eq J "MR")
                                   (vla-put-layer y "thua")
                                   (vla-put-color y acByLayer)
                                  )
                                  ((eq J "Center")
                                   (vla-put-layer y "sohieu_thua")
                                   (vla-put-color y acByLayer)
                                  )
                                  ((eq J "TC")
                                   (vla-put-layer y "dien_tich")
                                   (vla-put-color y acByLayer)
                                  )
                            )
                        )
                       ent_lst
                       obj_lst
               )
        )
    )
    (setq d2 (getvar "date"))
    (setq tex (acet-str-format "th\U+1EDDi gian ch\U+1EA1y lisp là: %1 giây" (rtos (- d2 d1) 2 9)))
    (princ tex)
)

 

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

thanhnhan1989    6

thanhnhan1989
Đã đăng

anh em ơi, hiện tại mình tải 3 lisp ở trên về đều ko chạy được cho các file khác, chỉ chạy được cho file mẫu đính kèm trên cùng thôi, anh em xem giúp mình lý do và chỉnh lại giúp mình được  không? 

file ko chaydc_2007.dwg

  • Vote giảm 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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Về Đầu Trang AutoLisp
×