Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
5 replies to this topic

#1 victor85

victor85

    biết lệnh stretch

  • Members
  • PipPipPip
  • 169 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 13 August 2011 - 03:38 PM

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...yua/rectang.dwg
  • 1

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5679 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 13 August 2011 - 07:43 PM

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 "")
)

  • 2

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 victor85

victor85

    biết lệnh stretch

  • Members
  • PipPipPip
  • 169 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 15 August 2011 - 05:18 PM

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?
  • 0

#4 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 15 August 2011 - 05:48 PM

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?
  • 0

#5 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5679 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 16 August 2011 - 06:44 AM

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 ??
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#6 victor85

victor85

    biết lệnh stretch

  • Members
  • PipPipPip
  • 169 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 16 August 2011 - 09:26 AM

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é!
  • 0