Shortest LWpolyline from a selection

January 8, 2019

After manually selecting a group of LWpolylines, I need a command to find and select the shortest (closed) LWpolyline from my current selection, I need only one polyline to be selected at a time, even if multiple polylines share the same length.

Thanks!

January 8, 2019

Try this

(defun c:shortest ( / *error* ss p_lst min_l s_lst)
	(defun *error* ( msg ) 
		(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
		(princ)
	);_end_*error*_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        ss (ssget '((0 . "LWPOLYLINE") (70 . 1)))
  );end_setq
  (if ss
    (vlax-for obj (vla-get-activeselectionset c_doc)
      (setq p_lst (cons (list (vlax-get-property obj 'length) obj) p_lst))
    );end_for
    (alert "Nothing Selected")
  );end_if
  (cond (p_lst
          (setq s_lst (vl-sort p_lst (function (lambda (x y) (< (car x) (car y)))))
                min_l (caar s_lst)
                p_lst (vl-remove-if-not (function (lambda (x) (= (car x) min_l))) s_lst)
                s_lst nil
          );end_setq
          (mapcar '(lambda (x) (setq s_lst (cons (cadr x) s_lst))) p_lst)
          (foreach a s_lst (vla-highlight a :vlax-true))
          (alert (strcat "There" (if (> (length p_lst) 1) " are " " is ") (itoa (length p_lst)) (if (> (length p_lst) 1) " entities of length : " " entity of length : ") (rtos min_l 2 3)))         
        )
  );end_cond        
);end_defun

min_l - contains the shortest distance

s_lst - contains all the vla-objects that have a length of min_l

The last two lines

(foreach a s_lst (vla-highlight a :vlax-true))
(alert (strcat "There" (if (> (length p_lst) 1) " are " " is ") (itoa (length p_lst)) (if (> (length p_lst) 1) " entities of length : " " entity of length : ") (rtos min_l 2 3)))

are only included for demonstration purposes and can be removed

I've included a selection process as part of the routine. This will only select closed lwpolylines.

Edited January 8, 2019 by dlanorh

January 8, 2019

9 minutes ago, dlanorh said:

Try this


(defun c:shortest ( / *error* ss p_lst min_l s_lst)
	(defun *error* ( msg ) 
		(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
		(princ)
	);_end_*error*_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        ss (ssget '((0 . "LWPOLYLINE") (70 . 1)))
  );end_setq
  (if ss
    (vlax-for obj (vla-get-activeselectionset c_doc)
      (setq p_lst (cons (list (vlax-get-property obj 'length) obj) p_lst))
    );end_for
    (alert "Nothing Selected")
  );end_if
  (cond (p_lst
          (setq s_lst (vl-sort p_lst (function (lambda (x y) (< (car x) (car y)))))
                min_l (caar s_lst)
                p_lst (vl-remove-if-not (function (lambda (x) (= (car x) min_l))) s_lst)
                s_lst nil
          );end_setq
          (mapcar '(lambda (x) (setq s_lst (cons (cadr x) s_lst))) p_lst)
          (foreach a s_lst (vla-highlight a :vlax-true))
          (alert (strcat "There" (if (> (length p_lst) 1) " are " " is ") (itoa (length p_lst)) (if (> (length p_lst) 1) " entities of length : " " entity of length : ") (rtos min_l 2 3)))         
        )
  );end_cond        
);end_defun

min_l - contains the shortest distance

s_lst - contains all the vla-objects that have a length of min_l

The last two lines


(foreach a s_lst (vla-highlight a :vlax-true))
(alert (strcat "There" (if (> (length p_lst) 1) " are " " is ") (itoa (length p_lst)) (if (> (length p_lst) 1) " entities of length : " " entity of length : ") (rtos min_l 2 3)))

are only included for demonstration purposes and can be removed

I've included a selection process as part of the routine. This will only select closed lwpolylines.

How can I make the shortest (highlighted) polyline into an active selection?

Thanks!

January 8, 2019

Try something like this:

(defun c:foo (/ _a a l s)
  ;; RJP » 2019-01-08
  ;; Returns shortest closed polyline
  (defun _a (e) (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
  (cond	((setq s (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1))))
	 (setq l (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
			  '(lambda (r j) (< (_a r) (_a j)))
		 )
	 )
	 (sssetfirst nil (ssadd (car l)))
	)
  )
  (princ)
)

Edited January 8, 2019 by ronjonp
*code changed original logic was flawed

January 8, 2019

Here's another method:

(defun c:shortestpoly ( / a d e i l s )
    (if (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
        (progn
            (setq e (ssname s 0)
                  l (vlax-curve-getdistatparam e (vlax-curve-getendparam e))
                  i 0
            )
            (while (setq i (1+ i) a (ssname s i))
                (if (< (setq d (vlax-curve-getdistatparam a (vlax-curve-getendparam a))) l)
                    (setq l d e a)
                )
            )
            (sssetfirst nil (ssadd e))
        )
    )
    (princ)
)

This will offer efficiency gains for large sets since the selection is only iterated once (therefore fewer comparisons & length calculations than a sort operation), without the need for conversion to a list (which can be slow when ssnamex is used, since this returns more information than is required).

Nothing against Ron's code

January 8, 2019

OP cross posted .. has many options to choose from.

January 8, 2019

25 minutes ago, Lee Mac said:

This will offer efficiency gains for large sets since the selection is only iterated once (therefore fewer comparisons & length calculations than a sort operation), without the need for conversion to a list (which can be slow when ssnamex is used, since this returns more information than is required).

Totally agree .. sometimes I get a bit crazy trying to keep code short as possible at the expense of speed.

January 8, 2019

For a shortest pline, it would be interesting to know which is the fastest solution. Bench them all if you have a little time.

(defun c:minlpoly (/ lSet)
	(if (setq lSet (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
		(apply
			(function min)
			(mapcar
				(function
					(lambda (x)(vla-get-length (vlax-ename->vla-object x)))
				)
				(vl-remove-if
					(function listp)
					(mapcar
						(function cadr)
						(ssnamex lSet)
					)
				)
			)
		)
	)
)

January 8, 2019

3 minutes ago, lido said:

For a shortest pline, it would be interesting to know which is the fastest solution. Bench them all if you have a little time.

Note that your function is not returning the shortest polyline, but rather the shortest length.

January 9, 2019

Sorry. Try this.

(defun c:lighmpoly (/ lEnt lVal)
 (if (setq sSet (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
  (setq sSet
   (car
    (sssetfirst
     nil
     (ssadd
      (nth
       (vl-position
        (apply
;;         (function max) ;;longest
         (function min)
         (mapcar
          (function
           (lambda (x / y)
            (setq y  (vla-get-length (vlax-ename->vla-object x))
              lVal (cons y lVal)
            )
            y
           )
          )
          (setq lEnt
           (vl-remove-if
            (function listp)
            (mapcar
             (function cadr)
             (ssnamex sSet)
            )
           )
          )
         )
        )
        lVal
       )
       (reverse lEnt)
      )
     )
    )
   )
  )
 )
;; (if lVal (/ (apply (function +) lVal) (length lVal))) ;;average
 (princ)
)

January 9, 2019

@Lido:

Your code creates the length list twice...

January 9, 2019

17 hours ago, lido said:

Bench them all if you have a little time

Here you go. Tested on 1000 polylines.

Quote

FOO
FOO2
SHORTESTPOLY
LIGHMPOLY

Benchmarking ..........Elapsed milliseconds / relative speed for 128 iteration(s):

(SHORTESTPOLY S)......2250 / 12.49 <fastest>
(FOO2 S)..............6032 / 4.66
(FOO S)..............19109 / 1.47
(LIGHMPOLY S)........28094 / 1.00 <slowest>

FOO2 is a quick mod of my vl-sort ( brought to light a while back by Michael Puckett @ TheSwamp )

(defun foo2 (s / _a a l)
  (defun _a (e) (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
  (cond	((setq l
		(cdar
		  (vl-sort
		    (mapcar '(lambda (x) (cons (_a x) x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
		    '(lambda (r j) (< (car r) (car j)))
		  )
		)
	 )
	 (sssetfirst nil (ssadd l))
	)
  )
  (princ)
)

January 9, 2019

Interesting, how fast would be this:

(defun c:polytheshortest ( / SS len tmp r )
  (and
    (ssget "_:L-I" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1)))
    (setq SS (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
    (progn 
      (setq tmp (vlax-get (setq r (vla-Item SS 0)) 'Length))
      (vlax-for o SS
        (and
          (> tmp (setq len (vlax-get o 'Length))) 
          (setq tmp len r o)
        ); and
      ); vlax-for
      (vla-Delete SS)
      (sssetfirst nil (ssadd (vlax-vla-object->ename r)))
    ); progn
  ); and
  (princ)
); defun

Edited January 9, 2019 by Grrr
(setq r (vla-Item SS 0))

January 9, 2019

45 minutes ago, Grrr said:

Interesting, how fast would be this:

Quote

(SHORTESTPOLY S).........2015 / 16.69 <fastest>
(FOO2 S).................5719 / 5.88
(FOO S).................21094 / 1.59
~~(POLYTHESHORTEST S).....23890 / 1.41~~
(LIGHMPOLY S)...........33625 / 1.00 <slowest>

*Must have done something wrong before, but when tested your code bombs on '(vlax-vla-object->ename r)'

Edited January 9, 2019 by ronjonp

January 9, 2019

10 minutes ago, ronjonp said:

*Must have done something wrong before, but when tested your code bombs on '(vlax-vla-object->ename r)'

Duh.. modified the code, to initialize r to the first item of the SS.

Edited January 9, 2019 by Grrr

January 9, 2019

56 minutes ago, Grrr said:

Duh.. modified the code, to initialize r to the first item of the SS.

Updated

Quote

<Selection set: 44222> Benchmarking ...........Elapsed milliseconds / relative speed for 256 iteration(s):

(SHORTESTPOLY S).........1843 / 23.12 <fastest>
(FOO2 S).................5047 / 8.44
(FOO S).................18047 / 2.36
(POLYTHESHORTEST S).....25547 / 1.67
(LIGHMPOLY S)...........42609 / 1.00 <slowest>

January 9, 2019

3 minutes ago, ronjonp said:

Updated

Oh wow, activex is freaking slow! .. Thanks for the update!

Sign In

Shortest LWpolyline from a selection

Recommended Posts

enthralled

dlanorh

enthralled

ronjonp

Lee Mac

ronjonp

ronjonp

lido

Lee Mac

lido

Roy_043

ronjonp

Grrr

ronjonp

Grrr

ronjonp

Grrr

Join the conversation

Tutorials

Forums

Activity