Author Topic: splitconcavepolygon2convexpolygons-triangles (Read 1272 times)

ribarm · « **on:** March 23, 2016, 03:05:26 PM »

This is looping infinitely... Comments are welcome and wise opinion...

Code - Auto/Visual Lisp: [Select]

(defun c:sconc2conv ( / LM:ConvexHull LM:Clockwise-p insidep nea process lw pl el ch pll ell chl eln plll elll pll3 ell3 en li1 li2 li3 f )
  ;;splitconcavepolygon2convexpolygons-triangles
 
  ;; Convex Hull  -  Lee Mac
  ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.
 
  (defun LM:ConvexHull ( lst / ch p0 )
      (cond
          (   (< (length lst) 4) lst)
          (   (setq p0 (car lst))
              (foreach p1 (cdr lst)
                  (if (or (< (cadr p1) (cadr p0))
                          (and (= (cadr p1) (cadr p0)) (< (car p1) (car p0)))
                      )
                      (setq p0 p1)
                  )
              )
              (setq lst (vl-remove p0 lst))
              (setq lst (append (list p0) lst))
              (setq lst
                  (vl-sort lst
                      (function
                          (lambda ( a b / c d )
                              (if (or (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8) (and (or (equal c 0.0 1e-8) (equal c (* 2 pi) 1e-8)) (or (equal d 0.0 1e-8) (equal d (* 2 pi) 1e-8))))
                                  (< (distance (list (car p0) (cadr p0)) a) (distance (list (car p0) (cadr p0)) b))
                                  (< c d)
                              )
                          )
                      )
                  )
              )
              (setq ch (list (caddr lst) (cadr lst) (car lst)))
              (foreach pt (cdddr lst)
                  (setq ch (cons pt ch))
                  (while (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt))
                      (setq ch (cons pt (cddr ch)))
                  )
              )
              (reverse ch)
          )
      )
  )
 
  ;; Clockwise-p  -  Lee Mac
  ;; Returns T if p1,p2,p3 are clockwise oriented or collinear
 
  (defun LM:Clockwise-p ( p1 p2 p3 )
      (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
              (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
          )
          1e-8
      )
  )
 
  (defun insidep ( pt entn / big flag obj1 obj2 obj3 p1 p2 small )
    (vl-load-com)
    (if (and pt entn)
      (progn
        (setq obj1 (vlax-ename->vla-object entn))
        (setq obj2 (car (vlax-invoke obj1 'Offset 0.001))
              obj3 (car (vlax-invoke obj1 'Offset -0.001))
        )
        (if (> (vla-get-area obj2) (vla-get-area obj3))
          (progn
            (set 'big obj2)
            (set 'small obj3)
          )
          (progn
            (set 'big obj3)
            (set 'small obj2)
          )
        )
        (setq p1 (vlax-curve-getClosestPointTo big pt)
              p2 (vlax-curve-getClosestPointTo small pt)
        )
        (if (> (distance pt p1) (distance pt p2))
          (setq flag T)
          (setq flag nil)
        )
        (mapcar (function (lambda (x)
                            (progn
                              (vla-delete x)
                              (vlax-release-object x)
                            )
                          )
                )
                (list big small)
        )
        (if (equal (trans pt entn 0) (vlax-curve-getclosestpointto entn pt) 1e-6)
          (setq flag T)
        )
      )
    )
    flag
  )
 
  (defun nea ( p1 p2 )
    (polar p1 (angle p1 p2) 1e-2)
  )
 
  (defun process ( pll ell )
    (setq plll nil eln nil chl t pl pll)
    (while (or (< (length plll) 3) (not (vl-every '(lambda ( x ) (vl-position x chl)) plll)))
      (setq p (car pll))
      (setq plll (cons p plll))
      (setq chl (LM:ConvexHull plll))
      (setq pll (cdr pll))
    )
    (command "_.PLINE")
    (foreach p plll
      (command "_non" p)
    )
    (command "_C")
    (setq elll (mapcar '(lambda ( a b ) (list a b)) plll (cdr (reverse (cons (car plll) (reverse plll))))))
    (foreach e elll
      (if (not (or (vl-position e ell) (vl-position e el) (vl-position e en) (vl-position (reverse e) ell) (vl-position (reverse e) el) (vl-position (reverse e) en)))
        (setq eln (cons e eln) en (cons e en))
      )
    )
    (if eln
      (if (= (length eln) 1)
        (progn
          (setq pll3 (reverse (member (cadar eln) (reverse (member (caar eln) (append pl pl))))))
          (if (/= (length pll3) (1- (length pl)))
            (setq pll3 (reverse (member (caar eln) (reverse (member (cadar eln) (append pl pl))))))
          )
          (while
            (or 
              (not (insidep (nea (car pll3) (cadr pll3)) lw)) (not (insidep (nea (cadr pll3) (car pll3)) lw))
              (not (insidep (nea (cadr pll3) (caddr pll3)) lw)) (not (insidep (nea (caddr pll3) (cadr pll3)) lw))
              (not (insidep (nea (car pll3) (caddr pll3)) lw)) (not (insidep (nea (caddr pll3) (car pll3)) lw))
              (progn
                (setq li1 (entmakex (list '(0 . "LINE") (cons 10 (car pll3)) (cons 11 (cadr pll3)))))
                (setq f (> (length (vlax-invoke (vlax-ename->vla-object li1) 'intersectwith (vlax-ename->vla-object lw) acextendnone)) 6))
                (entdel li1)
                f
              )
              (progn
                (setq li2 (entmakex (list '(0 . "LINE") (cons 10 (cadr pll3)) (cons 11 (caddr pll3)))))
                (setq f (> (length (vlax-invoke (vlax-ename->vla-object li2) 'intersectwith (vlax-ename->vla-object lw) acextendnone)) 6))
                (entdel li2)
                f
              )
              (progn
                (setq li3 (entmakex (list '(0 . "LINE") (cons 10 (car pll3)) (cons 11 (caddr pll3)))))
                (setq f (> (length (vlax-invoke (vlax-ename->vla-object li3) 'intersectwith (vlax-ename->vla-object lw) acextendnone)) 6))
                (entdel li3)
                f
              )
            )
            (setq pll3 (cons (last pll3) (reverse (cdr (reverse pll3)))))
          )
          (setq ell3 (mapcar '(lambda ( a b ) (list a b)) pll (cdr (reverse (cons (car pll) (reverse pll))))))
        )
      )
    )
  )
 
  (setq lw (car (entsel "\nPick concave polygon LWPOLYLINE...")))
  (while (not (and lw (= (cdr (assoc 0 (entget lw))) "LWPOLYLINE") (or (= (cdr (assoc 70 (entget lw))) 1) (= (cdr (assoc 70 (entget lw))) 129)) (vl-every 'zerop (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 42)) (entget lw))))))
    (prompt "\nMissed or wrong entity picked... Pick concave polygon LWPOLYLINE again...")
    (setq lw (car (entsel)))
  )
  (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget lw))))
  (setq el (mapcar '(lambda ( a b ) (list a b)) pl (cdr (reverse (cons (car pl) (reverse pl))))))
  (setq ch (LM:ConvexHull pl))
  (if (vl-every '(lambda ( x ) (vl-position x ch)) pl)
    (prompt "\nPicked convex polygon...")
    (progn
      (setq pll pl ell el eln t)
      (while eln
        (if (and pll3 ell3)
          (process pll3 ell3)
          (process pll ell)
        )
      )
    )
  )
  (princ)
)
 

Code - Auto/Visual Lisp: [Select]

(defun c:poltriang ( / LM:ConvexHull LM:Clockwise-p insidep nea process lw pl el ch pll ell chl eln plll elll pll3 ell3 en li1 li2 li3 f )
  ;;triangulate polygonal LWPOLYLINE
 
  ;; Convex Hull  -  Lee Mac
  ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.
 
  (defun LM:ConvexHull ( lst / ch p0 )
      (cond
          (   (< (length lst) 4) lst)
          (   (setq p0 (car lst))
              (foreach p1 (cdr lst)
                  (if (or (< (cadr p1) (cadr p0))
                          (and (= (cadr p1) (cadr p0)) (< (car p1) (car p0)))
                      )
                      (setq p0 p1)
                  )
              )
              (setq lst (vl-remove p0 lst))
              (setq lst (append (list p0) lst))
              (setq lst
                  (vl-sort lst
                      (function
                          (lambda ( a b / c d )
                              (if (or (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8) (and (or (equal c 0.0 1e-8) (equal c (* 2 pi) 1e-8)) (or (equal d 0.0 1e-8) (equal d (* 2 pi) 1e-8))))
                                  (< (distance (list (car p0) (cadr p0)) a) (distance (list (car p0) (cadr p0)) b))
                                  (< c d)
                              )
                          )
                      )
                  )
              )
              (setq ch (list (caddr lst) (cadr lst) (car lst)))
              (foreach pt (cdddr lst)
                  (setq ch (cons pt ch))
                  (while (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt))
                      (setq ch (cons pt (cddr ch)))
                  )
              )
              (reverse ch)
          )
      )
  )
 
  ;; Clockwise-p  -  Lee Mac
  ;; Returns T if p1,p2,p3 are clockwise oriented or collinear
 
  (defun LM:Clockwise-p ( p1 p2 p3 )
      (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
              (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
          )
          1e-8
      )
  )
 
  (defun insidep ( pt entn / big flag obj1 obj2 obj3 p1 p2 small )
    (vl-load-com)
    (if (and pt entn)
      (progn
        (setq obj1 (vlax-ename->vla-object entn))
        (setq obj2 (car (vlax-invoke obj1 'Offset 0.001))
              obj3 (car (vlax-invoke obj1 'Offset -0.001))
        )
        (if (> (vla-get-area obj2) (vla-get-area obj3))
          (progn
            (set 'big obj2)
            (set 'small obj3)
          )
          (progn
            (set 'big obj3)
            (set 'small obj2)
          )
        )
        (setq p1 (vlax-curve-getClosestPointTo big pt)
              p2 (vlax-curve-getClosestPointTo small pt)
        )
        (if (> (distance pt p1) (distance pt p2))
          (setq flag T)
          (setq flag nil)
        )
        (mapcar (function (lambda (x)
                            (progn
                              (vla-delete x)
                              (vlax-release-object x)
                            )
                          )
                )
                (list big small)
        )
        (if (equal (trans pt entn 0) (vlax-curve-getclosestpointto entn pt) 1e-6)
          (setq flag T)
        )
      )
    )
    flag
  )
 
  (defun nea ( p1 p2 )
    (polar p1 (angle p1 p2) 1e-2)
  )
 
  (defun process ( pll ell )
    (setq plll nil eln nil chl t pl pll)
    (while (or (< (length plll) 3) (not (vl-every '(lambda ( x ) (vl-position x chl)) plll)))
      (setq p (car pll))
      (setq plll (cons p plll))
      (setq chl (LM:ConvexHull plll))
      (setq pll (cdr pll))
    )
    (command "_.PLINE")
    (foreach p plll
      (command "_non" p)
    )
    (command "_C")
    (setq elll (mapcar '(lambda ( a b ) (list a b)) plll (cdr (reverse (cons (car plll) (reverse plll))))))
    (foreach e elll
      (if (not (or (vl-position e ell) (vl-position e el) (vl-position e en) (vl-position (reverse e) ell) (vl-position (reverse e) el) (vl-position (reverse e) en)))
        (setq eln (cons e eln) en (cons e en))
      )
    )
    (if eln
      (if (= (length eln) 1)
        (progn
          (setq pll3 (reverse (member (cadar eln) (reverse (member (caar eln) (append pl pl))))))
          (if (/= (length pll3) (1- (length pl)))
            (setq pll3 (reverse (member (caar eln) (reverse (member (cadar eln) (append pl pl))))))
          )
          (while
            (or 
              (not (insidep (nea (car pll3) (cadr pll3)) lw)) (not (insidep (nea (cadr pll3) (car pll3)) lw))
              (not (insidep (nea (cadr pll3) (caddr pll3)) lw)) (not (insidep (nea (caddr pll3) (cadr pll3)) lw))
              (not (insidep (nea (car pll3) (caddr pll3)) lw)) (not (insidep (nea (caddr pll3) (car pll3)) lw))
              (progn
                (setq li1 (entmakex (list '(0 . "LINE") (cons 10 (car pll3)) (cons 11 (cadr pll3)))))
                (setq f (> (length (vlax-invoke (vlax-ename->vla-object li1) 'intersectwith (vlax-ename->vla-object lw) acextendnone)) 6))
                (entdel li1)
                f
              )
              (progn
                (setq li2 (entmakex (list '(0 . "LINE") (cons 10 (cadr pll3)) (cons 11 (caddr pll3)))))
                (setq f (> (length (vlax-invoke (vlax-ename->vla-object li2) 'intersectwith (vlax-ename->vla-object lw) acextendnone)) 6))
                (entdel li2)
                f
              )
              (progn
                (setq li3 (entmakex (list '(0 . "LINE") (cons 10 (car pll3)) (cons 11 (caddr pll3)))))
                (setq f (> (length (vlax-invoke (vlax-ename->vla-object li3) 'intersectwith (vlax-ename->vla-object lw) acextendnone)) 6))
                (entdel li3)
                f
              )
            )
            (setq pll3 (cons (last pll3) (reverse (cdr (reverse pll3)))))
          )
          (setq ell3 (mapcar '(lambda ( a b ) (list a b)) pll (cdr (reverse (cons (car pll) (reverse pll))))))
        )
      )
    )
  )
 
  (setq lw (car (entsel "\nPick polygonal LWPOLYLINE...")))
  (while (not (and lw (= (cdr (assoc 0 (entget lw))) "LWPOLYLINE") (or (= (cdr (assoc 70 (entget lw))) 1) (= (cdr (assoc 70 (entget lw))) 129)) (vl-every 'zerop (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 42)) (entget lw))))))
    (prompt "\nMissed or wrong entity picked... Pick polygonal LWPOLYLINE again...")
    (setq lw (car (entsel)))
  )
  (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget lw))))
  (setq el (mapcar '(lambda ( a b ) (list a b)) pl (cdr (reverse (cons (car pl) (reverse pl))))))
  (setq ch (LM:ConvexHull pl))
  (if (vl-every '(lambda ( x ) (vl-position x ch)) pl)
    (foreach tr (mapcar '(lambda ( a b ) (list (car pl) a b)) (cdr pl) (cddr pl))
      (command "_.PLINE")
      (foreach p tr
        (command "_non" p)
      )
      (command "_C")
    )
    (progn
      (setq pll pl ell el eln t)
      (while eln
        (if (and pll3 ell3)
          (process pll3 ell3)
          (process pll ell)
        )
      )
    )
  )
  (princ)
)
 

Thanks, M.R.
[EDIT : Updated code and it works...]

ribarm · « **Reply #1 on:** March 23, 2016, 06:17:00 PM »

Fixed code... You can test it and inform me if somethings wrong...

Thanks, M.R.

ribarm · « **Reply #2 on:** March 24, 2016, 11:27:00 AM »

As addition, here is my version of polygon centroid based on previously posted algorithm...

Code - Auto/Visual Lisp: [Select]

(defun polygoncentroid ( lw / LM:ConvexHull LM:Clockwise-p insidep nea triangarea gravitycenttriang process p pl el ch pll ell chl eln plll elll pll3 ell3 en li1 li2 li3 f trl ar mx my )
  ;;splitconcavepolygon2convexpolygons-triangles
 
  ;; Convex Hull  -  Lee Mac
  ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.
 
  (defun LM:ConvexHull ( lst / ch p0 )
      (cond
          (   (< (length lst) 4) lst)
          (   (setq p0 (car lst))
              (foreach p1 (cdr lst)
                  (if (or (< (cadr p1) (cadr p0))
                          (and (= (cadr p1) (cadr p0)) (< (car p1) (car p0)))
                      )
                      (setq p0 p1)
                  )
              )
              (setq lst (vl-remove p0 lst))
              (setq lst (append (list p0) lst))
              (setq lst
                  (vl-sort lst
                      (function
                          (lambda ( a b / c d )
                              (if (or (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8) (and (or (equal c 0.0 1e-8) (equal c (* 2 pi) 1e-8)) (or (equal d 0.0 1e-8) (equal d (* 2 pi) 1e-8))))
                                  (< (distance (list (car p0) (cadr p0)) a) (distance (list (car p0) (cadr p0)) b))
                                  (< c d)
                              )
                          )
                      )
                  )
              )
              (setq ch (list (caddr lst) (cadr lst) (car lst)))
              (foreach pt (cdddr lst)
                  (setq ch (cons pt ch))
                  (while (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt))
                      (setq ch (cons pt (cddr ch)))
                  )
              )
              (reverse ch)
          )
      )
  )
 
  ;; Clockwise-p  -  Lee Mac
  ;; Returns T if p1,p2,p3 are clockwise oriented or collinear
 
  (defun LM:Clockwise-p ( p1 p2 p3 )
      (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
              (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
          )
          1e-8
      )
  )
 
  (defun insidep ( pt entn / big flag obj1 obj2 obj3 p1 p2 small )
    (vl-load-com)
    (if (and pt entn)
      (progn
        (setq obj1 (vlax-ename->vla-object entn))
        (setq obj2 (car (vlax-invoke obj1 'Offset 0.001))
              obj3 (car (vlax-invoke obj1 'Offset -0.001))
        )
        (if (> (vla-get-area obj2) (vla-get-area obj3))
          (progn
            (set 'big obj2)
            (set 'small obj3)
          )
          (progn
            (set 'big obj3)
            (set 'small obj2)
          )
        )
        (setq p1 (vlax-curve-getClosestPointTo big pt)
              p2 (vlax-curve-getClosestPointTo small pt)
        )
        (if (> (distance pt p1) (distance pt p2))
          (setq flag T)
          (setq flag nil)
        )
        (mapcar (function (lambda (x)
                            (progn
                              (vla-delete x)
                              (vlax-release-object x)
                            )
                          )
                )
                (list big small)
        )
        (if (equal (trans pt entn 0) (vlax-curve-getclosestpointto entn pt) 1e-6)
          (setq flag T)
        )
      )
    )
    flag
  )
 
  (defun nea ( p1 p2 )
    (polar p1 (angle p1 p2) 1e-2)
  )
 
  (defun triangarea ( p1 p2 p3 / unit mid v12 v13 v1 v21 v23 v2 c cz r ar )
 
    (defun unit ( v )
      (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
    )
 
    (defun mid ( p1 p2 )
      (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
    )
 
    (setq v12 (unit (mapcar '- p2 p1)))
    (setq v13 (unit (mapcar '- p3 p1)))
    (setq v1 (unit (mid v12 v13)))
 
    (setq v21 (mapcar '- v12))
    (setq v23 (unit (mapcar '- p3 p2)))
    (setq v2 (unit (mid v21 v23)))
 
    (setq c (inters p1 (mapcar '+ p1 v1) p2 (mapcar '+ p2 v2) nil))
    (setq cz (trans c 0 v12))
    (setq r (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v12)) cz))
 
    (setq ar (* r 0.5 (+ (distance p1 p2) (distance p2 p3) (distance p3 p1))))
 
    ar
  )
 
  (defun gravitycenttriang ( p1 p2 p3 / mid p12 p23 p31 c )
 
    (defun mid ( p1 p2 )
      (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
    )
 
    (setq p12 (mid p1 p2))
    (setq p23 (mid p2 p3))
    (setq p31 (mid p3 p1))
    (setq c (inters p12 p3 p1 p23))
 
    c
 
  )
 
  (defun process ( pll ell )
    (setq plll nil eln nil chl t pl pll)
    (while (or (< (length plll) 3) (not (vl-every '(lambda ( x ) (vl-position x chl)) plll)))
      (setq p (car pll))
      (setq plll (cons p plll))
      (setq chl (LM:ConvexHull plll))
      (setq pll (cdr pll))
    )
    (setq trl (cons plll trl))
    (setq elll (mapcar '(lambda ( a b ) (list a b)) plll (cdr (reverse (cons (car plll) (reverse plll))))))
    (foreach e elll
      (if (not (or (vl-position e ell) (vl-position e el) (vl-position e en) (vl-position (reverse e) ell) (vl-position (reverse e) el) (vl-position (reverse e) en)))
        (setq eln (cons e eln) en (cons e en))
      )
    )
    (if eln
      (if (= (length eln) 1)
        (progn
          (setq pll3 (reverse (member (cadar eln) (reverse (member (caar eln) (append pl pl))))))
          (if (/= (length pll3) (1- (length pl)))
            (setq pll3 (reverse (member (caar eln) (reverse (member (cadar eln) (append pl pl))))))
          )
          (while
            (or 
              (not (insidep (nea (car pll3) (cadr pll3)) lw)) (not (insidep (nea (cadr pll3) (car pll3)) lw))
              (not (insidep (nea (cadr pll3) (caddr pll3)) lw)) (not (insidep (nea (caddr pll3) (cadr pll3)) lw))
              (not (insidep (nea (car pll3) (caddr pll3)) lw)) (not (insidep (nea (caddr pll3) (car pll3)) lw))
              (progn
                (setq li1 (entmakex (list '(0 . "LINE") (cons 10 (car pll3)) (cons 11 (cadr pll3)))))
                (setq f (> (length (vlax-invoke (vlax-ename->vla-object li1) 'intersectwith (vlax-ename->vla-object lw) acextendnone)) 6))
                (entdel li1)
                f
              )
              (progn
                (setq li2 (entmakex (list '(0 . "LINE") (cons 10 (cadr pll3)) (cons 11 (caddr pll3)))))
                (setq f (> (length (vlax-invoke (vlax-ename->vla-object li2) 'intersectwith (vlax-ename->vla-object lw) acextendnone)) 6))
                (entdel li2)
                f
              )
              (progn
                (setq li3 (entmakex (list '(0 . "LINE") (cons 10 (car pll3)) (cons 11 (caddr pll3)))))
                (setq f (> (length (vlax-invoke (vlax-ename->vla-object li3) 'intersectwith (vlax-ename->vla-object lw) acextendnone)) 6))
                (entdel li3)
                f
              )
            )
            (setq pll3 (cons (last pll3) (reverse (cdr (reverse pll3)))))
          )
          (setq ell3 (mapcar '(lambda ( a b ) (list a b)) pll (cdr (reverse (cons (car pll) (reverse pll))))))
        )
      )
    )
  )
 
  (if (and lw (= (cdr (assoc 0 (entget lw))) "LWPOLYLINE") (or (= (cdr (assoc 70 (entget lw))) 1) (= (cdr (assoc 70 (entget lw))) 129)) (vl-every 'zerop (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 42)) (entget lw)))))
    (progn
      (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget lw))))
      (setq el (mapcar '(lambda ( a b ) (list a b)) pl (cdr (reverse (cons (car pl) (reverse pl))))))
      (setq ch (LM:ConvexHull pl))
      (if (vl-every '(lambda ( x ) (vl-position x ch)) pl)
        (progn
          (setq p (car pl))
          (setq trl (mapcar '(lambda ( a b ) (list p a b)) (cdr pl) (cddr pl)))
        )
        (progn
          (setq pll pl ell el eln t)
          (while eln
            (if (and pll3 ell3)
              (process pll3 ell3)
              (process pll ell)
            )
          )
        )
      )
      (setq ar 0.0 mx 0.0 my 0.0)
      (foreach tr trl
        (setq ar (+ ar (triangarea (car tr) (cadr tr) (caddr tr))))
        (setq mx (+ mx (* (triangarea (car tr) (cadr tr) (caddr tr)) (car (gravitycenttriang (car tr) (cadr tr) (caddr tr))))))
        (setq my (+ my (* (triangarea (car tr) (cadr tr) (caddr tr)) (cadr (gravitycenttriang (car tr) (cadr tr) (caddr tr))))))
      )
      (list (/ mx ar) (/ my ar) 0.0)
    )
    (prompt "\nWrong entity supplied as function argument or nil argument... Please supply polygon LWPOLYLINE as argument next time...")
  )
)
 

Test :

Code - Auto/Visual Lisp: [Select]

(setq cent (polygoncentroid (car (entsel "\nPick polygonal LWPOLYLINE..."))))
 

M.R.
P.S. My testing results are identical with AutoDesks (polygon -> region -> centroid), you can now check it...

News:

Author Topic: splitconcavepolygon2convexpolygons-triangles (Read 1272 times)

ribarm

splitconcavepolygon2convexpolygons-triangles

ribarm

Re: splitconcavepolygon2convexpolygons-triangles

ribarm

Re: splitconcavepolygon2convexpolygons-triangles