Jump to content
enthralled

Shortest LWpolyline from a selection

Recommended Posts

enthralled

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!

Share this post


Link to post
Share on other sites
dlanorh
Posted (edited)

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 by dlanorh
  • Like 1

Share this post


Link to post
Share on other sites
enthralled
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!

Share this post


Link to post
Share on other sites
ronjonp
Posted (edited)

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 by ronjonp
*code changed original logic was flawed
  • Like 2

Share this post


Link to post
Share on other sites
Lee Mac

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 :)

  • Like 1

Share this post


Link to post
Share on other sites
ronjonp

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

  • Like 1

Share this post


Link to post
Share on other sites
ronjonp
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. 😳

Share this post


Link to post
Share on other sites
lido

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)
					)
				)
			)
		)
	)
)

 

  • Like 1

Share this post


Link to post
Share on other sites
Lee Mac
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.

Share this post


Link to post
Share on other sites
lido

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)
)

 

  • Like 1

Share this post


Link to post
Share on other sites
Roy_043

@Lido:

Your code creates the length list twice...

Share this post


Link to post
Share on other sites
ronjonp
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)
)

 

  • Thanks 1

Share this post


Link to post
Share on other sites
Grrr
Posted (edited)

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 by Grrr
(setq r (vla-Item SS 0))

Share this post


Link to post
Share on other sites
ronjonp
Posted (edited)
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 by ronjonp
  • Thanks 1

Share this post


Link to post
Share on other sites
Grrr
Posted (edited)
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 by Grrr

Share this post


Link to post
Share on other sites
ronjonp
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>

 

Share this post


Link to post
Share on other sites
Grrr
3 minutes ago, ronjonp said:

Updated :)

 

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

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×