make-polyhedron

make-polyhedron.l

(defun make-polyhedron (top middles bottom)
  (let (upper-faces lower-faces)
    (setq middles (mapcar #'list middles))
    (make-face-from-vertices middles)
    (setq upper-faces (geometry::make-conic-side-faces (list top) middles :upper)
          lower-faces (geometry::make-conic-side-faces (list bottom) (reverse middles) :lower))
    (send (instantiate *body-class*) :init
          :faces (flatten (append upper-faces lower-faces))
          :approximated t
          :primitive (list ':polyhedron (append (list top) (mapcar #'car middles) (list bottom)))
          )
    ))
;; (make-octahedron (float-vector 0 0 100) (list (float-vector 0 0 50) (float-vector 100 0 0) (float-vector 0 100 20)) (float-vector 0 0 -100))
;; (make-octahedron (float-vector 0 0 100) (list (float-vector -100 0 50) (float-vector 0 -100 50)  (float-vector 100 0 0) (float-vector 0 100 20)) (float-vector 0 0 -100))