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  
thehost31

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

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

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

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

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

)

  • 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

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!

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

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.

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

 

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  

×