Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Doan Van Ha

[Đã xong] Ứng dụng hàm Grread để chia diện tích

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

Bác SSG đã có lisp “chia đất” rất hay.

Hàm Grread có nhiều ứng dụng sinh động. Lisp dưới đây là 1 ví dụ: sử dụng hàm Grread để chia diện tích các hình kín ra các phần với tỉ lệ xác định (tương tự lisp “chia đất”).

Ngoài ra, bạn có thể tìm hiểu thêm các hiệu ứng động thú vị của hàm Grread tại đây:

http://xaydungit.vn/...3%BA-v%E1%BB%8B

Chia_dien_tich.gif

;Doan Van Ha - CADViet.com - Ngay 12/6/2012
;Muc dich: Chia dien tich tao boi 1 Curve kin va 1 Line // Line chi phuong (hoac di qua 1 diem), de co 2 phan dien tich theo ti le.
;Cac chu y:
; 1). Khong nen di chuyen Mouse qua nhanh.
; 2). Khong nen chon sai so qua nho.
(defun C:HA( / ent1 ent2 ent3 ss ts lst ang kc ptd ppt dt12 dt1 dt2 z lstg txt ename)
(setq cmd (getvar "cmdecho")) (setvar "cmdecho" 0) (command "undo" "be")
(initget 6) (setq ts (getreal "\nChia theo ti so Area <1>: "))
(initget 6) (setq ss (getreal "\nSai so lon nhat cho phep (%) <1>: "))
(while (not (setq ent1 (car (entsel "\nChon doi tuong kin: ")))))
(initget "P D") (setq txt (getkword "\nChon kieu chia [duong chia di qua 1 Diem/duong chia theo 1 Phuong] <P>: "))
(if (or (= txt "P") (not txt))
 (while (not (setq ent2 (car (entsel "\nChon Line chi phuong: ")))))
 (while (not (setq ent2 (car (entsel "\nChon Point ma duong chia di qua: "))))))
(princ "\nDi chuyen Mouse de kiem tra Area...")
(if (not ss) (setq ss 1))
(if (not ts) (setq ts 1))
(setq dt12 (vla-get-Area (vlax-ename->vla-object ent1)))
(setq kc (* 0.2 (getvar "viewsize")))
(setq dt1 1E-8 dt2 1E+8 ename (entlast))
(while (and (not (<= (abs (- (/ dt1 dt2) ts)) (* ss 0.01))) (setq p (cadr (setq grr (grread T 4 1)))) (not (equal '(2 13) grr)) (not (equal '(2 32) grr)))
 (if (or (= txt "P") (not txt))
  (setq ang (angle (cdr (assoc 10 (entget ent2))) (cdr (assoc 11 (entget ent2)))))
  (setq ang (angle p (cdr (assoc 10 (entget ent2))))))
 (if (entnext ename) (vla-Delete (vlax-ename->vla-object (entnext ename))))
 (setq ent3 (entmakex (list (cons 0 "LINE") (cons 10 (polar p ang kc)) (cons 11 (polar p ang (- kc))))))
 (setq lstg (vlax-invoke (vlax-ename->vla-object ent1) 'IntersectWith (vlax-ename->vla-object ent3) acExtendOtherEntity))
 (if (= 6 (length lstg))
  (progn
(command "trim" ent3 "" "e" "e" ent1 "")
(setq dt1 (vla-get-Area (vlax-ename->vla-object ent1)) dt2 (- dt12 dt1))
(command "u"))))
(if (= 6 (length lstg))
 (progn
  (vla-Delete (vlax-ename->vla-object ent3))
  (entmake (list (cons 0 "LINE") (cons 10 (list (nth 0 lstg) (nth 1 lstg))) (cons 11 (list (nth 3 lstg) (nth 4 lstg)))))
  (alert (strcat "Da chia dien tich xong. Ket qua:\nS1 = " (rtos dt1 2 2) "\nS2 = " (rtos dt2 2 2) "\nSai so = " (rtos (abs (* 100 (- (/ dt1 dt2) ts))) 2 2) "%"))))
(command "undo" "e") (setvar "cmdecho" cmd) (princ))

  • Vote tăng 5

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

Code khá hay, một số bạn sẽ bớt đau đầu với ứng dụng động này đây ^^. Tks bác ĐVH

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

có 2 vấn đề đau đầu nhất khi muốn ứng dụng grread:

 

- 1 là: làm sao để (grread t) luôn tự động thực thi khi đưa vào vòng lặp chứ không cần người dùng tác động vào các thiết bị nhập. có khá nhiều ý tưởng hay ho nếu làm được việc này. hôm trước mót được cái này của ketxu (command "zoom" nil nil). thấy có vẻ chạy ngon trên máy ketxu nhưng rất tiếc bên máy mình không ăn thua. Nếu tải code thừ vlide vào cad thì nó chạy nhưng không thoát được với bất kỳ giá trị trả về nào của grread trừ khi truy cập menu. còn nếu để cad tự động tải khi mở bản vẽ thì không chạy. tsb nó, chả hiểu lỗi gì!

 

- 2 là: grread không có tùy chọn bắt điểm khi lấy tọa độ con trỏ, dẫn đến việc ứng dụng nó cũng coi như bỏ qua chế độ bắt điểm luôn. điển hình là ở trong ứng dụng bác Hà viết bên trên, không có cách nào để đặt chính xác đường thẳng chia tại 1 điểm mong muốn dẫn đến kết quả chi mang tính chính xác tương đối. Vấn đề này mình đã từng nêu phương án khắc phục và tương đối hiệu quả. các bác có thể tìm hiểu cách làm trong topic viết lại các hàm acet.

 

Mình viết khá nhiều ứng dụng sử dụng hàm này nên lời khuyên cho các bác nếu muốn dùng nó: hãy kết hợp nó với các hàm grvecs, grdraw, redraw để thay thế việc liên tục fải modified đối tượng như trên. Bản vẽ hơi nặng chút mà dùng cái này vài lần thì chẳng mấy mà hết Ram, tệ hơn có thể treo cad luôn :)

  • 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

Cái này bác Hạ vừa di chuột vừa tạo Line để lấy Intersec nên chắc phải vậy thôi ^^

P/s : ketxu nghĩ nên thêm phần zoom object trước khi tính toán cho nó trơ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

Bác không sử dụng vì bác đã có thể hài lòng với những gì đã có. còn mình thì không nếu mình có viết 1 cái gì đó làm công việc tương tự hoặc giống hệt như trên.

Những điều trên mình nói cốt để có thể tạo được thứ tốt hơn nữa, và mình có thể khẳng định 1 điều: làm được :)

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  

×