Đến nội dung


Hình ảnh
- - - - -

[Chia sẽ] Lisp tính diện tích của đa giác xác định bằng toạ độ các đỉnh 3D


  • Please log in to reply
5 replies to this topic

#1 thehost31

thehost31

    biết vẽ line

  • Members
  • PipPip
  • 26 Bài viết
Điểm đánh giá: 17 (tàm tạm)

Đã gửi 08 December 2014 - 02:06 AM

Tình hình là mình cần tính diện tích của đa giác trong không gian 3 chiều. Có một cách dễ là vẽ đa giác ra rồi lấy diện tích. Tuy nhiên mình cần phép toán tính thay cho việc vẽ rồi xoá. Mày mò mãi tìm được phương án này. Chia sẽ cùng các cao thủ có time thì check giúp nhiều trường hợp khác nhau. Lưu ý là danh sách điểm cung cấp ở dạng toạ độ 3 chiều, có z và thuộc cùng 1 mặt phẳng nhé.

 

Hoặc nếu ai có phương án hay hơn xin chia sẽ. Cám ơn!

 

(defun polygon3darea(points / area p0 p1 p2 v1 v2 normal_v n ax ay az coord i j k poi poj pok an)
; Khai bien chua ket qua
(setq area 0.0)
(if (>= (length points) 3)
(progn
; Tinh vector cua mat phang da giac
(setq p0 (nth 0 points)
p1 (nth 1 points)
p2 (nth 2 points)
)
(setq v1 (list
(- (car p0) (car p1))
(- (cadr p0) (cadr p1))
(- (caddr p0) (caddr p1))
)
)
(setq v2 (list
(- (car p1) (car p2))
(- (cadr p1) (cadr p2))
(- (caddr p1) (caddr p2))
)
)
(setq normal_v (list
(- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
(- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
(- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
)
)
; Tinh so dinh cua da giac
(setq n (length points))
; Them 2 dinh dau vao list
(setq points (append points (list p0)))
(setq points (append points (list p1)))
; Tinh ax, ay, az laf tri tuyet doi cua vector nomal
(if (> (car normal_v) 0.0)
(setq ax (car normal_v))
(setq ax (* -1 (car normal_v)))
)
(if (> (cadr normal_v) 0.0)
(setq ay (cadr normal_v))
(setq ay (* -1 (cadr normal_v)))
)
(if (> (caddr normal_v) 0.0)
(setq az (caddr normal_v))
(setq az (* -1 (caddr normal_v)))
)
; Xac dinh so truc
(setq coord 3)
(if (> ax ay)
(if (> ax az) (setq coord 1))
(if (> ay az) (setq coord 2))
)
; Tinh dien tich
(setq i 1 j 2 k 0)
(while (< i n)
(setq poi (nth i points)
poj (nth j points)
pok (nth k points)
)
(cond
((= coord 1) (setq area (+ area (* (cadr poi) (- (caddr poj) (caddr pok))))))
((= coord 2) (setq area (+ area (* (car poi) (- (caddr poj) (caddr pok))))))
((= coord 3) (setq area (+ area (* (car poi) (- (cadr poj) (cadr pok))))))
)
(setq i (1+ i))
(setq j (1+ j))
(setq k (1+ k))
)
; Tinh chieu dai cuar vector normal
(setq an (sqrt (+ (* ax ax) (* ay ay) (* az az))))
(cond
((= coord 1) (setq area (* area (/ an (* 2 ax)))))
((= coord 2) (setq area (* area (/ an (* 2 ay)))))
((= coord 3) (setq area (* area (/ an (* 2 az)))))
)
)
)
(setq area (abs area))
)

 

 

Mình test thử với

(setq points (list '(0 0 0) '(0 10 0) '(10 10 0) '(10 0 0)))
(setq a (POLYGON3DAREA points))

 

trả về 100.0


  • 0

#2 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

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

Đã gửi 08 December 2014 - 12:39 PM

Lisp hữu ích.

Mình có 2 ý kiến:
1. Bạn có thể cải tiến đoạn mã

(setq v1 (list
(- (car p0) (car p1))
(- (cadr p0) (cadr p1))
(- (caddr p0) (caddr p1))
)
)
(setq v2 (list
(- (car p1) (car p2))
(- (cadr p1) (cadr p2))
(- (caddr p1) (caddr p2))
)
)
Thành

(setq v1 (mapcar '- p0 p1)
v2 (mapcar '- p1 p2)
)



2. Vì sao đoạn

(if (> (car normal_v) 0.0)
(setq ax (car normal_v))
(setq ax (* -1 (car normal_v)))
)

(if (> (cadr normal_v) 0.0)
(setq ay (cadr normal_v))
(setq ay (* -1 (cadr normal_v)))
)

(if (> (caddr normal_v) 0.0)
(setq az (caddr normal_v))
(setq az (* -1 (caddr normal_v)))
)
Bạn không sửa thành

(setq
ax (abs (car normal_v))
ay (abs (cadr normal_v))
az (abs (caddr normal_v))
)

  • 1

#3 thehost31

thehost31

    biết vẽ line

  • Members
  • PipPip
  • 26 Bài viết
Điểm đánh giá: 17 (tàm tạm)

Đã gửi 08 December 2014 - 02:52 PM

Bác Hoành góp ý rất hay. Code sẽ gọn hơn rất nhiều. Cám ơn Bác. Do viết theo trình tự tinh vector nên 2 đoạn đó rất chuối :D


  • 0

#4 haanh

haanh

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2875 Bài viết
Điểm đánh giá: 1554 (rất tốt)

Đã gửi 08 December 2014 - 03:32 PM

Tình hình là mình cần tính diện tích của đa giác trong không gian 3 chiều. Có một cách dễ là vẽ đa giác ra rồi lấy diện tích. Tuy nhiên mình cần phép toán tính thay cho việc vẽ rồi xoá. Mày mò mãi tìm được phương án này. Chia sẽ cùng các cao thủ có time thì check giúp nhiều trường hợp khác nhau. Lưu ý là danh sách điểm cung cấp ở dạng toạ độ 3 chiều, có z và thuộc cùng 1 mặt phẳng nhé.

 

Hoặc nếu ai có phương án hay hơn xin chia sẽ. Cám ơn!

 

Mình test thử với

(setq points (list '(0 0 0) '(0 10 0) '(10 10 0) '(10 0 0)))
(setq a (POLYGON3DAREA points))

 

trả về 100.0

 

Khỏi cần phải vẽ đa giác:

1/ Nếu đa giác có các điểm có tọa Z bằng nhau chỉ cần dùng lệnh Area >> ra kết quả trên dòng Command

2/ Nếu các điểm của có tọa độ Z khác nhau (không thuộc mp// XOY ) thì gắn hệ trục USD vào mặt phẳng đa giác để có Z=0, rồi dùng lệnh Area cũng không đến nỗi chậm lắm!


  • 0

“Sống trong đời sống cần có một tấm lòng / Để làm gì em biết không ? / Để gió cuốn đi, để gió cuốn đi...”


#5 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5448 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 08 December 2014 - 04:11 PM

Khỏi cần phải vẽ đa giác:

1/ Nếu đa giác có các điểm có tọa Z bằng nhau chỉ cần dùng lệnh Area >> ra kết quả trên dòng Command

2/ Nếu các điểm của có tọa độ Z khác nhau (không thuộc mp// XOY ) thì gắn hệ trục USD vào mặt phẳng đa giác để có Z=0, rồi dùng lệnh Area cũng không đến nỗi chậm lắm!

Haanh không đọc kỹ đề toán rồi. Chủ topic lập trình để tính diện tích của 1 hình tạo bởi 1 danh sách điểm 3D, nghĩa là có danh sách điểm nhưng chưa có hình.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#6 tien2005

tien2005

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 257 Bài viết
Điểm đánh giá: 94 (tàm tạm)

Đã gửi 12 December 2014 - 03:27 PM

@thehost31 mình test với đa giác lõm thì code này tính chưa đúng

mình cũng thử làm 1 code theo hướng chuyển UCS của các điểm sang hệ trục mới rồi tính diện tích đa giác trên hệ trục này


;;(polygonarea (acet-geom-vertex-list (car (entsel "\nPick..."))))

(defun polygonarea (lsp / ls p1 p2 a b n ar)
  (command "_.ucs" "_3" (car lsp) (cadr lsp) (caddr lsp))
  (setq ls (mapcar '(lambda (x) (trans x 0 1)) lsp))
  (setq	n  0
	ar 0
  )
  (if (not (equal (car ls) (last ls) 1E-8))
    (setq ls (cons (last ls) ls))
  )
  (repeat (1- (length ls))
    (setq p1 (nth n ls)
	  p2 (nth (1+ n) ls)
	  a  (- (car p2) (car p1))
	  b  (+ (cadr p2) (cadr p1))
	  ar (+ ar (* a b 0.5))
	  n  (1+ n)
    )
  )
  (command "_.ucs" "w")
  (abs ar)
)

 


  • 0