Jump to content

Shortest LWpolyline from a selection

enthralled

By enthralled
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

enthralled Enthusiast

enthralled

Posted
Posted

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!

dlanorh Mentor

dlanorh

Posted
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
enthralled Enthusiast

enthralled

Posted
  • Author
Posted
  On 1/8/2019 at 12:25 PM, 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.

Expand  

 

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

Thanks!

ronjonp Grand Master

ronjonp

Posted
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
Lee Mac Grand Master

Lee Mac

Posted
Posted

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
ronjonp Grand Master

ronjonp

Posted
Posted
  On 1/8/2019 at 5:37 PM, 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).

Expand  

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

lido Enthusiast

lido

Posted
Posted

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
Lee Mac Grand Master

Lee Mac

Posted
Posted
  On 1/8/2019 at 9:54 PM, 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.🙂

Expand  

 

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

lido Enthusiast

lido

Posted
Posted

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
Roy_043 Mentor

Roy_043

Posted
Posted

@Lido:

Your code creates the length list twice...

ronjonp Grand Master

ronjonp

Posted
Posted
  On 1/8/2019 at 9:54 PM, lido said:

Bench them all if you have a little time

Expand  

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>

Expand  

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
Grrr Veteran

Grrr

Posted
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))
ronjonp Grand Master

ronjonp

Posted
Posted (edited)
  On 1/9/2019 at 7:40 PM, Grrr said:

Interesting, how fast would be this:

 

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

Expand  

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

Edited by ronjonp
  • Thanks 1
Grrr Veteran

Grrr

Posted
Posted (edited)
  On 1/9/2019 at 8:23 PM, ronjonp said:

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

Expand  

 

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

 

Edited by Grrr
ronjonp Grand Master

ronjonp

Posted
Posted
  On 1/9/2019 at 8:33 PM, Grrr said:

 

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

 

Expand  

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>

Expand  

 

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.

×
 Share
Go to topic listing
×
×
  • Create New...