0 Members and 1 Guest are viewing this topic.
Find the 3 points of a given set that form the largest triangle not containing any point?
(defun c:Test (/ AT:TriangleArea _toList _lwpline _uTrans pointlist trianglelist triangle) (defun AT:TriangleArea (a b c) ;; Returns area of three provided points ;; If returned value is negative, last point (c) exists on right side of a-b vector ;; Alan J. Thompson, 06.09.10 (/ (- (* (- (car b) (car a)) (- (cadr c) (cadr a))) (* (- (cadr b) (cadr a)) (- (car c) (car a))) ) 2. ) ) (defun _toList (ss / i l) (if (and (eq (type ss) 'PICKSET) (> (sslength ss) 2)) (repeat (setq i (sslength ss)) (setq l (cons (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))) l)) ) ) ) (defun _lwpline (lst) (if (> (length lst) 1) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) '(70 . 1) ) (mapcar (function (lambda (p) (list 10 (car p) (cadr p)))) lst) ) ) ) ) (defun _uTrans (p) (trans p 0 1)) (foreach a (setq pointlist (_toList (ssget '((0 . "POINT"))))) (mapcar (function (lambda (b c) (if (not (ssget "_WP" (mapcar (function _uTrans) (list a b c)))) (setq trianglelist (cons (list (abs (AT:TriangleArea a b c)) a b c) trianglelist)) ) ) ) (cdr pointlist) (cddr pointlist) ) ) (_lwpline (cdr (car (vl-sort trianglelist (function (lambda (a b) (> (car a) (car b)))))))) (princ))
(defun c:test (/ A1 A2 L LST S) (defun ins (l p) ;; check is a point inside the triangle. ;; by ElpanovEvgeniy (not (if (< (sin (- (angle (last l) p) (angle (last l) (car l)))) -1e-14) (vl-every (function (lambda (a b) (< (sin (- (angle a p) (angle a b))) -1e-14))) l (cdr l) ) (vl-every (function (lambda (a b) (> (sin (- (angle a p) (angle a b))) 1e-14))) l (cdr l) ) ) ) ) (defun area_geron (p1 p2 p3 / l p) ;; area triangle ;; Uses the formula of Heron (setq l (cons 0 (mapcar (function distance) (list p1 p2 p3) (list p2 p3 p1))) p (/ (apply (function +) l) 2.) ) (sqrt (abs (apply (function *) (mapcar (function -) l (list p p p p))))) ) (if (setq a1 0 s (ssget "_x" '((0 . "point"))) ) (foreach a (setq lst (mapcar (function (lambda (a) (cdr (assoc 10 (entget (cadr a)))))) (ssnamex s) ) ) (foreach b lst (foreach c lst (if (and (> (setq a2 (area_geron a b c)) a1) (vl-every (function (lambda (p) (ins (list a b c) p))) lst) ) (setq a1 a2 l (list a b c) ) ) ) ) ) ) (entmakex (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 3) (70 . 1)) (mapcar (function (lambda (a) (cons 10 a))) l) ) ) (princ))
hi, Evgeniy , yours run fast , but not often a corret result ,see the picture : red is corret , yellow is yours resulttested in the new dwg
(defun c:t1 (/ A1 A2 L LST S) (defun ins (l p) ;; check is a point inside the triangle. ;; by ElpanovEvgeniy (not (if (< (sin (- (angle (last l) p) (angle (last l) (car l)))) -1e-6) (vl-every (function (lambda (a b) (< (sin (- (angle a p) (angle a b))) -1e-6))) l (cdr l) ) (vl-every (function (lambda (a b) (> (sin (- (angle a p) (angle a b))) 1e-6))) l (cdr l) ) ) ) ) (defun area_geron (p1 p2 p3 / l p) ;; area triangle ;; Uses the formula of Heron (setq l (cons 0 (mapcar (function distance) (list p1 p2 p3) (list p2 p3 p1))) p (/ (apply (function +) l) 2.) ) (sqrt (abs (apply (function *) (mapcar (function -) l (list p p p p))))) ) (if (setq a1 0 s (ssget "_x" '((0 . "point"))) ) (foreach a (setq lst (mapcar (function (lambda (a) (cdr (assoc 10 (entget (cadr a)))))) (ssnamex s) ) ) (foreach b lst (foreach c lst (if (and (> (setq a2 (area_geron a b c)) a1) (vl-every (function (lambda (p) (ins (list a b c) p))) lst) ) (setq a1 a2 l (list a b c) ) ) ) ) ) ) (entmakex (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 3) (70 . 1)) (mapcar (function (lambda (a) (cons 10 a))) l) ) ) (princ))