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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...