Programming Challenge 24-3

[john.uhden]

I'm pretty bad with 3D things, so I have no clue how to go about this, but the challenge is to determine if four (4) points are in the same plane or not.  Yes, 3 points always define a plane but 4 or more points = not necessarily.  I'm not even sure how to draw such points that they might be coplanar (except in Plan World of course).  So you have to draw the conditions yourself for one group of 4 that is all coplanar and one that is not.

Your function should be named with your initials as a suffix, and shall contain the four points as input arguments, such as...

(defun coplanar-JU (p1 p2 p3 p4 / locals) ... ) ;; where all points are in the WCS.

OR

(defun coplanar-HAK (pts / locals) ... ) ;; where pts is a list of 4 or more WCS points.

It should return simply either T or nil.

It might be helpful to others if you label each of the points ("P1" "P2" etc.)

Please saveas/export to 2002 format so I can review (and learn from) your work.

Include all required subfunctions within the main function definition.

Have fun, OR ELSE!!

[ronjonp · Accepted solution]

My vote LM:Coplanar-p

[john.uhden]

@ronjonp ,

I haven't even peaked at it, but judging by is provenance it's probably the Grand Champion.

[MunteanStefan · Accepted solution]

I'd still like to play, maybe we ca have some fun

What about this:

(defun coplanar-ST (p1 p2 p3 p4)
  (or
    (inters p1 p2 p3 p4 nil)
    (inters p1 p3 p2 p4 nil)
    (inters p1 p4 p2 p3 nil)
  )
)

Why 3 times? because the points might be in a rectangle corners and 2 of the tests would not find any intersection. We must catch the "diagonals".

If the provided points are in a strict clockwise or ccw order, then 1 check would be enough, (inters p1 p3 p2 p4 nil).

Test function

(defun c:test ( / *error* ss i l)
  (defun *error* (msg) (if msg (princ msg)) (princ))

  (if
    (setq ss (ssget '((0 . "POINT"))))
    (progn
      (repeat (setq i (sslength ss))
        (setq l (cons (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))) l))
      )
      (if
        (= (length l) 4)
        (princ (strcat "\nThe selected points are " (if (apply 'coplanar-st l) "" "NOT ") "coplanar."))
        (princ "\nSelect exactly 4 points.")
      )
    )
  )

  (*error* nil)
  (princ)

)

[john.uhden]

@MunteanStefan ,

OMG, it appears to work!  YAY!!

[komondormrex · Accepted solution]

another one

(defun coplanar-kmndrmrex (point_1 point_2 point_3 point_4 / vector_1 vector_2 vector_3 vector_4)
  
  ;****************************************************************************************
  
  (defun vectors_multiplying (vector_1 vector_2)
	(list (- (* (cadr vector_1) (caddr vector_2)) (* (caddr vector_1) (cadr vector_2)))
	      (- (* (caddr vector_1) (car vector_2)) (* (car vector_1) (caddr vector_2)))
	      (- (* (car vector_1) (cadr vector_2)) (* (cadr vector_1) (car vector_2)))
        ) 
  )
  
  ;****************************************************************************************

  (defun check_colinear (vector_1 vector_2)
  	(or (equal (angle '(0 0 0) vector_1) (angle '(0 0 0) vector_2) 1e-6)
	    (equal (angle '(0 0 0) vector_1) (+ pi (angle '(0 0 0) vector_2)) 1e-6)
	    (equal (+ pi (angle '(0 0 0) vector_1)) (angle '(0 0 0) vector_2) 1e-6)
        )
  )
 
  ;****************************************************************************************
  
  (setq vector_1 (mapcar '- point_1 point_2)
	vector_2 (mapcar '- point_2 point_3)
	vector_3 (mapcar '- point_3 point_4)
	vector_4 (mapcar '- point_4 point_1)
  )
  (check_colinear (vectors_multiplying vector_1 vector_2) 
	       	  (vectors_multiplying vector_3 vector_4)
  )
)

usage: (coplanar-kmndrmrex (getpoint) (getpoint) (getpoint) (getpoint))

[leeminardi · Accepted solution]

@MunteanStefan Very clever!  I like it.

I was curious to see how it handle slight errors so  I added code to calculate the shortest distance between the three infinite lines formed by the 4 points.

I tested it by creating 4 points on the XY plane and then randomly rotating them several times in 3D with rotate3d and then moved by a million in x.

Sample results:

(defun coplanar-ST (p1 p2 p3 p4)
  (or
    (inters p1 p2 p3 p4 nil)
    (inters p1 p3 p2 p4 nil)
    (inters p1 p4 p2 p3 nil)
  )
)

(defun c:test (/ *error* ss i l)
  (defun *error* (msg)
    (if	msg
      (princ msg)
    )
    (princ)
  )

  (if
    (setq ss (ssget '((0 . "POINT"))))
     (progn
       (repeat (setq i (sslength ss))
	 (setq l
		(cons (cdr (assoc 10 (entget (ssname ss (setq i (1- i))))))
		      l
		)
	 )
       )
       (if
	 (= (length l) 4)
	  (progn
	    (princ (strcat "\nThe selected points are "
			   (if (apply 'coplanar-st l)
			     ""
			     "NOT "
			   )
			   "coplanar."
		   )
	    )
	  ; calculate distance between lines p1p2 p3p4  
	    (setq p1 (nth 0 l)
		  p2 (nth 1 l)
		  p3 (nth 2 l)
		  p4 (nth 3 l)
	    )
	    (setq v (unitvec (cross (mapcar '- p2 p1) (mapcar '- p4 p3)))
		  d (dot (mapcar '- p3 p1) v)
	    )
	    (princ "\nDistance between lines p1 p2 and p3 p4 = ")
	    (princ d)
	    (setq v (unitvec (cross (mapcar '- p3 p1) (mapcar '- p4 p2)))
		  d (dot (mapcar '- p3 p1) v)
	    )
	    (princ "\nDistance between lines p1 p3 and p2 p4 = ")
	    (princ d)
	    (setq v (unitvec (cross (mapcar '- p4 p1) (mapcar '- p2 p3)))
		  d (dot (mapcar '- p3 p1) v)
	    )
	    (princ "\nDistance between lines p1 p4 and p2 p3 = ")
	    (princ d)

	  )
	  (princ "\nSelect exactly 4 points.")
       )
     )
  )

  (*error* nil)
  (princ)

)

[dbroad]

@MunteanStefan  Yours is the only one that returns false if the points are colinear.  I'm not sure if that is a plus or a minus since the colinear test really should be first.  If all the points are colinear, they are together members of an infinite number of planes.

Logically it should be

(cond

  ((Samepoint_P p1 p2 p3 p4)

   "Points are same location")

  ((Colinear_P p1 p2 p3 p4)

    "Points are colinear")

  ((Coplanar_P p1 p2 p3 p4)

    "Points are  Coplanar")

  (T "Points are separate but neither colinear nor coplanar")

)

[MunteanStefan]

---

@dbroad wrote:

@MunteanStefan  Yours is the only one that returns false if the points are colinear.  I'm not sure if that is a plus or a minus since the colinear test really should be first.  If all the points are colinear, they are together members of an infinite number of planes.

Logically it should be

(cond

  ((Samepoint_P p1 p2 p3 p4)

   "Points are same location")

  ((Colinear_P p1 p2 p3 p4)

    "Points are colinear")

  ((Coplanar_P p1 p2 p3 p4)

    "Points are  Coplanar")

  (T "Points are separate but neither colinear nor coplanar")

)

---

You are right. If the points are colinear my lisp returns nil.

I added one more check. If 3 points are colinear, then all 4 are coplanar.

(defun colinear-ST (p1 p2 p3 / d)
  (setq d (vl-sort
            (mapcar
              'distance
              (list p1 p2 p3)
              (list p2 p3 p1)
            )
            '<
          )
  )
  (equal (+ (car d) (cadr d)) (caddr d) 1e-6)
)

(defun coplanar-ST (p1 p2 p3 p4)
  (or
    (colinear-ST p1 p2 p3)
    (inters p1 p2 p3 p4 nil)
    (inters p1 p3 p2 p4 nil)
    (inters p1 p4 p2 p3 nil)
  )
)

[dbroad]

What if all 4 are either colinear or concurrent?

[ryanatkins49056]

Hello,

I know I'm late but here is my attempt. It uses the pure mathematical formula for testing for coplanar points. I've never really tested this out with finer points so no idea how it would handle the double floating point problem. I have also left the original getpoint functions in (albeit they are commented out) should they be required.

(defun rracoplanar ( rrap1 rrap2 rrap3 rrap4 / x1 y1 z1 x2 y2 z2 x3 y3 z3 x4 y4 z4 rraanswer rraresult)

  ; (setq rrap1 (getpoint "\n1"))

  ; (setq rrap2 (getpoint "\n2"))

  ; (setq rrap3 (getpoint "\n3"))

  ; (setq rrap4 (getpoint "\n4"))

  (setq x1 (nth 0 rrap1))

  (setq y1 (nth 1 rrap1))

  (setq z1 (nth 2 rrap1))

  (setq x2 (nth 0 rrap2))

  (setq y2 (nth 1 rrap2))

  (setq z2 (nth 2 rrap2))

  (setq x3 (nth 0 rrap3))

  (setq y3 (nth 1 rrap3))

  (setq z3 (nth 2 rrap3))

  (setq x4 (nth 0 rrap4))

  (setq y4 (nth 1 rrap4))

  (setq z4 (nth 2 rrap4))

  (setq rraanswer

  (+

    (* x1 (- (* y2 (- z3 z4)) (* z2 (- y3 y4)) (+ (* y3 z4) (* -1 y4 z3))))

    (* -1 y1 (- (* x2 (- z3 z4)) (* z2 (- x3 x4)) (+ (* x3 z4) (* -1 x4 z3))))

    (* z1 (- (* x2 (- y3 y4)) (* y2 (- x3 x4)) (+ (* x3 y4) (* -1 x4 y3))))

    (- (* x2 (- (* y3 z4) (* y4 z3))) (* y2 (- (* x3 z4) (* x4 z3))) (* z2 (- (* x3 y4) (* x4 y3))))

  ))

  (if (equal 0 rraanswer 1e-8)

    (setq rraresult "T")

    (setq rraresult "Nil")

  );(if)

  (princ (strcat "\n" rraresult))

  (princ)

)

This was born from originally tinkering with general maths equations in prefix format (the way autolisp calculates) as I have always used infix and suffix formats (normal and rpn calculators respectively). Mainly to get used to the way numbers are handled within AutoCAD.