Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
victor85

[Yêu cầu] Nhờ viết lisp break và join rectang

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

victor85    10

Nhờ các bác viết dùm lisp break một rectang (polyline) tại một điểm mình pick thành 2 rectang tiếp xúc nhau như hình minh họa dùm mình với.

Lệnh: brr và jr.

Trong đó lệnh jr là quá trình ngược lại của brr bác nhé.

Thanks các bác trước.

Hình minh họa: http://www.mediafire.com/file/f43acwyr5ds9yua/rectang.dwg

  • Vote tăng 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
ketxu    2.653

Của bạn đây. Mỗi code một ý tưởng khác hẳn nhau ^^

(vl-load-com)
(defun c:brr(/ ST:List-Filter  ent obj pnt lst10) 
(defun ST:List-Filter (lst vl)(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) vl)) lst)))
(setq ent (entget(setq obj (car(entsel "\nChon HCN :"))));CHon HCN 
	pnt (getpoint "\nChon diem tren HCN") ;CHon diem
	lst10 (ST:List-Filter ent 10)
)
(foreach pt lst10
(command ".rectang" pt pnt)
(if (equal (vla-get-area (vlax-ename->vla-object (entlast))) 0.0 1e-8)(entdel (entlast)))
)
(entdel obj)
)
(defun c:jr(/ p1 p2 n ss lstPnt) 
(prompt "\nChon cac HCN :")
(setq ss (ssget (list (cons 0 "*POLYLINE")(cons 70 1))));CHon cac HCN 
(setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))  
(vla-getboundingbox (vlax-ename->vla-object e) 'p1 'p2)
(mapcar  '(lambda (a B) (* 0.5 (+ a B)))
(setq p1 (vlax-safearray->list p1)) (setq p2(vlax-safearray->list p2)))
(setq lstPnt (append (list p1 p2) lstPnt))
)
(setq lstPnt (vl-sort lstPnt '(lambda (x y)  (> (cadr x) (cadr  y)))))
(command ".rectang" (car lstPnt)(last lstPnt) ".erase" ss "")
)

  • Vote tăng 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
victor85    10

Hì hì, thanks ketxu nhé. Có điều cái jr chỉ dùng đc cho trường hợp duy nhất là 2 Hình Chữ Nhật tiếp xúc nhau. Ketxu Có thể sửa đổi dùm mình cho nó thành join nhiều HCN không tiếp xúc nhau thành 1 HCN có điểm đầu và điểm cuối kéo dài bao toàn bộ các HCN con kia không vậ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
Tue_NV    3.841

Hì hì, thanks ketxu nhé. Có điều cái jr chỉ dùng đc cho trường hợp duy nhất là 2 Hình Chữ Nhật tiếp xúc nhau. Ketxu Có thể sửa đổi dùm mình cho nó thành join nhiều HCN không tiếp xúc nhau thành 1 HCN có điểm đầu và điểm cuối kéo dài bao toàn bộ các HCN con kia không vậy?

Thấy cái Lisp viết đúng y như yêu cầu như lời bạn viết rồi. Bạn đã thử chưa?

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
ketxu    2.653

Hì hì, thanks ketxu nhé. Có điều cái jr chỉ dùng đc cho trường hợp duy nhất là 2 Hình Chữ Nhật tiếp xúc nhau. Ketxu Có thể sửa đổi dùm mình cho nó thành join nhiều HCN không tiếp xúc nhau thành 1 HCN có điểm đầu và điểm cuối kéo dài bao toàn bộ các HCN con kia không vậy?

Bạn check chưa ??

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
victor85    10

Bạn check chưa ??

 

Úi, hôm nay làm lại thấy được rồi. Sao hôm trước check nó toàn giao nhau ra cái HCN ở khoảng trống cơ. Không hiểu lắm, nhưng mà giờ thì ổn rồi. Cảm ơn bạn 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

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

Đăng nhập để thực hiện theo  

×