pface convex hull

[Tom_Brabant]

Given a random set of points in 3 dimensions, I would like to find the convex hull and make a polyface mesh (PFACE) to represent the hull. Any suggestions?

[Jürg Menzi]

Hi Tom

I haven't time to adapt this to 3D, but you've a startup:

;
; == Function MeGetConvexHull
; Calculates the convex hull from a 'cloud' of points.
; Arguments [Type]:
;   Lst = Point list [LIST]
; Return [Type]:
;   > Hull points [LIST]
; Notes:
;   - Algorithm by Graham
;
(defun MeGetConvexHull (Lst / FstCnt LstLen MinCnt NxtCnt TmpLst)
 (setq LstLen (length Lst)
       MinCnt 0
       FstCnt 1
 )
 (while (< FstCnt LstLen)
  (if (< (cadr (nth FstCnt Lst)) (cadr (nth MinCnt Lst)))
   (setq MinCnt FstCnt)
  )
  (setq FstCnt (1+ FstCnt))
 )
 (setq FstCnt 0)
 (while (< FstCnt LstLen)
  (if (and
       (equal (cadr (nth FstCnt Lst)) (cadr (nth MinCnt Lst)) 1E-8)
       (> (car (nth FstCnt Lst)) (car (nth MinCnt Lst)))
      )
   (setq MinCnt FstCnt)
  )
  (setq FstCnt (1+ FstCnt))
 )
 (setq TmpLst (MeSwapList Lst 0 MinCnt)
       TmpLst (vl-sort
               TmpLst
               (function
                (lambda (e1 e2)
                 (<
                  (MeCalcTheta (nth 0 TmpLst) e1)
                  (MeCalcTheta (nth 0 TmpLst) e2)
                 )
                )
               )
              )
       TmpLst (cons (last TmpLst) TmpLst)
       NxtCnt 3
       FstCnt 4
 )
 (while (<= FstCnt LstLen)
  (while (>=
          (MeGetCcw
           (nth NxtCnt TmpLst)
           (nth (1- NxtCnt) TmpLst)
           (nth FstCnt TmpLst)
          )
          0
         )
   (setq NxtCnt (1- NxtCnt))
  )
  (setq NxtCnt (1+ NxtCnt)
        TmpLst (MeSwapList TmpLst FstCnt NxtCnt)
        FstCnt (1+ FstCnt)
  )
 )
 (mapcar '(lambda (l) (nth l TmpLst)) (MeRepeatedList 0 (1- NxtCnt) 1))
)
;
; == Function MeSwapList
; Swaps 2 atoms in a list.
; Arguments [Type]:
;   Lst = List to swap [LIST]
;   Fst = Source position [INT]
;   Nxt = Target position [INT]
; Return [Type]:
;   > Swapped list [LIST]
; Notes:
;   None
;
(defun MeSwapList (Lst Fst Nxt / FstVal NxtVal TmpLst)
 (setq FstVal (nth Fst Lst)
       NxtVal (nth Nxt Lst)
       TmpLst (MeEditList 0 Fst NxtVal Lst)
 )
 (MeEditList 0 Nxt FstVal TmpLst)
)
;
; == Function MeCalcTheta
; Calculates a ordinal number between 2 points.
; Arguments [Type]:
;   Pt1 = First point [LIST]
;   Pt2 = Second point [LIST]
; Return [Type]:
;   > A value between 0 and 360 [REAL]
; Notes:
;   None
;
(defun MeCalcTheta (Pt1 Pt2 / X__Abs Y__Abs X__Dif Y__Dif TheVal)
 (setq X__Dif (- (car Pt2) (car Pt1))
       Y__Dif (- (cadr Pt2) (cadr Pt1))
       X__Abs (abs X__Dif)
       Y__Abs (abs Y__Dif)
       TheVal (if (equal (+ X__Abs Y__Abs) 0 1E-5)
               0
               (/ Y__Dif (+ X__Abs Y__Abs))
              )
 )
 (if (< X__Dif 0)
  (setq TheVal (- 2.0 TheVal))
  (if (< Y__Dif 0) (setq TheVal (+ 4.0 TheVal)))
 )
 (* 90.0 TheVal)
)
;
; == Function MeGetCcw
; Determines the direction of 3 points.
; Arguments [Type]:
;   Pt1 = First point [LIST]
;   Pt1 = Second point [LIST]
;   Pt3 = Third point [LIST]
; Return [Type]:
;   >  1 = ccw [INT]
;   > -1 = cw [INT]
;   >  0 = Colinear [INT]
; Notes:
;   None
;
(defun MeGetCcw (Pt0 Pt1 Pt2 / X1_Dif X1_Sqr X2_Dif X2_Sqr Y1_Dif Y1_Sqr
                               Y2_Dif Y2_Sqr)
 (setq X1_Dif (- (car Pt1) (car Pt0))
       Y1_Dif (- (cadr Pt1) (cadr Pt0))
       X2_Dif (- (car Pt2) (car Pt0))
       Y2_Dif (- (cadr Pt2) (cadr Pt0))
       X1_Sqr (* X1_Dif X1_Dif)
       Y1_Sqr (* Y1_Dif Y1_Dif)
       X2_Sqr (* X2_Dif X2_Dif)
       Y2_Sqr (* Y2_Dif Y2_Dif)
 )
 (cond
  ((> (* X1_Dif Y2_Dif) (* Y1_Dif X2_Dif)) 1)
  ((< (* X1_Dif Y2_Dif) (* Y1_Dif X2_Dif)) -1)
  ((or (< (* X1_Dif X2_Dif) 0) (< (* Y1_Dif Y2_Dif) 0)) -1)
  ((< (+ X1_Sqr Y1_Sqr) (+ X2_Sqr Y2_Sqr)) 1)
  (0)
 )
)
;
; == Function MeRepeatedList
; Fills a list with numbers from Srt to End, using increment of Inc.
; Arguments [Type]:
;   Srt = Start number [INT] or [REAL]
;   End = End number [INT] or [REAL]
;   Inc = Increment to use [INT] or [REAL]
; Return [Type]:
;   > List containting all numbers between and including Srt and End
; Notes:
;   If End is not a repeated of End - Srt, End will not be included
;
(defun MeRepeatedList (Srt End Inc / TmpVal RetVal)
 (setq TmpVal (- Srt Inc))
 (while (< TmpVal End)
  (setq RetVal (append
                RetVal
                (list (setq TmpVal (+ TmpVal Inc)))
               )
  )
 )
 RetVal
)
;
; == Function MeEditList
; Delete, replace or append a list.
; Arguments [Type]:
;   Mde = Mode  1 append  [INT]
;         Mode  0 replace [INT]
;         Mode -1 delete  [INT]
;   Pos = Position in list [INT]
;   Val = New value [INT/REAL/STR/LIST]
;   Lst = List [LIST]
; Return [Type]:
;   > Modified list [LIST]
; Notes:
;   - Delete and replace, require the position (Pos) in list.
;   - Append and replace, require the new value (Val).
;   - :vlax-null items are not allowed in the list argument
;
(defun MeEditList (Mde Pos Val Lst / Countr TmpLst TmpVal)
 (if (= Mde 1)
  (reverse (cons Val (reverse Lst)))
  (progn 
   (setq Countr -1
         TmpVal (if (= Mde -1) :vlax-null Val)
         TmpLst (mapcar
                '(lambda (l)
                  (if (= Pos (setq Countr (1+ Countr))) TmpVal l)
                 ) Lst
                )
   )
   (vl-remove :vlax-null TmpLst)
  )
 )
)

Cheers
--
Juerg Menzi
MENZI ENGINEERING GmbH, Switzerland
http://www.menziengineering.ch

[Tom_Brabant]

Very nice, Juerg. Are you still interested in a 3d solution? If so, I'll try to return the favor. Might have to abandon Graham scan for this, though, and pursue divide and conquer, or some other algorithm. Also looking into alpha shapes, and just building a pface from a network of line entities which is a wheel I'm sure someone else must have already invented. The primary motivation is giving my non-programming CAD students a reason to appreciate polyface meshes, and to get them to work with some non-CAD students using 3Dsmax. Thanks for getting me out of the starting gate :)

{Which way is up?
(defun det2 (a d b c)(- (* a d)(* b c)))
(defun crossprod (u v)
(list (det2 (cadr u)(caddr v)
(caddr u)(cadr v))
(- (det2 (car u)(caddr v)
(caddr u)(car v)))
(det2 (car u)(cadr v)
(cadr u)(car v))
))
}