Topic: ( Challenge ) Shortest & Longest Pline

[Mark]

The challenge is to find the shortest and longest Pline by layer. Erase all others. The attached .dwg contains 1624 3D polylines on 4 layers. Bonus points to the fastest code.

Thanks again to Lee Mac for the code to create the .dwg  WARNING: do not try to create 2000 polylines and then erase them! You will be waiting on your computer for some time. LOL

Good luck!

[Marc'Antonio Alessi]

Surely this type of approach (as previous) has its greatest speed in DWG with large number of objects:

Code - Auto/Visual Lisp: [Select]

1. (defun C:ShortLongestPL ( / SelSet Countr EntSht EntLng LenVal MaxLen MinLen)
2.  (if (setq SelSet (ssget "_X" '((0 . "POLYLINE"))))
3.    (progn
4.      (if (= 1 (logand 1 (getvar "UNDOCTL"))) (command "_.UNDO" "_C" "_N"))
5.      (setvar "HIGHLIGHT" 0)
6.      (setq
7.        Countr 0
8.        EntSht (ssname SelSet 0)
9.        EntLng EntSht
10.        MaxLen (vla-get-length (vlax-ename->vla-object EntSht))
11.        MinLen  MaxLen
12.      )
13.      (repeat (sslength SelSet)
14.        (setq
15.          EntNam (ssname SelSet Countr)
16.          LenVal (vla-get-length (vlax-ename->vla-object EntNam))
17.          Countr (1+ Countr)
18.        )
19.        (cond
20.          ( (> LenVal MaxLen) (setq MaxLen LenVal  EntLng EntNam) )
21.          ( (< LenVal MinLen) (setq MinLen LenVal  EntSht EntNam) )
22.        )
23.      )
24.      (command "_.ERASE" SelSet "_R" (ssadd EntSht (ssadd EntLng)) "")
25. ;      (princ (strcat "\n" (itoa Countr) " erased entity(es). Use Oops to restore. "))
26.    )
27.    (alert "No lines to erase.")
28.  )
29. )
30. ; By Layer version
31. (defun C:ShortLongestPLByLyr ( / TblDat SelSet SelSt2 Countr EntSht EntLng
32.                                  EntDat EntNam LenVal MaxLen MinLen AllSet)
33.   (if (= 1 (logand 1 (getvar "UNDOCTL"))) (command "_.UNDO" "_C" "_N"))
34.   (setvar "HIGHLIGHT" 0)
35.   (setq SelSt2 (ssadd))
36.   (while (setq TblDat (tblnext "LAYER" (null TblDat)))
37.     (if (setq
38.           SelSet (ssget "_X" (list '(0 . "POLYLINE") (cons 8 (cdr (assoc 2 TblDat)))))
39.         )
40.       (progn
41.         (setq
42.           Countr 0
43.           EntSht (ssname SelSet 0)
44.           EntLng EntSht
45.           MaxLen (vla-get-length (vlax-ename->vla-object EntSht))
46.           MinLen  MaxLen
47.         )
48.         (repeat (sslength SelSet)
49.           (setq
50.             EntNam (ssname SelSet Countr)
51.             LenVal (vla-get-length (vlax-ename->vla-object EntNam))
52.             Countr (1+ Countr)
53.           )
54.           (cond
55.             ( (> LenVal MaxLen) (setq MaxLen LenVal  EntLng EntNam) )
56.             ( (< LenVal MinLen) (setq MinLen LenVal  EntSht EntNam) )
57.           )
58.         )
59.         (setq
60.           SelSt2 (ssadd EntSht SelSt2)  SelSt2 (ssadd EntLng SelSt2)
61.           AllSet (cons SelSet AllSet)
62.         )
63.       )
64.     )
65.   )
66.   (command "_.ERASE") (foreach ForElm AllSet (command ForElm))
67.   (command  "_R" SelSt2 "")
68. )

[irneb]

Didn't you have the same question just recently? If using the vlax-curve-* functions it would work the same (or at least very similar) to the method for finding the longest & shortest lines.

[Marc'Antonio Alessi]

Didn't you have the same question just recently? If using the vlax-curve-* functions it would work the same (or at least very similar) to the method for finding the longest & shortest lines.

My apologies for my english, is it a question for me? If so please can you give me an example?

Marco

[Tharwat]

Didn't you have the same question just recently? If using the vlax-curve-* functions it would work the same (or at least very similar) to the method for finding the longest & shortest lines.

My apologies for my english, is it a question for me? If so please can you give me an example?

Marco

I think irneb indicating to the following thread . 

http://www.theswamp.org/index.php?topic=43714.0

[Marc'Antonio Alessi]

I think irneb indicating to the following thread . 

http://www.theswamp.org/index.php?topic=43714.0

Maybe the question it is not for me.

[Mark]

Didn't you have the same question just recently?

The only difference in this challenge is the .dwg contains 3D Plines.

Try doing it without vlax-*.

[irneb]

The only difference in this challenge is the .dwg contains 3D Plines.

Try doing it without vlax-*.

Fine I assumed it's something like that. Thus you'd want this to be a case of adding polyline segment lengths together.

Now I can just imagine the next challenge  : 2d Polylines with curved sgments.

[irneb]

OK, to pre-empt all this  :

Code - Auto/Visual Lisp: [Select]

1. (defun curveLength  (start end bulge)
2.   (cond ((or (not bulge) (zerop bulge)) (distance start end))
3.         (t (* 4.0 (atan (abs bulge)) (/ (* (distance start end) (1+ (* bulge bulge))) 4 (abs bulge))))))
4.  
5. (defun getEntityLayer+Length  (eName / eDXF 70DXF eType points bulges)
6.   (setq eDXF (entget eName '("*")))
7.   (list
8.     (cdr (assoc 8 eDXF))
9.     (cond
10.       ((wcmatch (setq eType (cdr (assoc 0 eDXF))) "LINE") ;Line
11.        (distance (cdr (assoc 10 eDXF)) (cdr (assoc 11 eDXF))))
12.       ((wcmatch eType "POLYLINE") ;Heavy Polyline
13.        (setq 70DXF (cdr (assoc 70 eDXF)))
14.        ;; Get vector info
15.        (while (and (setq eName (entnext eName))
16.                    (setq eDXF (entget eName))
17.                    (wcmatch (cdr (assoc 0 eDXF)) "VERTEX"))
18.          (setq points (cons (cdr (assoc 10 eDXF)) points)
19.                bulges (cons (cdr (assoc 42 eDXF)) bulges)))
20.        (setq points (reverse points)
21.              bulges (reverse bulges))
22.        (cond
23.          ((> (logand 70DXF 0) ;If 3d Polyline
24.           (cond ((> (logand 70DXF 1) 0) ;If closed
25.                  (apply '+ (mapcar 'distance (cons (last points) points) points)))
26.                 ;; Else not closed
27.                 (t (apply '+ (mapcar 'distance points (cdr points))))))
28.          ;; Else 2d Polyline - possibly bulges
29.          (t
30.           (cond ((> (logand 70DXF 1) 0) ;If closed
31.                  (apply '+ (mapcar 'curveLength (cons (last points) points) points (cons (last bulges) bulges))))
32.                 ;; Else not closed
33.                 (t (apply '+ (mapcar 'curveLength points (cdr points) bulges)))))))
34.       ((wcmatch eType "LWPOLYLINE")
35.        (setq 70DXF (cdr (assoc 70 eDXF)))
36.        (foreach item  (member (assoc 90 eDXF) eDXF)
37.          (cond ((= (car item) 10) (setq points (cons (cdr item) points)))
38.                ((= (car item) 42) (setq bulges (cons (cdr item) bulges)))))
39.        (setq points (reverse points)
40.              bulges (reverse bulges))
41.        (cond ((> (logand 70DXF 1) 0) ;If closed
42.               (apply '+ (mapcar 'curveLength (cons (last points) points) points (cons (last bulges) bulges))))
43.              ;; Else not closed
44.              (t (apply '+ (mapcar 'curveLength points (cdr points) bulges))))))))
45.  
46. (defun c:RemAllButLongest&Shortest  (/ ss long short n en)
47.   (setq long  '(nil nil -1.0)
48.         short '(nil nil 1.7976931348623158e308))
49.   (if (setq ss (ssget "_X" '((0 . "LINE,POLYLINE,LWPOLYLINE"))))
50.     (progn (repeat (setq n (sslength ss))
51.              (setq en (ssname ss (setq n (1- n)))
52.                    en (cons en (getEntityLayer+Length en)))
53.              (if (> (caddr en) (caddr long))
54.                (setq long en))
55.              (if (< (caddr en) (caddr short))
56.                (setq short en))
57.              (entdel (car en)))
58.            (entdel (car long))
59.            (entdel (car short))
60.            (princ (strcat "\nLongest :\tLayer="
61.                           (cadr long)
62.                           ";\tLength ="
63.                           (rtos (caddr long))
64.                           "\nShortest:\tLayer="
65.                           (cadr short)
66.                           ";\tLength ="
67.                           (rtos (caddr short))
68.                           "\n"))))
69.   (princ))
70.  

And the test:

Code: [Select]

_$ (DoTest '((c:RemAllButLongest&Shortest)))

(C:REMALLBUTLONGEST&SHORTEST)
Longest :    Layer=RED;    Length =71652.0653
Shortest:    Layer=RED;    Length =243.2759
Program running time: 1030 msecs.

[irneb]

or using the vlax-curve-* idea (despite your comment to "not" use it):

Code - Auto/Visual Lisp: [Select]

1. (defun c:RemAllButLongest&Shortest1  (/ ss long short n en lay len)
2.   (setq long  '(nil nil -1.0)
3.         short '(nil nil 1.7976931348623158e308))
4.   (if (setq ss (ssget "_X" '((0 . "LINE,POLYLINE,LWPOLYLINE"))))
5.     (progn (repeat (setq n (sslength ss))
6.              (setq en (ssname ss (setq n (1- n)))
7.                    lay (cdr (assoc 8 (entget en)))
8.                    len (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)))
9.              (if (> len (caddr long))
10.                (setq long (list en lay len)))
11.              (if (< len (caddr short))
12.                (setq short (list en lay len)))
13.              (entdel en))
14.            (entdel (car long))
15.            (entdel (car short))
16.            (princ (strcat "\nLongest :\tLayer="
17.                           (cadr long)
18.                           ";\tLength ="
19.                           (rtos (caddr long))
20.                           "\nShortest:\tLayer="
21.                           (cadr short)
22.                           ";\tLength ="
23.                           (rtos (caddr short))
24.                           "\n"))))
25.   (princ))

And the test:

Code: [Select]

_$ (DoTest '((c:RemAllButLongest&Shortest) (c:RemAllButLongest&Shortest1)))

(C:REMALLBUTLONGEST&SHORTEST)
Longest :    Layer=RED;    Length =71652.0653
Shortest:    Layer=RED;    Length =243.2759
Program running time: 1045 msecs.
(C:REMALLBUTLONGEST&SHORTEST1)
Longest :    Layer=RED;    Length =71652.0653
Shortest:    Layer=RED;    Length =243.2759
Program running time: 93 msecs.BTW, I've used Lee's time-it function in a combined version, so I am assured of "equal" allowance for each version:

Code - Auto/Visual Lisp: [Select]

1. (defun time-it  (expr / et st)
2.   ;; by: Lee Mac
3.   (setq st (getvar 'millisecs))
4.   (eval expr)
5.   (setq et (getvar 'millisecs))
6.   (princ (strcat "Program running time: " (itoa (- et st)) " msecs."))
7.   (princ))
8.  
9. (defun DoTest  (exprlist /)
10.   (foreach expr exprlist (command "_.undo" "_Back" "_Yes") (print expr) (time-it expr))
11.   (princ))

Not much in the order of which version to perform first:

Code: [Select]

_$ (DoTest '((c:RemAllButLongest&Shortest1) (c:RemAllButLongest&Shortest)))

(C:REMALLBUTLONGEST&SHORTEST1)
Longest :    Layer=RED;    Length =71652.0653
Shortest:    Layer=RED;    Length =243.2759
Program running time: 78 msecs.
(C:REMALLBUTLONGEST&SHORTEST)
Longest :    Layer=RED;    Length =71652.0653
Shortest:    Layer=RED;    Length =243.2759
Program running time: 1077 msecs.

[irneb]

Just to compare apples with apples:

Code - Auto/Visual Lisp: [Select]

1. (defun c:RemAllButLongest&ShortestByLayer  (/ ss long short n en lay len)
2.   (while (setq lay (tblnext "LAYER" (not lay)))
3.     (setq long  '(nil nil -1.0)
4.           short '(nil nil 1.7976931348623158e308))
5.     (if (setq ss (ssget "_X" (list '(0 . "LINE,POLYLINE,LWPOLYLINE") (cons 8 (cdr (assoc 2 lay))))))
6.       (progn (repeat (setq n (sslength ss))
7.                (setq en  (ssname ss (setq n (1- n)))
8.                      len (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)))
9.                (if (> len (caddr long))
10.                  (setq long (list en lay len)))
11.                (if (< len (caddr short))
12.                  (setq short (list en lay len)))
13.                (entdel en))
14.              (entdel (car long))
15.              (entdel (car short)))))
16.   (princ))

And the test for all 5:

Code: [Select]

_$ (DoTest '((c:RemAllButLongest&Shortest1) (c:RemAllButLongest&Shortest) (C:ShortLongestPL) (C:ShortLongestPLByLyr) (c:RemAllButLongest&ShortestByLayer)))

(C:REMALLBUTLONGEST&SHORTEST1)
Longest :    Layer=RED;    Length =71652.0653
Shortest:    Layer=RED;    Length =243.2759
Program running time: 63 msecs.
(C:REMALLBUTLONGEST&SHORTEST)
Longest :    Layer=RED;    Length =71652.0653
Shortest:    Layer=RED;    Length =243.2759
Program running time: 967 msecs.
(C:SHORTLONGESTPL) Program running time: 125 msecs.
(C:SHORTLONGESTPLBYLYR) Program running time: 141 msecs.
(C:REMALLBUTLONGEST&SHORTESTBYLAYER) Program running time: 47 msecs.

[irneb]

Oh! Noticed a slight hiccup: If there's only one entity on the layer, then it will get erased. So here's the fix (with a minor optimization):

Code - Auto/Visual Lisp: [Select]

1. (defun c:RemAllButLongest&ShortestByLayer  (/ ss long short n en lay len)
2.   (while (setq lay (tblnext "LAYER" (not lay)))
3.     (setq long  '(nil -1.0)
4.           short '(nil 1.7976931348623158e308))
5.     (if (and (setq ss (ssget "_X" (list '(0 . "LINE,POLYLINE,LWPOLYLINE") (cons 8 (cdr (assoc 2 lay))))))
6.              (> (setq n (sslength ss)) 1))
7.       (progn (repeat n
8.                (setq en  (ssname ss (setq n (1- n)))
9.                      len (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en)))
10.                (if (> len (cadr long))
11.                  (setq long (list en len)))
12.                (if (< len (cadr short))
13.                  (setq short (list en len)))
14.                (entdel en))
15.              (entdel (car long))
16.              (entdel (car short)))))
17.   (princ))

Test:

Code: [Select]

(C:REMALLBUTLONGEST&SHORTEST1)
Longest :    Layer=RED;    Length =71652.0653
Shortest:    Layer=RED;    Length =243.2759
Program running time: 78 msecs.
(C:REMALLBUTLONGEST&SHORTEST)
Longest :    Layer=RED;    Length =71652.0653
Shortest:    Layer=RED;    Length =243.2759
Program running time: 983 msecs.
(C:SHORTLONGESTPL) Program running time: 125 msecs.
(C:SHORTLONGESTPLBYLYR) Program running time: 141 msecs.
(C:REMALLBUTLONGEST&SHORTESTBYLAYER) Program running time: 47 msecs.

[Marc'Antonio Alessi]

(C:REMALLBUTLONGEST&SHORTESTBYLAYER) Program running time: 47 msecs.

I think I know why this version is faster, is there anyone who knows?

[Marc'Antonio Alessi]

I think I know why this version is faster, is there anyone who knows?

This is the answer:

Code - Auto/Visual Lisp: [Select]

1. ;AutoCAD 2010
2. ;(time-it '(c:RemAllButLongest&Shortest1)) ;Program running time: 421 msecs.
3. ;(time-it '(c:ALE_ShortLongestPL))       ;Program running time: 265 msecs
4.  
5. (defun C:ALE_ShortLongestPL ( / SelSet Countr EntSht LenVal MinLen InfLst)
6.  (if (setq SelSet (ssget "_X" '((0 . "POLYLINE"))))
7.    (progn
8.      (setq
9.        Countr 0
10.        EntSht (ssname SelSet 0)
11.        MinLen (vla-get-length (vlax-ename->vla-object EntSht))
12.        InfLst (list EntSht MinLen EntSht MinLen)
13.      )
14.      (repeat (sslength SelSet)
15.        (setq
16.          EntNam (ssname SelSet Countr)
17.          LenVal (vla-get-length (vlax-ename->vla-object EntNam))
18.          Countr (1+ Countr)
19.        )
20.        (cond
21.          ( (> LenVal (cadddr InfLst))
22.            (setq InfLst (list (car InfLst) (cadr InfLst) EntNam LenVal))
23.          )
24.          ( (< LenVal (cadr   InfLst))
25.            (setq InfLst (list EntNam LenVal (caddr InfLst) (cadddr InfLst)))
26.          )
27.        )
28.      )
29.      (command "_.ERASE" SelSet "_R" (ssadd (car InfLst) (ssadd (caddr InfLst))) "")
30.    )
31.  )
32. )

[ronjonp]

This one fares pretty well:

Program running time: 188 msecs.

Code - Auto/Visual Lisp: [Select]

1. (defun c:testfoo (/ e el l l2 lyr n o ss)
2.   (if (setq ss (ssget "_x" '((0 . "POLYLINE"))))
3.     (progn (setq n -1)
4.            (while (setq e (ssname ss (setq n (1+ n))))
5.              (setq o (vlax-ename->vla-object e))
6.              (setq l (cons (list (vla-get-layer o) (vla-get-length o) e) l))
7.              (entdel e)
8.            )
9.            (setq l (vl-sort l (function (lambda (a b) (< (car a) (car b))))))
10.            (while (setq lyr (caar l))
11.              (while (eq (caar l) lyr) (setq l2 (cons (car l) l2)) (setq l (cdr l)))
12.              (setq l2 (vl-sort l2 (function (lambda (a b) (< (cadr a) (cadr b))))))
13.              (entdel (last (car l2)))
14.              (entdel (last (last l2)))
15.              (setq l2 nil)
16.            )
17.     )
18.   )
19. )

Nice Irneb 

C:REMALLBUTLONGEST&SHORTESTBYLAYER
Program running time: 78 msecs.

[irneb]

I think I know why this version is faster, is there anyone who knows?

This is the answer:

Empirically it doesn't appear to be the answer. Your previous code was faster:

Code: [Select]

(C:ALE_SHORTLONGESTPL) Program running time: 297 msecs.
(C:TESTFOO) Program running time: 218 msecs.
(C:SHORTLONGESTPLBYLYR) Program running time: 140 msecs.
(C:SHORTLONGESTPL) Program running time: 140 msecs.
(C:REMALLBUTLONGEST&SHORTESTBYLAYER) Program running time: 63 msecs.
(C:REMALLBUTLONGEST&SHORTEST1)
Longest :    Layer=RED;    Length =71652.0653
Shortest:    Layer=RED;    Length =243.2759
Program running time: 78 msecs.
(C:REMALLBUTLONGEST&SHORTEST)
Longest :    Layer=RED;    Length =71652.0653
Shortest:    Layer=RED;    Length =243.2759
Program running time: 1107 msecs.I think mine using the vlax-curve functions should perform faster due to it never needing to entget or convert the ename to a vla-object. The entget route is obviously extremely slow since it gets all the data from each entity (including each vector). The vla method should be a lot quicker since it obtains the full length by only one method. But the vlax-curve method goes quicker since it's not converting the eename at all (and from previous tests it's faster working directly on enames than on vla-objects).

Another possibility might be that you're using the command function to erase and the remove the longest/shortest. This is recreating a selection set and then modifying it, not to mention passing stuff to the command-line. You might also want to turn off CmdEcho to get an extra miniscule bit faster so it doesn't display as much on the cmd-line. It seems (even from the lines thread) that using entdel's 2nd call to "unerase" the longest/shortest is actually a bit faster (also no need to fiddle with Undo control and sysvars).

But the reason Mac'Antonio's and mine is a bit faster than ronjonp's (methinks) is because his is doing 2 loops through the entire list of objects. Ours are only looping through the layer names and then only the objects on each of those layers individually - a lot less iterations.

Edit: BTW, anyone know if something similar to undelete can be done through vla? I'm thinking it might be possible to convert the selection set to a vla-selectionset, then iterate that so it need not convert enames to vla-objects. But then how to undelete the longest/shortest.

[irneb]

Here's what I meant by stepping through a vla selection set:

Code - Auto/Visual Lisp: [Select]

1. (defun c:RemAllButLongest&ShortestByLayer1 (/ doc ss len long short)
2.   (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
3.   (vlax-for lay (vla-get-Layers doc)
4.     (if (and (setq ss (ssget "_X" (list '(0 . "LINE,POLYLINE,LWPOLYLINE") (cons 8 (vla-get-Name lay)))))
5.              (> (sslength ss) 1))
6.       (progn (setq ss (vla-get-ActiveSelectionSet doc)
7.                    long '(nil . 0.0)
8.                    short '(nil . 1.7976931348623158e308))
9.         (vlax-for obj ss
10.           (if (> (setq len (vla-get-Length obj)) (cdr long))
11.             (setq long (cons obj len)))
12.           (if (< len (cdr short))
13.             (setq short (cons obj len))))
14.         (vlax-invoke ss 'RemoveItems (mapcar 'car (list long short)))
15.         (vla-Erase ss)
16.         (vla-Delete ss))))
17.   (princ))

Though it's still a touch slower than Marc'Antonio's due to it doing a  RevomeItems on the selection set through ActiveX:

Code: [Select]

(C:ALE_SHORTLONGESTPL) Program running time: 187 msecs.
(C:TESTFOO) Program running time: 203 msecs.
(C:SHORTLONGESTPLBYLYR) Program running time: 141 msecs.
(C:SHORTLONGESTPL) Program running time: 140 msecs.
(C:REMALLBUTLONGEST&SHORTESTBYLAYER) Program running time: 63 msecs.
(C:REMALLBUTLONGEST&SHORTESTBYLAYER1) Program running time: 156 msecs.
(C:REMALLBUTLONGEST&SHORTEST1)
Longest :    Layer=RED;    Length =71652.0653
Shortest:    Layer=RED;    Length =243.2759
Program running time: 78 msecs.
(C:REMALLBUTLONGEST&SHORTEST)
Longest :    Layer=RED;    Length =71652.0653
Shortest:    Layer=RED;    Length =243.2759
Program running time: 1139 msecs.

[Patrick_35]

Hi

My version

Code: [Select]

(defun c:test(/ doc ent lst sel tab tmp)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (and (ssget "x" (list (cons 0 "*POLYLINE")))
    (progn
      (vlax-for ent (setq sel (vla-get-activeselectionset doc))
(setq lst (cons (list (vla-get-layer ent) (vla-get-length ent) ent) lst))
      )
      (vla-delete sel)
      (while lst
(setq tmp (vl-sort (vl-remove-if-not '(lambda(x) (eq (caar lst) (car x))) lst) '(lambda(a b)(< (cadr a) (cadr b))))
      tab (cons (append (car tmp) (last tmp)) tab)
      tmp (cdr (vl-remove (last tmp) tmp))
      lst (vl-remove-if '(lambda(x) (eq (caar lst) (car x))) lst)
)
(mapcar '(lambda(x)(vla-delete (caddr x))) tmp)
      )
    )
  )
  (princ tab)
  (vla-endundomark doc)
  (princ)
)
@+

[Marc'Antonio Alessi]

Empirically it doesn't appear to be the answer. Your previous code was faster:
<clip>

inerb,

thanks for your long and interesting answer, IMHO i think there is also another
reason that justifies the difference later when I have time I will say my thoughts.
I am sorry to say that the tests do not correspond with mine, attached the command
line tests done with my AutoCAD 2010 Mech (Vanilla profile).
Each test was done by launching AutoCAD and opening the DWG then exiting from
AutoCAD completely, see txt attachment.

(time-it '(c:ALE_ShortLongestPL)); Program running time: 561 msecs.
(time-it '(c:RemAllButLongest&ShortestByLayer)) ; Program running time: 546 msecs.

[irneb]

OK, don't know what's the issue on yours. I've done the test by closing ACad down fully, then opening that DWG again, loading & running one of the codes from VLIDE, then closing acad. Then re-open acad and the DWG and rerun the test on the next. These are the results I get:

Code: [Select]

_$ (time-it '(C:ALE_ShortLongestPL))
Program running time: 188 msecs.

_$ (time-it '(c:RemAllButLongest&ShortestByLayer))
Program running time: 94 msecs.I'm running in ACA 2013 in vanilla mode.

Workstation:
i7-2600 @ 3.4GH
16GB Ram
64bit Win7 Pro
AMD Radeon HD 7800
Seagate Baracuda 500GB 7200RPM SATA3 (6GB/s)
Seagate FreeAgent GoFlex 1TB USB3

So I thought, perhaps due to me running it from VLIDE, but still similar scenario applies from command-line without opening VLIDE:

Code: [Select]

Command: (load "G:\\Documents\\AutoLisp Tests\\Longest Shortest Line\\LongShort.LSP")
C:REMALLBUTLONGEST&SHORTESTBYLAYER1
Command: (time-it '(C:ALE_ShortLongestPL))
...
Program running time: 140 msecs.

Code: [Select]

Command: (load "G:\\Documents\\AutoLisp Tests\\Longest Shortest Line\\LongShort.LSP")
C:REMALLBUTLONGEST&SHORTESTBYLAYER1
Command: (time-it '(c:RemAllButLongest&ShortestByLayer))
Program running time: 78 msecs.

[Lee Mac]

Could the following modifications perhaps shave off a few millisecs?

Code: [Select]

(defun c:RemAllButLongest&ShortestByLayerLeeMacMod ( / en in le ll ln se sl ss )
    (foreach la '((8 . "BLUE") (8 . "CYAN") (8 . "GREEN") (8 . "RED"))
        (setq ll -1.0  le nil
              sl 1e308 se nil
        )
        (if (setq ss (ssget "_X" (list '(0 . "LINE,POLYLINE,LWPOLYLINE") la)))
            (progn
                (repeat (setq in (sslength ss))
                    (setq en (ssname ss (setq in (1- in)))
                          ln (vlax-curve-getdistatparam en (vlax-curve-getendparam en))
                    )
                    (if (< ll ln)
                        (setq ll ln le en)
                    )
                    (if (< ln sl)
                        (setq sl ln se en)
                    )
                    (entdel en)
                )
                (entdel le)
                (entdel se)
            )
        )
    )
    (princ)
)

[Marc'Antonio Alessi]

OK, don't know what's the issue on yours. I've done the test by closing ACad down fully, then opening that DWG again, loading & running one of the codes from VLIDE, then closing acad. Then re-open acad and the DWG and rerun the test on the next. These are the results I get:

Code: [Select]

_$ (time-it '(C:ALE_ShortLongestPL))
Program running time: 188 msecs.

_$ (time-it '(c:RemAllButLongest&ShortestByLayer))
Program running time: 94 msecs.I'm running in ACA 2013 in vanilla mode.

Also test in Vlide, now I think test are very unreliable:

;start A2013 & open only RandomPlines.dwg
;
$ (LOAD "E:/__Temp/LongShort.lsp")
TIME-IT
_$ (vl-load-com)
_$ (time-it '(C:ALE_ShortLongestPL))

Program running time: 904 msecs.

(time-it '(C:ALE_ShortLongestPL))

;start A2013 & open only RandomPlines.dwg
_$ (LOAD "E:/__Temp/LongShort.lsp")
TIME-IT
_$
_$ (vl-load-com)
_$ (time-it '(c:RemAllButLongest&ShortestByLayer))

Program running time: 421 msecs.
_$

;-------------------------------------------------------------

;start A2010 & open only RandomPlines.dwg
$ (LOAD "E:/__Temp/LongShort.lsp")
TIME-IT
_$ (vl-load-com)
_$ (time-it '(C:ALE_ShortLongestPL))

Program running time: 421 msecs.

;start A2010 & open only RandomPlines.dwg
_$ (LOAD "E:/__Temp/LongShort.lsp")
TIME-IT
_$
_$ (vl-load-com)
_$
_$ (time-it '(c:RemAllButLongest&ShortestByLayer))

Program running time: 390 msecs.
_$


;start A2010 & open only RandomPlines.dwg > second Test
_$ (LOAD "E:/__Temp/LongShort.lsp")
TIME-IT
_$ (vl-load-com)
_$ (time-it '(c:RemAllButLongest&ShortestByLayer))

Program running time: 562 msecs.               <<<<<<<<<<<<<<
_$

[ronjonp]

Could the following modifications perhaps shave off a few millisecs?

Code: [Select]

(defun c:RemAllButLongest&ShortestByLayerLeeMacMod ( / en in le ll ln se sl ss )
    (foreach la '((8 . "BLUE") (8 . "CYAN") (8 . "GREEN") (8 . "RED"))
        (setq ll -1.0  le nil
              sl 1e308 se nil
        )
        (if (setq ss (ssget "_X" (list '(0 . "LINE,POLYLINE,LWPOLYLINE") la)))
            (progn
                (repeat (setq in (sslength ss))
                    (setq en (ssname ss (setq in (1- in)))
                          ln (vlax-curve-getdistatparam en (vlax-curve-getendparam en))
                    )
                    (if (< ll ln)
                        (setq ll ln le en)
                    )
                    (if (< ln sl)
                        (setq sl ln se en)
                    )
                    (entdel en)
                )
                (entdel le)
                (entdel se)
            )
        )
    )
    (princ)
)

(C:REMALLBUTLONGEST&SHORTESTBYLAYERLEEMACMOD) - 63 msecs.   

[Marc'Antonio Alessi]

New version:

Code - Auto/Visual Lisp: [Select]

1. (defun C:ALE_ShortLongestPLByLyr01 ( / VlaSst VlaObj LenVal LyrNam InfLtC
2.                                             InfLtB InfLtG InfLtR InfTot EntLst)
3.     (defun ALE_CompareLenght (ObjFor LenVal InfLst / TmpLst)
4.       (setq TmpLst (eval InfLst))
5.       (cond
6.         ( (> LenVal (cadddr TmpLst))
7.           (set InfLst (list (car TmpLst) (cadr TmpLst) ObjFor LenVal))
8.         )
9.         ( (< LenVal (cadr   TmpLst))
10.           (set InfLst (list ObjFor LenVal (caddr TmpLst) (cadddr TmpLst)))
11.         )
12.       )
13.     )
14.     (if (setq VlaSst (ssget "_X" (list '(0 . "POLYLINE"))))
15.       (progn
16.         (setq
17.           VlaObj (vlax-ename->vla-object (ssname VlaSst 0))
18.           LenVal (vla-get-length VlaObj)
19.           InfLtB (list VlaObj LenVal VlaObj LenVal)
20.           InfLtC InfLtB InfLtG InfLtB InfLtR InfLtB
21.           VlaSst (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
22.         )
23.         (vlax-for ObjFor VlaSst
24.           (setq
25.             LenVal (vla-get-length ObjFor)
26.             LyrNam (vla-get-Layer ObjFor)
27.           )
28.           (cond
29.             ( (eq LyrNam "BLUE")  (ALE_CompareLenght ObjFor LenVal 'InfLtB) )
30.             ( (eq LyrNam "CYAN")  (ALE_CompareLenght ObjFor LenVal 'InfLtC) )
31.             ( (eq LyrNam "GREEN") (ALE_CompareLenght ObjFor LenVal 'InfLtG) )
32.             ( (eq LyrNam "RED")   (ALE_CompareLenght ObjFor LenVal 'InfLtR) )
33.           )
34.         )
35.       )
36.     )
37.     (setq InfTot (append InfLtC InfLtB InfLtG InfLtR))
38.     (while InfTot
39.       (setq
40.         EntLst (cons (vlax-vla-object->ename (car InfTot)) EntLst)
41.         InfTot (cddr InfTot)
42.       )
43.     )
44.     (command
45.       "_.ERASE" "_ALL" "_R"
46.       (ssadd (nth 7 EntLst) (ssadd (nth 6 EntLst) (ssadd (nth 5 EntLst)
47.       (ssadd (nth 4 EntLst) (ssadd (cadddr EntLst) (ssadd (caddr EntLst)
48.       (ssadd (cadr EntLst)  (ssadd (car EntLst))))))))) ""
49.     )
50. )

[Lee Mac]

Could the following modifications perhaps shave off a few millisecs?

Code: [Select]

(defun c:RemAllButLongest&ShortestByLayerLeeMacMod < ... >

(C:REMALLBUTLONGEST&SHORTESTBYLAYERLEEMACMOD) - 63 msecs.   

Your computer is way faster than mine 

[ronjonp]

Could the following modifications perhaps shave off a few millisecs?

Code: [Select]

(defun c:RemAllButLongest&ShortestByLayerLeeMacMod < ... >

(C:REMALLBUTLONGEST&SHORTESTBYLAYERLEEMACMOD) - 63 msecs.   

Your computer is way faster than mine 

What was your time?

[Lee Mac]

Could the following modifications perhaps shave off a few millisecs?

Code: [Select]

(defun c:RemAllButLongest&ShortestByLayerLeeMacMod < ... >

(C:REMALLBUTLONGEST&SHORTESTBYLAYERLEEMACMOD) - 63 msecs.   

Your computer is way faster than mine 

What was your time?

About 110ms

[LE3]

the best performance, i was able to get using a c# routine is 88msecs on a bylayer sorting:

Command: netload
Command: sp2
Add polylines to selection: Specify opposite corner: 1624 found
Add polylines to selection:
Elapsed=88msecs.

[Lee Mac]

Here are my results for all 'layer-by-layer' programs posted:

Code: [Select]

(C:REMALLBUTLONGEST&SHORTESTBYLAYER)          Program running time: 109 msecs.
(C:REMALLBUTLONGEST&SHORTESTBYLAYERLEEMACMOD) Program running time: 109 msecs.
(C:REMALLBUTLONGEST&SHORTESTBYLAYER1)         Program running time: 359 msecs.
(C:SHORTLONGESTPLBYLYR)                       Program running time: 405 msecs.
(C:TESTFOO)                                   Program running time: 499 msecs.
(C:PATRICK_35TEST)                            Program running time: 546 msecs.
(C:ALE_SHORTLONGESTPLBYLYR01)                 Program running time: 561 msecs.
I also added a (gc) after every function call for cleanup.

[Lee Mac]

the best performance, i was able to get using a c# routine is 88msecs on a bylayer sorting

But how fast do the AutoLISP solutions run on your system by comparison?

[LE3]

the best performance, i was able to get using a c# routine is 88msecs on a bylayer sorting

But how fast do the AutoLISP solutions run on your system by comparison?

Will run those tests later and post here and added also the time-it port into c#, to do the compare with the same - but looks like the sw.ElapsedMilliseconds from the var sw = new Stopwatch(); it is basically returning the same timing.

[Marc'Antonio Alessi]

Here are my results for all 'layer-by-layer' programs posted: ...

What AutoCAD version?

[Lee Mac]

Here are my results for all 'layer-by-layer' programs posted: ...

What AutoCAD version?

AutoCAD 2013 / Windows 7 Ultimate 32-bit
Intel Core2 Duo 2.1GHz, 3GB RAM

[LE3]

got the chance to run this one on one of my old pc's and inside of acad2011:

Command: (time-it '(c:RemAllButLongest&ShortestByLayer))
Program running time: 125 msecs.

Command: (time-it '(C:ALE_ShortLongestPLByLyr01))
_.ERASE
Select objects: _ALL 1624 found
Select objects: _R
Remove objects:   8 found, 8 removed, 1616 total
Remove objects:
Command:
Program running time: 375 msecs.

and this one:

Command: (time-it '(c:testfoo))
Program running time: 157 msecs.

ps> guess it is taking me more time to remove all those stupid numbers on the code rows.... can't do any more testing, it is a lot of waste of time to remove all those numbers on the rows (maybe there is a shortcut to remove them easily... but still no idea why they are needed?)

if possible, please remove those or post code using just the  code /code with the brackets... that's much better - my 2cts.

[Lee Mac]

ps> guess it is taking me more time to remove all those stupid numbers on the code rows.... can't do any more testing, it is a lot of waste of time to remove all those numbers on the rows (maybe there is a shortcut to remove them easily... but still no idea why they are needed?)

if possible, please remove those or post code using just the  code /code with the brackets... that's much better - my 2cts.

Luis, I believe the line numbers are only copied with IE, they aren't copied for me using FF18.0.2...

[Marc'Antonio Alessi]

Here are my results for all 'layer-by-layer' programs posted: ...

What AutoCAD version?

AutoCAD 2013 / Windows 7 Ultimate 32-bit
Intel Core2 Duo 2.1GHz, 3GB RAM

I do not have 2013 on Win 32-bit, can you test this:

Code: [Select]

(defun C:ALE_ShortLongestPLByLyr02 ( / SelSet EntDat Countr EntNam LenVal LyrNam InfLtC InfLtB InfLtG InfLtR)
    (if (setq SelSet (ssget "_X" (list '(0 . "POLYLINE"))))
      (progn
       (acad-push-dbmod) (setvar "HIGHLIGHT" 0)
       (setq
          Countr 0
          EntNam (ssname SelSet 0)
          EntDat (entget EntNam)
          LenVal (vlax-curve-getDistAtParam EntNam (vlax-curve-getEndParam EntNam))
          InfLtB (list EntNam LenVal EntNam LenVal)
          InfLtC InfLtB InfLtG InfLtB InfLtR InfLtB
        )
        (repeat (sslength SelSet)
          (setq
            EntNam (ssname SelSet Countr) EntDat (entget EntNam)
            LenVal (vlax-curve-getDistAtParam EntNam (vlax-curve-getEndParam EntNam))
            LyrNam (cdr (assoc 8 EntDat))
            Countr (1+ Countr)
          )
          (cond
            ( (eq LyrNam "BLUE")
              (cond
                ( (> LenVal (cadddr InfLtB))
                  (setq InfLtB (list (car InfLtB) (cadr InfLtB) EntNam LenVal))
                )
                ( (< LenVal (cadr   InfLtB))
                  (setq InfLtB (list EntNam LenVal (caddr InfLtB) (cadddr InfLtB)))
                )
              )
            )
            ( (eq LyrNam "CYAN")
              (cond
                ( (> LenVal (cadddr InfLtC))
                  (setq InfLtC (list (car InfLtC) (cadr InfLtC) EntNam LenVal))
                )
                ( (< LenVal (cadr   InfLtC))
                  (setq InfLtC (list EntNam LenVal (caddr InfLtC) (cadddr InfLtC)))
                )
              )
            )
            ( (eq LyrNam "GREEN")
              (cond
                ( (> LenVal (cadddr InfLtG))
                  (setq InfLtG (list (car InfLtG) (cadr InfLtG) EntNam LenVal))
                )
                ( (< LenVal (cadr   InfLtG))
                  (setq InfLtG (list EntNam LenVal (caddr InfLtG) (cadddr InfLtG)))
                )
              )
            )
            ( (eq LyrNam "RED")
              (cond
                ( (> LenVal (cadddr InfLtR))
                  (setq InfLtR (list (car InfLtR) (cadr InfLtR) EntNam LenVal))
                )
                ( (< LenVal (cadr   InfLtR))
                  (setq InfLtR (list EntNam LenVal (caddr InfLtR) (cadddr InfLtR)))
                )
              )
            )
          )
        )
      )
    )
   (command "_.ERASE" SelSet "")
   (foreach ForElm (list InfLtC InfLtB InfLtG InfLtR)
     (entdel (car ForElm)) (entdel (caddr ForElm))
   )
)

[Marc'Antonio Alessi]

ps> guess it is taking me more time to remove all those stupid numbers on the code rows.... can't do any more testing, it is a lot of waste of time to remove all those numbers on the rows (maybe there is a shortcut to remove them easily... but still no idea why they are needed?)

if possible, please remove those or post code using just the  code /code with the brackets... that's much better - my 2cts.

Luis, I believe the line numbers are only copied with IE, they aren't copied for me using FF18.0.2...

Me too.

[Marc'Antonio Alessi]

... test this: ...

Maybe with command-s is a little bit faster:
(command-s "_.ERASE" SelSet "")

[irneb]

if possible, please remove those or post code using just the  code /code with the brackets... that's much better - my 2cts.

The numbers don't copy with any other browser but IE (not FF/Chrome/Opera).

A trick you can do if you're stuck using IE (IMO the worst browser there is - this being one of the reasons): click the quote button, then select & copy the code from the edit box. That should remove the numbers.

[CAB]

Could the following modifications perhaps shave off a few millisecs?

Code: [Select]

(defun c:RemAllButLongest&ShortestByLayerLeeMacMod < ... >

(C:REMALLBUTLONGEST&SHORTESTBYLAYERLEEMACMOD) - 63 msecs.   

Your computer is way faster than mine 

What was your time?

My times vary.

Code: [Select]

Command: (time-it '(c:RemAllButLongest&ShortestByLayerLeeMacMod))

Program running time: 46 msecs.

Command: _.undo Current settings: Auto = On, Control = All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: 1
Everything has been undone

Command: (time-it '(c:RemAllButLongest&ShortestByLayerLeeMacMod))

Program running time: 31 msecs.

[pBe]

......

A trick you can do if you're stuck using IE (IMO the worst browser there is - this being one of the reasons): click the quote button, then select & copy the code from the edit box. That should remove the numbers.

Exactly, I even went as far as writing a code to remove those leading "numbers" but then i trashed it and settled with Chrome. 


EDIT: found the code

Code - Auto/Visual Lisp: [Select]

1.  
2. (Defun c:remlead (/ opf full code a str i where recode)
3.   (if (setq opf (getfiled "Select Text file:" "" "txt" 16))
4.     (progn
5.       (Setq FULL nil
6.             code (open opf "r")
7.       )
8.       (while (setq a (read-line code))
9.         (if (not (eq "" a))
10.           (setq FULL (cons a FULL))
11.         )
12.       )
13.       (close code)
14.       (Setq str   (Car full)
15.             i     1
16.             where 0
17.       )
18.       (while (setq where (vl-string-search
19.                            (setq this (strcat (itoa i) "."))
20.                            str
21.                            where
22.                          )
23.              )
24.         (if
25.           (not
26.             (wcmatch (substr str (1+ where) (1+ (strlen this))) "*.#*")
27.           )
28.            (setq str (vl-string-subst "" this str where)
29.                  i   (1+ i)
30.            )
31.            (setq where (1+ where))
32.         )
33.       )
34.       (setq recode (open opf "w"))
35.       (write-line str recode)
36.       (close recode)
37.     )
38.   )
39.   (princ)
40. )
41.  

[Marc'Antonio Alessi]

My last shot:

Code: [Select]

(defun C:ALE_ShortLongestPLByLyr03 ( / SelSet EntDat Countr EntNam LenVal LyrNam TmpLst InfLst)
    (if (setq Countr 0 SelSet (ssget "_X" (list '(0 . "POLYLINE"))))
      (progn
        (setvar "HIGHLIGHT" 0)
        (repeat (sslength SelSet)
          (setq
            EntNam (ssname SelSet Countr) EntDat (entget EntNam)
            LenVal (vlax-curve-getDistAtParam EntNam (vlax-curve-getEndParam EntNam))
            LyrNam (cdr (assoc 8 EntDat))
            Countr (1+ Countr)
          )
          (cond
            ( (not (setq TmpLst (assoc LyrNam InfLst)))
              (setq InfLst (cons (list LyrNam EntNam LenVal EntNam LenVal) InfLst))
            )
            ( (> LenVal (nth 4 TmpLst))
              (setq InfLst (subst (list (car TmpLst) (cadr TmpLst) (caddr  TmpLst)  EntNam LenVal) TmpLst  InfLst))
            )
            ( (< LenVal (caddr TmpLst))
              (setq InfLst (subst (list (car TmpLst) EntNam LenVal (cadddr TmpLst) (nth 4 TmpLst)) TmpLst  InfLst))
            )
          )
        )
      )
    )
   (command "_.ERASE" SelSet "")
   (foreach ForElm InfLst (entdel (cadr ForElm)) (entdel (cadddr ForElm)))
)

[irneb]

I'm not too sure which would be faster:

• sending a selection set to the erase command
• entdel each entity in turn
• vla-Delete each entity
• vla-Erase a vla selection set (probably this one, but then the rest of the code doesn't perform too well)

I think the use of entdel to unerase the entities should be a slight bit faster, since even sending a remove to the command is still adjusting a selection set (even though it's inside the ObjectARX of the erase command).

But  we're all actually missing Mark's request from post #7: Not using any vlax methods. Thus it means stuck with entget (since from a previous test of mine) the new getpropertyvalue function is even slower than using entget (I think it might be because it's implemented in DotNet, which isn't the fastest already, and also needs converting to-and-from DotNet object types): http://www.theswamp.org/index.php?topic=43304.msg485508#msg485508

Thus far I've not seen any other codes performing this without vlax (at least once). Anyone have an idea to speed up my original version from post #9, or do it through some other way? It should be possible to speed it up quite a lot by only worrying about 3d polylines specific to this thread - unlike my code which is calculating even bulged vectors.

[Lee Mac]

But  we're all actually missing Mark's request from post #7: Not using any vlax methods.

Much slower 

Code: [Select]

(defun LM:LongShortPoly ( / e1 e2 el in le ll ln p1 p2 se sl ss )
    (foreach la '((8 . "BLUE") (8 . "CYAN") (8 . "GREEN") (8 . "RED"))
        (setq ll -1.0  le nil
              sl 1e308 se nil
        )
        (if (setq ss (ssget "_X" (list '(0 . "POLYLINE") la)))
            (progn
                (repeat (setq in (sslength ss))
                    (setq e1 (ssname ss (setq in (1- in)))
                          e2 (entnext e1)
                          p1 (cdr (assoc 10 (entget e2)))
                          e2 (entnext e2)
                          el (entget  e2)
                          ln 0.0
                    )
                    (while (= "VERTEX" (cdr (assoc 0 el)))
                        (setq p2 (cdr (assoc 10 el))
                              ln (+ ln (distance p1 p2))
                              e2 (entnext e2)
                              el (entget  e2)
                              p1 p2
                        )
                    )
                    (if (< ll ln)
                        (setq ll ln le e1)
                    )
                    (if (< ln sl)
                        (setq sl ln se e1)
                    )
                    (entdel e1)
                )
                (entdel le)
                (entdel se)
            )
        )
    )
    (princ)
)

Code: [Select]

(time-it '(LM:LongShortPoly))
Program running time: 2324 msecs.

[Marc'Antonio Alessi]

I'm not too sure which would be faster:

• sending a selection set to the erase command
• entdel each entity in turn
• vla-Delete each entity
• vla-Erase a vla selection set (probably this one, but then the rest of the code doesn't perform too well)

<clip>

IMHO vla-Erase a vla selection set is slower.
The real problem is to test it:

Code: [Select]

;no vlax-curve-...
(defun C:ALE_ShortLongestPLByLyr05 ( / VlaObj SelSet EntDat Countr EntNam LenVal LyrNam TmpLst InfLst)
    (if (setq Countr 0 SelSet (ssget "_X" (list '(0 . "POLYLINE"))))
      (progn
        (setvar "HIGHLIGHT" 0)
        (repeat (sslength SelSet)
          (setq
            EntNam (ssname SelSet Countr) EntDat (entget EntNam)
            VlaObj (vlax-ename->vla-object EntNam)
            LenVal (vla-get-length VlaObj)
            LyrNam (cdr (assoc 8 EntDat))
            Countr (1+ Countr)
          )
          (cond
            ( (not (setq TmpLst (assoc LyrNam InfLst)))
              (setq InfLst (cons (list LyrNam EntNam LenVal EntNam LenVal) InfLst))
            )
            ( (> LenVal (nth 4 TmpLst))
              (setq InfLst (subst (list (car TmpLst) (cadr TmpLst) (caddr  TmpLst)  EntNam LenVal) TmpLst  InfLst))
            )
            ( (< LenVal (caddr TmpLst))
              (setq InfLst (subst (list (car TmpLst) EntNam LenVal (cadddr TmpLst) (nth 4 TmpLst)) TmpLst  InfLst))
            )
          )
        )
      )
    )
   (command "_.ERASE" SelSet "")
   (foreach ForElm InfLst (entdel (cadr ForElm)) (entdel (cadddr ForElm)))
)

(repeat 10
(time-it '(C:ALE_ShortLongestPLByLyr05))
(command "_.OOPS")
(gc)
)
Program running time: 936 msecs.
Program running time: 406 msecs.
Program running time: 593 msecs.
Program running time: 390 msecs.
Program running time: 312 msecs.
Program running time: 328 msecs.
Program running time: 312 msecs.
Program running time: 406 msecs.
Program running time: 312 msecs.
Program running time: 312 msecs.

[LE3]

Here it is the C# solution and the dll in case anyone wants to run the test for this command.

Note, it does a filter to ignore some layers.

Command name: SLP

Command: slp
Elapsed=68msecs. 79msecs // here it is returning also the timing using the system variable millisecs- value on the right.

Code: [Select]

        [CommandMethod("SLP")]
        public void cmd_shortestLongestPlinesOnLayer()
        {
            var e = AcadApp.DocumentManager.MdiActiveDocument.Editor;
            using (var tr = e.Document.Database.TransactionManager.StartTransaction())
            {
                var layerTable = tr.GetObject(e.Document.Database.LayerTableId, OpenMode.ForRead) as LayerTable;
                var sw = Stopwatch.StartNew();
                var st = (int)AcadApp.GetSystemVariable("millisecs");
                foreach (var layerId in layerTable)
                {
                    var layer = tr.GetObject(layerId, OpenMode.ForRead) as LayerTableRecord;
                    if (layer.Name.Equals("Defpoints") || layer.IsFrozen || layer.IsOff || layer.Name.Contains("|"))
                        continue;
                    var pairs = new Dictionary<double, Polyline3d>();
                    PromptSelectionResult psr;
                    if (SelectionOfPLines(e, layer.Name, out psr)) continue;
                    foreach (var id in psr.Value.GetObjectIds())
                    {
                        var pline = tr.GetObject(id, OpenMode.ForWrite, false) as Polyline3d;
                        if (pline.Layer != layer.Name) continue;
                        pairs.Add(pline.Length, pline);
                        pline.Erase(true);
                    }
                    psr.Value.Dispose();
                    if (pairs.Count <= 0) continue;
                    var dict = pairs.Keys;
                    var maxLine = dict.Max();
                    var minLine = dict.Min();
                    var ll = pairs[maxLine];
                    var sl = pairs[minLine];
                    ll.Erase(false);
                    sl.Erase(false);
                    pairs.Clear();
                }
                sw.Stop();
                var et = (int)AcadApp.GetSystemVariable("millisecs");
                e.WriteMessage("\nElapsed={0}msecs. {1}msecs \n", sw.ElapsedMilliseconds, (et - st).ToString());
                tr.Commit();
            }
        }

        private static bool SelectionOfPLines(Editor e, string layerName, out PromptSelectionResult psr)
        {
            TypedValue[] tv = { new TypedValue((int)DxfCode.Start, "POLYLINE"), new TypedValue((int)DxfCode.LayerName, layerName) };
            var filter = new SelectionFilter(tv);
            psr = e.SelectAll(filter);
            return psr.Status != PromptStatus.OK;
        }