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

[Doan Van Ha 3.185]

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

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

[ketxu 2.984]

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

[Thaistreetz 539]

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

[ketxu 2.984]

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 ^^

[Doan Van Ha 3.185]

Bác Thái!

Lisp này không sử dụng osnap để làm gì cả. Và cũng không sử dụng 2 hàm grvecs + grdraw để làm gì cả.

[Thaistreetz 539]

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