Jump to content

Shortest LWpolyline from a selection


enthralled

Recommended Posts

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!

Link to comment
Share on other sites

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

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!

Link to comment
Share on other sites

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

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

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. 😳

Link to comment
Share on other sites

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

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.

Link to comment
Share on other sites

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

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

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

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

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

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>

 

Link to comment
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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

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