Topic: selection set "by length"

[Mark]

Any way to speed up this process? So far I've tried these three variations.

Code: [Select]


;;; ============= number 1 ====================
(defun ss-by-length (lt / get-lgth ss ssf cntr ent lgth)
  ;; return a sset that contains all the LINES that are
  ;; greater than length (lt)

  (defun get-lgth (ent)
    (distance
      (cdr (assoc 10 (entget ent)))
      (cdr (assoc 11 (entget ent)))
      )
    )

  (gc)

  (setq ss (ssget "X" '((0 . "LINE")))
        ssf (ssadd)
        cntr 0
        )

  (if (> (sslength ss) 0)
    (repeat (1- (sslength ss))
            (setq ent (ssname ss cntr)
                  lgth (get-lgth ent)
                  )

            (if (> lgth lt)(setq ssf (ssadd ent ssf)))
            (setq cntr (1+ cntr))
            )
    )

  ssf
  )

;;; ============= number 2 ====================
(defun ss-by-length (lt / get-lgth ss ssf cntr ent lgth)
  ;; return a sset that contains all the LINES that are
  ;; greater than length (lt)

  (defun get-lgth (ent)
    (distance
      (cdr (assoc 10 (entget ent)))
      (cdr (assoc 11 (entget ent)))
      )
    )

  (gc)

  (setq ss (ssget "X" '((0 . "LINE")))
        ssf (ssadd)
        cntr 0
        )

  (if (> (sslength ss) 0)
    (while (setq ent (ssname ss cntr))

           (setq lgth (get-lgth ent))

           (if (> lgth lt)(setq ssf (ssadd ent ssf)))
           (setq cntr (1+ cntr))
           )
    )

  ssf
  )
 
;;; ============= number 3 ====================
(defun ss-by-length (lt / get-lgth ss ssf cntr ent lgth)
  ;; return a sset that contains all the LINES that are
  ;; greater than length (lt)

  (defun get-lgth (ent)
    (distance
      (cdr (assoc 10 (entget ent)))
      (cdr (assoc 11 (entget ent)))
      )
    )

  (gc)

  (setq ss (ssget "X" '((0 . "LINE")))
        cntr 0
        )

  (if (> (sslength ss) 0)
    (repeat (1- (sslength ss))
            (setq ent (ssname ss cntr)
                  lgth (get-lgth ent)
                  )

            (if (> lgth lt)(setq ss (ssdel ent ss)))
            (setq cntr (1+ cntr))
            )
    )

  ss
  )


[MP]

What if you rethink the idea?

For example, I'm a big believer in flexible functions. What if you had a function that was essentially a "remove ename from selection set if predicate function (that takes an entity name as the sole argument) is true?" kind of thing.

Not optimized, but ...

Code: [Select]

(defun SSRemoveIf ( QuotedFunction ss / i ename )
    (cond
        (   (eq 'pickset (type ss))
            (repeat (setq i (sslength ss))
                (if
                    (apply QuotedFunction
                        (list
                            (setq ename
                                (ssname ss (setq i (1- i)))
                            )    
                        )
                    )
                    (ssdel ename ss)
                )
            )
            (if (< 0 (sslength ss)) ss)
        )    
    )    
)
Then you could call it like ...

Code: [Select]

(SSRemoveIf
   '(lambda (ename)
        (<  (vla-get-length
                (vlax-ename->vla-object ename)
            )
            10 ;; remove all lines less than 10 units long
        )
    )
    (ssget "x" '((0 . "line")))
)

This is over simplified, you would probably need to employ robust error trapping; I wanted to keep it simple for idea clarity.

Just a thought.

Edit: Revised SSRemoveIf.

[CAB]

Mark
How does this one fair?
I did not test it.

Code: [Select]

(defun ss-by-length (lt / ss ename elst)
  (and
    (setq ss (ssget "X" '((0 . "LINE"))))
    (setq i (sslength ss))
    (while (setq ename (ssname ss (setq i (1- i))))
      (setq elst (entget ename))
      (if (< (distance (cdr(assoc 10 elst))(cdr(assoc 11 elst))) lt)
        (ssdel ename ss))
    )
  )
  ss
)

EDIT: I think I fixed it...

[MP]

Hey CAB -- it's not a good idea to iterate thru a selection set in a forward direction if you are modifying it (adding or removing members).

Also, I think you missed some cdr statements (does run fast when fixed up).

Cheers.

[CAB]

Oooops,

Sorry about that. I did not think about that. The pointer would get lost.
That's what happens when you don't test your work. I can't write error free
code on the fly like you and Stig can.

[MP]

I can't write error free code on the fly like you and Stig can.

I think you have me confused with someone else CAB -- I araely wrtie errro fere cdoe no teh fyl.

[spacebuffalo]

the ss in the while loop is different than the returned ss...

[CAB]

I posted the repaired code, so Mark try it again.

[JohnK]

>  I araely wrtie errro fere cdoe no teh fyl

:Oo:
I understood every word of that sentence. (Is that sad?! Do i really spell that bad. Do i really spell like "T I Double 'Grr'" speaks?)

[Mark]

- CAB
that surely beats mine in a speed test.

- MP
That is truly ingenious! I would have never thought of that. I'm still looking at how I might  "optimized" that code.

Thanks for all the input guys.

[whdjr]

MP,

How do you even think like that?

That is too cool!

[CAB]

MP,

How do you even think like that?

That is too cool!

"How, can you not think like that?" said MP the Lisp Master

It amazes me too, I think these folks have internalized the language and with
there creative talent it just flows out.

[MP]

Guys, it's not all that clever -- it's just an adaptation of functions we already have, like vl-remove-if.

[MP]

Some quick notes on performance.

This code --

Code: [Select]

(SSRemoveIf
   '(lambda (ename)
        (<  (vla-get-length
                (vlax-ename->vla-object ename)
            )
            10 ;; remove all lines less than 10 units long
        )
    )
    (ssget "x" '((0 . "line")))
)

Is fine if the code will be executed once, but if the code will be executed multiple times, say in a process loop, better performance will be realized by committing the functionality to a formal function. This would remove the overhead associated with the creation of the temporary function for each iteration.

Example --

Code: [Select]

(defun Foo (ename)
    (<  (vla-get-length
            (vlax-ename->vla-object ename)
        )
        10 ;; remove all lines less than 10 units long
    )
)

(repeat n
    (cond
        (   (setq ss
                (SSRemoveIf
                   'Foo  ;; note, quoted function
                    (ssget "x" '((0 . "line")))
                )
            )
            ;;  now do something with the selection set ...
        )
    )
)

Still better performance can be realized if we remove the need for the function to be quoted:

Code: [Select]

(defun SSRemoveIf ( UnquotedFunction ss / i ename )
    (cond
        (   (eq 'pickset (type ss))
            (repeat (setq i (sslength ss))
                (if
                    (UnquotedFunction
                        (setq ename
                            (ssname ss (setq i (1- i)))
                        )    
                    )
                    (ssdel ename ss)
                )
            )
            (if (< 0 (sslength ss)) ss)
        )    
    )    
)

Now call it using an unquoted function --

Code: [Select]

(SSRemoveIf
    Foo ;; note, unquoted function call
    (ssget "x" '((0 . "line")))
)

Finally1, if you are writing an application that must run as fast as possible, using generic functions / structures like above are probably not the way to go. In that case I would likely hand roll each function specifically for each task.

Finally2, also note that there are differences between activex calls and dxf equivalents -- sometimes activex wins, sometimes it doesn't. You may have to do some benching.

Enjoy.

[Mark]

Enjoy.

Oh .......... I am.  

Many thanks there MP.

[MP]

My pleasure Mark.

[MP]

Speaking of optimizing, benchmarking ... thought you might find this illuminating Mark ...

Using this benchmarking utility ...

Code: [Select]

(defun c:Test

    (   /
        GetEnameDistance
        GetEnameLength
        GetObjectLength
        ename
        object
    )

    (defun GetEnameDistance ( ename / data )
        (distance
            (cdr (assoc 10 (setq data (entget ename))))
            (cdr (assoc 11 data))
        )
    )

    (defun GetEnameLength ( ename )
        (vlax-get-property
            (vlax-ename->vla-object ename)
            'Length
        )
    )

    (defun GetObjectLength ( object )
        (vlax-get-property
            object
            'Length
        )
    )

    (setvar "cmdecho" 0)
    (command ".line" '(0 0) '(10 10) "")
    (setvar "cmdecho" 0)

    (setq object
        (vlax-ename->vla-object
            (setq ename (entlast))
        )    
    )

    (Benchmark
       '(
            (GetEnameDistance ename)
            (GetEnameLength ename)
            (GetObjectLength object)
        )
    )

    (vl-catch-all-apply
       '(lambda ()
            (entdel ename)
        )
    )

    (princ)

)

(c:Test)

Output:

Elapsed milliseconds / relative speed for 32768 iteration(s):

    (GETOBJECTLENGTH OBJECT).....1687 / 1.63 <fastest>
    (GETENAMEDISTANCE ENAME).....1985 / 1.39
    (GETENAMELENGTH ENAME).......2750 / 1.00 <slowest>

[Mark]

Now that is cool !!
I'm surprised that 'GetEnameDistance' was slower than 'GetObjectLength'.

[SMadsen]

Got another result:

Code: [Select]

   (GETENAMEDISTANCE ENAME).....1234 / 1.82 <fastest>
    (GETOBJECTLENGTH OBJECT).....1390 / 1.62
    (GETENAMELENGTH ENAME).......2250 / 1.00 <slowest>

[SMadsen]

Here's an interesting observation. Given the function below, passing an object to it is slower than passing an ename:

Code: [Select]

   (defun GetCurveLength ( object )
      (vlax-curve-getDistAtPoint
        object
        (vlax-curve-getEndPoint object)
      )
    )


Code: [Select]

Object:
    (GETENAMEDISTANCE ENAME).....1219 / 1.99 <fastest>
    (GETOBJECTLENGTH OBJECT).....1484 / 1.63
    (GETCURVELENGTH OBJECT)......2047 / 1.18
    (GETENAMELENGTH ENAME).......2422 / 1 <slowest>

Ename:
    (GETCURVELENGTH ENAME).......1235 / 2.19 <fastest>
    (GETENAMEDISTANCE ENAME).....1500 / 1.8
    (GETOBJECTLENGTH OBJECT).....1781 / 1.52
    (GETENAMELENGTH ENAME).......2703 / 1 <slowest>


[CAB]

My results. Ran it twice.

Code: [Select]

   (GETENAMEDISTANCE ENAME).....1222 / 1.57 <fastest>
    (GETOBJECTLENGTH OBJECT).....1322 / 1.45
    (GETENAMELENGTH ENAME).......1913 / 1.00 <slowest>
   
   
    (GETENAMEDISTANCE ENAME).....1112 / 1.65 <fastest>
    (GETOBJECTLENGTH OBJECT).....1271 / 1.44
    (GETENAMELENGTH ENAME).......1833 / 1.00 <slowest>

PS.  I think Michael's computer has a vla bias.

[Mark]

my results.

Code: [Select]


:: pasted 'test' strait into acad
Elapsed milliseconds / relative speed for 32768 iteration(s):

    (GETOBJECTLENGTH OBJECT).....1375 / 1.66 <fastest>
    (GETENAMEDISTANCE ENAME).....1766 / 1.29
    (GETENAMELENGTH ENAME).......2281 / 1.00 <slowest>

:: from within the vlide/vlisp console
Benchmarking .................Elapsed milliseconds / relative speed for 16384 iteration(s):

    (GETENAMEDISTANCE ENAME).....1062 / 1.97 <fastest>
    (GETOBJECTLENGTH OBJECT).....1281 / 1.63
    (GETENAMELENGTH ENAME).......2094 / 1.00 <slowest>


[MP]

Quick note --

I was running under AutoCAD 2004 and killed all other apps as well as my internet connection.

Also --

   ;;  Notes:
    ;;
    ;;      I make no claims that this is definitive benchmarking. I
    ;;      wrote this utility for my own purposes and thought I'd
    ;;      share it. Many considerations go into evaluating the
    ;;      performance or suitability of an algorythm for a given
    ;;      task. Raw performance as profiled herein is just one.
    ;;
    ;;      Please note that background dramatically affect results.

In other words, it's a guide, an indicator of performance, but as written I don't think it's a definitive work for benchmarking. Take the results with a grain a salt, switch the order of the statements being evaluated, perform several runs etc.

<gotto go, sorry to be so brief>