Leaderboard

Here's another .. no fancy reporting: (defun c:foo (/ _s2l pts s) (defun _s2l (s) (if s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))) ) (foreach x (_s2l (setq s (ssget '((0 . "insert,lwpolyline"))))) (if (= "LWPOLYLINE" (cdr (assoc 0 (entget x)))) (progn (setq pts (mapcar 'cdr (vl-remove-if '(lambda (p) (/= 10 (car p))) (entget x)))) (foreach y (_s2l (ssget "_WP" pts '((0 . "insert")))) (ssdel y s)) (ssdel x s) ) ) ) (sssetfirst nil s) (princ) )

Sorry, but I couldn't resist this. Attached takes care of displaying the overall area and a final polyline. I've used VL as it retains all the properties of the original polyline, but would also work entmaking a new polyline, transfering properties then deleting the old. Bulges could be a problems and also the need to stop stretching once the intersection point is reached/ the segment length is zero. aaa-v2.lsp

as i said, since its structure is provided, it can be optimized to suit your needs. please appreciate any afford (ideas, concept, psuedo etc..) not just full code. try learning : ( setq area ( getreal "\nInput area" ) ) (defun c:aaa1 ( / ang en ep i k l l1 lst n p p1 s ) ;;(revision 1) hanhphuc 30.03.2020 (and (setq s (ssget "_:S:E+." '((0 . "LWPOLYLINE")))) (setq en (ssname s 0) p1 (osnap (cadr (grread t 13)) "_nea")) (setq p (trans p1 1 0) i (vlax-curve-getparamatpoint en p)) (setq i (fix i) ep (vlax-curve-getEndParam en)) (>= ep 2) (setq ang (mapcar '(lambda (x) (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en x))) (cond ( (< i 1)(list (1- ep) (1+ i)) ) ( (>= i (1- ep)) (list (1- i) 0)) ( (list (1- i) (1+ i)) ) ) ) ) (princ "\nStretching segment.. \n") (while (and p (mapcar 'set '(k p) (grread t 13)) (= 5 k) (setq p1 (trans p 1 0)) ) (redraw) (if (vl-some 'not (setq l (mapcar '(lambda (a b / p ) (list (setq p (vlax-curve-getPointAtParam en b)) (inters p (polar p a 1.0) p1 (polar p1 (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en i)) 1.0 ) nil ) ) ) ang (list i (1+ i)) ) l1 (apply 'append l) n (length l1) lst (mapcar '(lambda (x)(nth x l1 )) '(0 1 3 2)) ) ) (setq p nil) (progn (grvecs (apply 'append ( mapcar '( lambda (x) (cons (car x) (mapcar '(lambda (x) (trans x 0 1)) (cdr x))) ) (cons (cons 2 (mapcar 'cadr l)) (mapcar '(lambda (x) (cons 2 x)) l ) ) ) ) ) (princ (strcat "\rArea = " (rtos (abs (math:area lst )) 2 2) " M\U+00B2 " ) ) ) ) ); while (entmakex (vl-list* '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(70 . 0) (cons 90 n ) (setq lst (mapcar '(lambda (x)(cons 10 x)) lst)) ) ) ) (princ) ) ;math formula ; | x1 x2 x3 x4 xn.. | ; 1 | \/ \/ \/ \/ | ;Area= / | /\ /\ /\ /\ | ; 2 | y1 y2 y3 y4 yn.. | ; (defun math:area (l) ;hanhphuc (* (apply '- (mapcar '(lambda (x y) (apply '+ (mapcar '* (mapcar x l) (mapcar y (append (cdr l) (list (car l))))) ) ) '(car cadr) '(cadr car) ) ) 0.5 ) ) p/s: today start working at home using my engineer's notebook - bricscad v19 not support double quotes lambda ' ' ((x) now changed previous to '(lambda (x)

Hi all guys, I need a function to find the point that has minimum Y in a list, like this : ((10 15) (19 25) (26 10) (50 32)) >> (26 10) Can some one give me a function or best way to do this? Thanks in advanced. I won't probably iterate. I'll do the below, though I'm not sure if it's more efficient: (defun findmin (lst / m) (setq m (apply 'min (mapcar 'cadr lst))) (car (vl-member-if '(lambda (x) (eq (cadr x) m)) lst)) )

When finding extrema, it is typically more efficient to iterate over the list once, rather than using a sorting function (such as vl-sort) which necessarily performs many more comparisons to order the entire list - this is one circumstance where shorter code is not necessarily more efficient. You may find this thread of interest in this regard.

Try. I can't test as I'm away from AutoCAD (defun miny (lst) (car (vl-sort lst '(lambda (x y) (< (cadr x) (cadr y)))))) ;example call (setq ymin (miny '((10 15) (19 25) (26 10) (50 32))))

Very nice @hanhphuc. You cannot select the first or last segment though, perhaps (defun c:aaa ( / ang en i k l p p1 ep pp np) (and (mapcar 'set '(en p) (entsel "Pick segment on LWPOLYLINE.. ")) (setq p1 (osnap p "nea")) (setq p (trans p1 1 0)) (setq i (fix (vlax-curve-getparamatpoint en p))) (setq ep (vlax-curve-getEndParam en)) (setq np (if (= i (1- ep)) 0 (1+ i))) (setq pp (if (zerop i) (1- ep) (1- i))) (>= ep 3) ;(< 0 i (1- ep)) (setq ang (mapcar ''((x) (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en x))) (list pp np))) (while (and p (mapcar 'set '(k p) (grread t 13)) (= 5 k) (setq p1 (trans p 1 0)) ) (redraw) (setq l (mapcar ''((a b / p) (list (setq p (vlax-curve-getPointAtParam en b)) (inters p (polar p a 1.0) p1 (polar p1 (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en i)) 1.0 ) nil) ) ) ang (list i np);(1+ i)) ) ) (grvecs (apply 'append (mapcar ''((x) (cons (car x) (mapcar ''((x) (trans x 0 1)) (cdr x)))) (cons (cons 2 (mapcar 'cadr l)) (mapcar ''((x) (cons 2 x)) l))))) ) ) (princ) )