[Euslisp-commit] SF.net SVN: euslisp:[607] trunk/EusLisp/lisp/geo/primt.l

[<k-...@us...>]

Revision: 607
          http://sourceforge.net/p/euslisp/code/607
Author:   k-okada
Date:     2013-04-18 14:15:43 +0000 (Thu, 18 Apr 2013)
Log Message:
-----------
move enclosed-vertexp from jsk, update convex-hull-3d based on convex-hull-3d-old of primtpatch.l

Modified Paths:
--------------
    trunk/EusLisp/lisp/geo/primt.l

Modified: trunk/EusLisp/lisp/geo/primt.l
===================================================================
--- trunk/EusLisp/lisp/geo/primt.l	2013-04-16 06:48:00 UTC (rev 606)
+++ trunk/EusLisp/lisp/geo/primt.l	2013-04-18 14:15:43 UTC (rev 607)
@@ -332,6 +332,13 @@
 ;; convexhull using gift-wrapping algorithm
 ;;
 
+(defun enclosed-vertexp (v)  ;; v=(#f() #<edge..> #<edge..>...)
+  (let ((result t))
+    (dolist (e (cdr v))
+      (setq result (and (e . pface)(e . nface) result))
+      )
+    (and (cdr v) result)))
+
 (defun convex-hull-3d (vertices)
 "ARGS = (vertices)
 Create a body of convex-hull from a list of vertices"
@@ -390,8 +397,15 @@
 		   (setq newedges (send newface :edges))
 		   (dolist (ne newedges)
 			(if (memq ne edgeq)
-		    	    (setq edgeq (delete ne edgeq))
-			    (setq edgeq (cons ne edgeq))))
+                            (progn
+                              (setq edgeq (delete ne edgeq))
+                              (let ((ver))
+                                (dolist (v (send ne :vertices))
+                                  (setq ver (find v *vertices* :key #'car))
+                                  (if (enclosed-vertexp ver)
+                                      (setq *vertices* (delete ver *vertices* :count 1                              )
+                                            )))))
+                          (setq edgeq (append edgeq (list ne)))))
 		   (setq faceq (cons newface faceq))
 		   (nconc *faces* (list newface))
 		   (if *debug* (print (length *faces* )))

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.