Topic: Creating 4 point 3DSOLID without SURFSCULPT...

[ribarm]

Hi, I have one situation I need to solve...
There are 3 points in 3D space that aren't collinear and 4th point is not coplanar to those 3... (Somehing like tetrahedron, but not neccessary with equal sides...)
It is easy to make 3DSOLID by using SURFSCULPT command...
But, I need it to be working also in BricsCAD that don't have this command...
Here is example operational in AutoCAD :

Code: [Select]

(defun c:4pt-3dsol ( / collinear-p coplanar-p adoc p1 p2 p3 p4 3df1 3df2 3df3 3df4 s el )

  (vl-load-com)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))

  (defun collinear-p ( p1 p2 p3 )
    (
      (lambda ( a b c )
        (or
          (equal (+ a b) c 1e-6)
          (equal (+ b c) a 1e-6)
          (equal (+ c a) b 1e-6)
        )
      )
      (distance p1 p2) (distance p2 p3) (distance p1 p3)
    )
  )

  (defun coplanar-p ( p1 p2 p3 p4 / l )
    (setq l (list p1 p2 p3 p4))
    (or
      (vl-some (function (lambda ( x ) (apply (function collinear-p) (vl-remove x l)))) l)
      (apply (function inters) (append l (list nil)))
      (apply (function inters) (append (cdr l) (list (car l) nil)))
    )
  )

  (if
    (and
      (setq p1 (trans (getpoint "\nFirst point : ") 1 0))
      (setq p2 (trans (getpoint "\nSecond point : ") 1 0))
      (setq p3 (trans (getpoint "\nThird point : ") 1 0))
      (setq p4 (trans (getpoint "\nFourth point : ") 1 0))
      (not (coplanar-p p1 p2 p3 p4))
    )
    (progn
      (setq 3df1 (entmakex (list '(0 . "3DFACE") (cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p1))))
      (setq 3df2 (entmakex (list '(0 . "3DFACE") (cons 10 p1) (cons 11 p2) (cons 12 p4) (cons 13 p1))))
      (setq 3df3 (entmakex (list '(0 . "3DFACE") (cons 10 p2) (cons 11 p3) (cons 12 p4) (cons 13 p2))))
      (setq 3df4 (entmakex (list '(0 . "3DFACE") (cons 10 p1) (cons 11 p3) (cons 12 p4) (cons 13 p1))))

      (setq s (ssadd))
      (ssadd 3df1 s)
      (ssadd 3df2 s)
      (ssadd 3df3 s)
      (ssadd 3df4 s)
      (setq el (entlast))
      (vl-cmdf "_.REGION" s "")
      (setq s (ssadd))
      (while (setq el (entnext el))
        (ssadd el s)
      )
      (vl-cmdf "_.SURFSCULPT" s "")
    )
  )
  (vla-endundomark adoc)
  (princ)
)

This task is part of my bigger program for which I want to be useful also in BricsCAD as it's faster than AutoCAD...
Any insight or solution is welcomed and appreciated...

Thanks, M.R.

[ribarm]

Ha...
Imidieatly after I posted, I rethought once again and I found solution :
1. extrude one basis 3dface in direction of vector ptbase 4th point...
2. slice 3DSOLID with 4th point and other 2 different than ptbase...
3. remove 3DSOLID that don't have ptbase...

If there is something different, please reply...
But it is siple enough and like this...
Thanks for attention anyway...

[ribarm]

Here is it written in ALISP - BricsCAD version...

Code: [Select]

(defun c:4pt-3dsol ( / collinear-p coplanar-p adoc p1 p2 p3 p4 var 3df regobj 3ds e1 e2 c1 c2 )

  (vl-load-com)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))

  (defun collinear-p ( p1 p2 p3 )
    (
      (lambda ( a b c )
        (or
          (equal (+ a b) c 1e-6)
          (equal (+ b c) a 1e-6)
          (equal (+ c a) b 1e-6)
        )
      )
      (distance p1 p2) (distance p2 p3) (distance p1 p3)
    )
  )

  (defun coplanar-p ( p1 p2 p3 p4 / l )
    (setq l (list p1 p2 p3 p4))
    (or
      (vl-some (function (lambda ( x ) (apply (function collinear-p) (vl-remove x l)))) l)
      (apply (function inters) (append l (list nil)))
      (apply (function inters) (append (cdr l) (list (car l) nil)))
    )
  )

  (if
    (and
      (setq p1 (trans (getpoint "\nFirst point : ") 1 0))
      (setq p2 (trans (getpoint "\nSecond point : ") 1 0))
      (setq p3 (trans (getpoint "\nThird point : ") 1 0))
      (setq p4 (trans (getpoint "\nFourth point : ") 1 0))
      (not (coplanar-p p1 p2 p3 p4))
    )
    (progn
      (if (not (vl-catch-all-error-p (setq var (vl-catch-all-apply (function vla-addregion) (list (vla-get-block (vla-get-activelayout adoc)) (vlax-safearray-fill (vlax-make-safearray vlax-vbObject '(0 . 0)) (list (vlax-ename->vla-object (setq 3df (entmakex (list (cons 0 "3DFACE") (cons 10 p1) (cons 11 p1) (cons 12 p2) (cons 13 p3))))))))))))
        (progn
          (setq regobj (car (safearray-value (variant-value var))))
          (if (not (vlax-erased-p 3df))
            (entdel 3df)
          )
        )
        (progn
          (vl-cmdf "_.CONVTOSURFACE" 3df "")
          (setq regobj (vlax-ename->vla-object (entlast)))
        )
      )
      (vl-cmdf "_.EXTRUDE" (vlax-vla-object->ename regobj) "" "_D" "_non" p1 "_non" p4)
      (vla-slicesolid (vlax-ename->vla-object (setq 3ds (entlast))) (vlax-3d-point p2) (vlax-3d-point p3) (vlax-3d-point p4) :vlax-true)
      (if (vlax-erased-p 3ds)
        (progn
          (setq e1 (entlast))
          (entdel e1)
          (setq e2 (entlast))
          (entdel e1)
          (setq c1 (safearray-value (variant-value (vla-get-centroid (vlax-ename->vla-object e1)))))
          (setq c2 (safearray-value (variant-value (vla-get-centroid (vlax-ename->vla-object e2)))))
          (if (< (distance p1 c1) (distance p1 c2))
            (progn
              (setq 3ds e1)
              (entdel e2)
            )
            (progn
              (setq 3ds e2)
              (entdel e1)
            )
          )
        )
        (progn
          (setq e1 (entlast))
          (setq c1 (safearray-value (variant-value (vla-get-centroid (vlax-ename->vla-object e1)))))
          (if (< (distance p1 c1) (distance p1 (safearray-value (variant-value (vla-get-centroid (vlax-ename->vla-object 3ds))))))
            (progn
              (entdel 3ds)
              (setq 3ds e1)
            )
            (entdel e1)
          )
        )
      )
      (princ "\nResulting 3DSOLID : ") (princ 3ds)
    )
  )
  (vla-endundomark adoc)
  (princ)
)


[ribarm]

I don't want to start new topic...
Quickly written this function :

The question : Is it OK?

Code: [Select]

;;; UnChecked function - I guess not effective... ;;;
(defun coplanar-p-ptlst ( l / collinear-p k r )

  (defun collinear-p ( p1 p2 p3 )
    (
      (lambda ( a b c )
        (or
          (equal (+ a b) c 1e-6)
          (equal (+ b c) a 1e-6)
          (equal (+ c a) b 1e-6)
        )
      )
      (distance p1 p2) (distance p2 p3) (distance p1 p3)
    )
  )

  (defun coplanar-p-4 ( l )
    (or
      (vl-some (function (lambda ( x ) (apply (function collinear-p) (vl-remove x l)))) l)
      (apply (function inters) (append l (list nil)))
      (apply (function inters) (append (cdr l) (list (car l) nil)))
    )
  )

  (repeat (- (1- (setq k (1+ (length l)))) 4)
    (setq k (1- k))
    (eval (defun (strcat "coplanar-p-" (itoa k)) ( l ) (vl-every (function (lambda ( x ) (apply (function (read (strcat "collinear-p-" (itoa (1- k))))) (vl-remove x l)))) l)))
  )

  (setq r
    (if (> (length l) 3)
      (eval (read (strcat "(coplanar-p-" (itoa (length l)) ")")))
      t
    )
  )

  (repeat (- (1- (setq k (1+ (length l)))) 3)
    (setq k (1- k))
    (set (read (strcat "coplanar-p-" (itoa k))) nil)
  )

  r
)


Code: [Select]

;;; This should be working well and is effective - double iteration - chk collinearity + chk coplanarity... ;;;
(defun coplanar-p-ptlst ( l / v^v collinear-p p n e )

  (defun v^v ( u v )
    (list
      (- (* (cadr u) (caddr v)) (* (caddr u) (cadr v)))
      (- (* (caddr u) (car v)) (* (car u) (caddr v)))
      (- (* (car u) (cadr v)) (* (cadr u) (car v)))
    )
  )

  (defun collinear-p ( p1 p2 p3 )
    (
      (lambda ( a b c )
        (or
          (equal (+ a b) c 1e-6)
          (equal (+ b c) a 1e-6)
          (equal (+ c a) b 1e-6)
        )
      )
      (distance p1 p2) (distance p2 p3) (distance p1 p3)
    )
  )

  (if (> (length l) 3)
    (if (setq p (vl-some (function (lambda ( x ) (if (not (collinear-p (car l) (cadr l) x)) x))) (cddr l)))
      (progn
        (setq n (v^v (mapcar (function -) (cadr l) (car l)) (mapcar (function -) p (car l))))
        (setq e (caddr (trans (car l) 0 n)))
        (vl-every (function (lambda ( x ) (equal e (caddr (trans x 0 n)) 1e-6))) l)
      )
    )
    t
  )
)


[ribarm]

EE, could this be more effective?
Are we in hurry?