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

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

Revision: 618
          http://sourceforge.net/p/euslisp/code/618
Author:   k-okada
Date:     2013-04-22 15:02:00 +0000 (Mon, 22 Apr 2013)
Log Message:
-----------
use searched-edgeq, impremented as convex-hull-3d-ol of primptpatch.l

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

Modified: trunk/EusLisp/lisp/geo/primt.l
===================================================================
--- trunk/EusLisp/lisp/geo/primt.l	2013-04-22 13:10:57 UTC (rev 617)
+++ trunk/EusLisp/lisp/geo/primt.l	2013-04-22 15:02:00 UTC (rev 618)
@@ -350,6 +350,7 @@
 	 (newbody)
 	 (faceq)
 	 (edgeq)
+	 (searched-edgeq)
 	 (searched-v)
 	 )
       (setq *points* vertices
@@ -396,16 +397,29 @@
 					 p1 p2 p3 (set-difference *vertices* searched-v :key #'car)))
 		   (setq newedges (send newface :edges))
 		   (dolist (ne newedges)
-			(if (memq 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)))))
+                     (cond ((memq ne edgeq)
+                            (setq edgeq (delete ne edgeq))
+                            (setq searched-edgeq (cons ne searched-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)))
+                                ))
+                            )
+                           ((memq ne searched-edgeq)
+                            (format *error-output* "~%re-searched edge:~A~%" ne)
+                            (let ((*coplanar-threshold*
+                                   (/ *coplanar-threshold* 2)))
+                              (format *error-output*
+                                      "thd:~A->~A~%" (* 2 *coplanar-threshold*)
+                                      *coplanar-threshold*)
+                              (if (< *coplanar-threshold* 0.00001)
+                                  (error "edgeq error!!")
+                                (return-from convex-hull-3d
+                                  (convex-hull-3d vertices)))))
+                           (t
+                            (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.