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

Nhờ viết lisp lấy giao của một region và nhiều region.

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

Nhờ các bạn giúp giùm lisp lấy giao của một region và nhiều region với yêu cầu như sau:

- Bản vẽ có sẵn các region thuộc các layer khác nhau. Ví dụ: region A có layer A; region B có layer B; region C có layer C; region D có layer D; .....

- Lisp sẽ lấy region A giao (intersect) với lần lượt các region B, C, D, .... Kết quả mong muốn là giao của A và B sẽ có layer và màu của B;  A và C sẽ có layer và màu của C;  A và D sẽ có layer và màu của D;  ....

- Thao tác mong muốn là chọn A xong enter rồi quét chọn hoặc pick lần lượt B, C, D, .....

Lý do dùng region mà không dùng polyline là để tính được diện tích (region cho phép có phần rỗng bên trong; polyline thì không).

Mong được các anh em giúp giùm. Nếu được xin gởi chi phí cà phê.

Zalo liên lạc là: 0949471713.

Xin cảm ơ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
9 giờ trước, ktssontg đã nói:

Nhờ các bạn giúp giùm lisp lấy giao của một region và nhiều region với yêu cầu như sau:

- Bản vẽ có sẵn các region thuộc các layer khác nhau. Ví dụ: region A có layer A; region B có layer B; region C có layer C; region D có layer D; .....

- Lisp sẽ lấy region A giao (intersect) với lần lượt các region B, C, D, .... Kết quả mong muốn là giao của A và B sẽ có layer và màu của B;  A và C sẽ có layer và màu của C;  A và D sẽ có layer và màu của D;  ....

- Thao tác mong muốn là chọn A xong enter rồi quét chọn hoặc pick lần lượt B, C, D, .....

Lý do dùng region mà không dùng polyline là để tính được diện tích (region cho phép có phần rỗng bên trong; polyline thì không).

Mong được các anh em giúp giùm. Nếu được xin gởi chi phí cà phê.

Zalo liên lạc là: 0949471713.

Xin cảm ơn.

Bạn đưa hình vẽ or file cad theo yêu cầ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

Nếu bạn muốn gửi mình ly cà phê thì có thể inbox nha. :D

Lệnh IRM: chọn region A. rồi quét chọn toàn bộ. (lisp tự bỏ qua layer của region A)

Lưu ý vì đặc tính của intersect nên nếu region X và region A không có giao nhau. region X sẽ bị xoá. Bạn không nên chọn các region không giao nhau với region A.

(defun c:IRM (/ ent ss x)
  (setq 
    ent (car (entsel "\nSelect region A"))
    ss (ssget (list '(0 . "REGION") '(-4 . "<NOT") (assoc 8 (entget ent)) '(-4 . "NOT>")))
    ent (vlax-ename->vla-object ent)
    ss (mapcar 'vlax-ename->vla-object (acet-ss-to-list ss))
  )
  (foreach item ss
    (vla-boolean (vla-copy item) acintersection (vla-copy ent))
  )
  (initget 1 "Yes No")
  (setq x (getkword "Are delele region old? [Yes/No] <Yes> "))
  (if (eq "Yes" x)
    (mapcar 'vla-delete (cons ent ss))
  )
  (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
50 phút trước, Doan Van Ha đã nói:

Donate cũng khó nhỉ!

:)) haha tại code cũng hơi ngắn nên em nói vậy thôi chứ k định nhận donate. Bác chủ thớt thiện chí thậ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
Vào lúc 6/3/2023 tại 08:31, tannguyen291 đã nói:

Lưu ý vì đặc tính của intersect nên nếu region X và region A không có giao nhau. region X sẽ bị xoá. Bạn không nên chọn các region không giao nhau với region A

Có lẽ là nên check giao nhau trước khi thực hiện các phép copy, boolean ^^

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
37 phút trước, ketxu đã nói:

Có lẽ là nên check giao nhau trước khi thực hiện các phép copy, boolean ^^

Không cần ạ. chỉ cần không xoá đối tượng đấy về sau là oke ạ.

(defun c:IRM (/ ent ss x enx)
  (setq 
    ent (car (entsel "\nSelect region A"))
    ss (ssget (list '(0 . "REGION") '(-4 . "<NOT") (assoc 8 (entget ent)) '(-4 . "NOT>")))
    ent (vlax-ename->vla-object ent)
    ss (mapcar 'vlax-ename->vla-object (acet-ss-to-list ss))
  )
  (foreach item ss
    (vla-boolean (setq enx (vla-copy item)) acintersection (vla-copy ent))
    (if (equal 0 (vla-get-area enx) 1e-8)
      (setq ss (vl-remove item ss))
    )
  )
  (initget 1 "Yes No")
  (setq x (getkword "Are delele region old? [Yes/No] <Yes> "))
  (if (eq "Yes" x)
    (mapcar 'vla-delete (cons ent ss))
  )
  (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

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

×