; Arkance Systems, 2023 - www.cadforum.cz
; based on a code by Dave Espinosa-Aguilar
;
(defun C:4PSphere ( / cmde osm pa pb pc pd pa1 pb1 pc1 pd1 c1 c2 c3 c4 pctr)
 (defun _Collinear-p ( p1 p2 p3 )
    (
        (lambda ( a b c )
            (or
                (equal (+ a b) c 1e-8)
                (equal (+ b c) a 1e-8)
                (equal (+ c a) b 1e-8)
            )
        )
        (distance p1 p2) (distance p2 p3) (distance p1 p3)
    )
 )
 
 (princ "\nCreate 3D sphere from 4 points.")
 (setq
	pa (getpoint "\nPick 1st point: ")
	pb (getpoint "\nPick 2nd point: ")
	pc (getpoint "\nPick 3rd point: ")
	pd (getpoint "\nPick 4th point: ")
 )
 (if (_Collinear-p pa pb pc)(progn (princ "\nFirst 3 points are collinear!")(exit)))
 (if (_Collinear-p pb pc pd)(progn (princ "\nLast 3 points are collinear!")(exit)))
 (setq cmde (getvar "cmdecho")) (setvar "cmdecho" 0)
 (setq osm (getvar "osmode")) (setvar "osmode" 0)
 (command "_undo" "_m")
 (command "_ucs" "_w") (command "_ucs" "_3p" pa pb pc)
 (setq pa1 (trans pa 0 1) pb1 (trans pb 0 1) pc1 (trans pc 0 1))
 (if (equal (caddr (trans pd 0 1)) 0.0 1e-8) (princ "\nThe 4 points are coplanar!") ; else
 (progn
  (command "_circle" "_3p" pa1 pb1 pc1)
  (setq c1 (trans (cdr (assoc 10 (entget (entlast)))) (entlast) 0))
  (command "_copy" "_l" "" "0,0,0" "0,0,1")
  (setq c2 (trans (cdr (assoc 10 (entget (entlast)))) (entlast) 0))
  (command "_ucs" "_w") (command "_ucs" "_3p" pb pc pd)
  (setq pb1 (trans pb 0 1) pc1 (trans pc 0 1) pd1 (trans pd 0 1))
  (command "_circle" "_3p" pb1 pc1 pd1)
  (setq c3 (trans (cdr (assoc 10 (entget (entlast)))) (entlast) 0))
  (command "_copy" "_l" "" "0,0,0" "0,0,1")
  (setq c4 (trans (cdr (assoc 10 (entget (entlast)))) (entlast) 0))
  (command "_undo" "_b")
  (command "_ucs" "_w")
  (setq pctr (inters c1 c2 c3 c4 nil))
  (if pctr (progn
   (princ "\nCenter: ")(princ pctr)
   (princ "  Radius: ")(princ (distance pctr pa))
   (command "_sphere" pctr pa)
   ) ; else
   (princ "\nSphere not found! (check geometry)")
  )
 ))
 (command "_ucs" "_w")
 (setvar "osmode" osm) (setvar "cmdecho" cmde)
 (princ)
)