Topic: ( Challenge ) Shortest & Longest Segment

[Mark]

Thanks to Lee Mac for the idea

Challenge is to find the longest and shortest segment and output your findings. The attached .dwg had 1406 polylines. Of course speed is the issue.

Have fun!

[ronjonp]

Well since I had a base to start with from the other challenge Lists ename param length.

"((<Entity name: 7f7df8515f0> 7 1546.45) (<Entity name: 7f7df85dac0> 1 0.0))"
Program running time: 234 msecs.

Code - Auto/Visual Lisp: [Select]

1. (defun time-it (expr / et st)
2.   (gc)
3.   (setq st (getvar 'millisecs))
4.   (eval expr)
5.   (setq et (getvar 'millisecs))
6.   (princ (strcat "\n" (vl-prin1-to-string expr) " - " (itoa (- et st)) " msecs."))
7.   (princ)
8. )
9. (defun c:foo (/ en ep i in le len li ll ln result se si sl ss)
10.   (setq ll -1.0
11.         le nil
12.         sl 1e308
13.         se nil
14.   )
15.   (if (setq ss (ssget "_X" (list '(0 . "LINE,POLYLINE,LWPOLYLINE"))))
16.     (progn (repeat (setq in (sslength ss))
17.              (setq en  (ssname ss (setq in (1- in)))
18.                    ep  (fix (vlax-curve-getendparam en))
19.                    i   0
20.                    len 0
21.              )
22.              (repeat ep
23.                (setq ln (abs (- len (setq len (vlax-curve-getdistatparam en (setq i (1+ i)))))))
24.                (if (< ll ln)
25.                  (setq ll ln
26.                        le en
27.                        li i
28.                  )
29.                )
30.                (if (< ln sl)
31.                  (setq sl ln
32.                        se en
33.                        si i
34.                  )
35.                )
36.              )
37.              (entdel en)
38.            )
39.            (if (eq le se)
40.              (progn (entdel le) (setq result (list (list le si sl) (list le li ll))))
41.              (progn (entdel le) (entdel se) (setq result (list (list le li ll) (list se si sl))))
42.            )
43.     )
44.   )
45.   (print (vl-prin1-to-string result))
46. )
47. (time-it '(c:foo))

[Marc'Antonio Alessi]

Well since I had a base to start with from the other challenge Lists ename param length.

"((<Entity name: 7f7db5855f0> 7 1546.45) (<Entity name: 7f7db424400> 28 11.227))"
Program running time: 250 msecs.

I get this:
"((<Nome entità: 7ffff34d5f0> 7 1546.45) (<Nome entità: 7ffff359ac0> 1 0.0))"

[Marc'Antonio Alessi]

Slower (no vlax...)
Command: ALE_SHLGPLSEGMENTS01
(<Nome entità: 7ffffb825c0> 11.227 <Nome entità: 7ffff14d660> 1546.45)

Code: [Select]

(defun C:ALE_ShLgPlSegments01 ( / SelSet EntDat Countr EntNm1 EntNm2 Pnt002 Pnt001 LenVal TmpLst)
    (if (setq Countr 0 SelSet (ssget "_X" (list '(0 . "POLYLINE"))))
      (progn
        (repeat (sslength SelSet)
          (setq
            EntNm1 (entnext (ssname SelSet Countr))
            Countr (1+ Countr)
            EntNm2 (entnext EntNm1)
            Pnt002 (cdr (assoc 10 (entget EntNm2)))
            LenVal (distance (cdr (assoc 10 (entget EntNm1))) Pnt002)
          )
          (or TmpLst (setq TmpLst (list EntNm1 LenVal EntNm2 LenVal)))
          (setq EntNm1 (entnext EntNm2)  EntDat (entget EntNm1))
          (while (= "VERTEX" (cdr (assoc 0 EntDat)))
            (setq
              Pnt001 (cdr (assoc 10 (entget EntNm1)))
              LenVal (distance Pnt002 Pnt001)
            )
            (cond
              ( (> LenVal (cadddr TmpLst))
                (setq TmpLst (list (car TmpLst)  (cadr TmpLst)    EntNm2 LenVal))
              )
              ( (< LenVal (cadr TmpLst))
                (setq TmpLst (list EntNm2 LenVal (caddr TmpLst) (cadddr TmpLst)))
              )
            )
            (setq
              EntNm2 EntNm1            Pnt002 Pnt001
              EntNm1 (entnext EntNm2)  EntDat (entget EntNm1)
            )
          )
        )
      )
    )
    TmpLst
)

[fixo]

My attempt

Code: [Select]

(defun c:sbl (/ a b en i maxpl maxpts maxseg maxsort minpl minpts minseg minsort num obj par pp ss tmp unsorted)

(setq ss (ssget "_X" (list (cons 0  "POLYLINE"))))
  (setq num (sslength ss)i 0)
  (repeat num
  (setq en (ssname ss i)
obj (vlax-ename->vla-object en ))
  (setq tmp (cons obj (vla-get-length obj))
unsorted (cons tmp unsorted)
i (1+ i)))
  (setq maxsort (vl-sort unsorted '(lambda (pf ps)(> (cdr pf)(cdr ps)))))
  (setq minsort (reverse maxsort))
  (setq maxpl (caar maxsort)
minpl (caar minsort))
  (setq par1 (vlax-curve-getendParam maxpl))
  (if (eq 1 (fix par1))
   (setq maxseg (- (vlax-curve-getdistatparam maxpl par1) (vlax-curve-getdistatparam maxpl (- par1 1))))
   (progn
  (if (vlax-curve-isclosed maxpl)
     (vlax-curve-getendparam maxpl)
     (+ (vlax-curve-getendparam maxpl) 1)
   )
  (while (setq pp (vlax-curve-getpointatparam maxpl (setq par1 (- par1 1))))
    (setq maxpts (cons pp maxpts))
  )
  (setq maxseg (car (vl-sort (mapcar '(lambda ( a b) (distance a b))maxpts (cdr  maxpts)) '(lambda (a b)(> a b)))))))
  (setq par2 (vlax-curve-getendparam minpl))
(if (eq 1 (fix par2))
   (setq minseg (- (vlax-curve-getdistatparam minpl par2) (vlax-curve-getdistatparam minpl (- par2 1))))
   (progn
   (if (vlax-curve-isclosed minpl)
     (vlax-curve-getendparam minpl)
     (+ (vlax-curve-getendparam minpl) 1)
   )
  (while (setq pp (vlax-curve-getpointatparam minpl (setq par2 (- par2 1))))
    (setq minpts (cons pp minpts))
  )
  (setq minseg (car (vl-sort (mapcar '(lambda ( a b) (distance a b))minpts (cdr  minpts)) '(lambda (a b)(< a b)))))))
 
(print maxseg)(print minseg)        
(list maxseg minseg)
)

[Marc'Antonio Alessi]

Second shot, a little faster (no Vlax...):

Code: [Select]

(defun C:ALE_ShLgPlSegments02 ( / SelSet EntNam EntDat Countr EntLst LenVal TmpLst)
    (if (setq Countr 0 SelSet (ssget "_X" (list '(0 . "POLYLINE"))))
      (progn
        (setq TmpLst (list nil 1e308 nil -1.0))
        (repeat (sslength SelSet)
          (setq
            EntNam (entnext (ssname SelSet Countr))
            EntLst (list EntNam (entnext EntNam))
            Countr (1+ Countr)
            LenVal (distance
                     (cdr (assoc 10 (entget (car  EntLst))))
                     (cdr (assoc 10 (entget (cadr EntLst))))
          )        )
          (cond
            ( (> LenVal (cadddr TmpLst))
              (setq TmpLst (list (car TmpLst) (cadr TmpLst) (car EntLst) LenVal))
            )
            ( (< LenVal (cadr TmpLst))
              (setq TmpLst (list (car EntLst) LenVal (caddr TmpLst) (cadddr TmpLst)))
            )
          )
          (setq
             EntLst (list (cadr EntLst) (entnext (cadr EntLst)))
             EntDat (entget (cadr EntLst))
          )
          (while (= "VERTEX" (cdr (assoc 0 EntDat)))
            (setq LenVal (distance (cdr (assoc 10 (entget (car  EntLst)))) (cdr (assoc 10 EntDat))))
            (cond
              ( (> LenVal (cadddr TmpLst))
                (setq TmpLst (list (car TmpLst) (cadr TmpLst) (car EntLst) LenVal))
              )
              ( (< LenVal (cadr TmpLst))
                (setq TmpLst (list (car EntLst) LenVal (caddr TmpLst) (cadddr TmpLst)))
              )
            )
            (setq
              EntLst (list (cadr EntLst) (entnext (cadr EntLst)))
              EntDat (entget (cadr EntLst))
            )
          )
        )
      )
    )
    TmpLst
)

[Lee Mac]

Code - Auto/Visual Lisp: [Select]

1.                (cond ((< ll ln)
2.                       (setq ll ln
3.                             le en
4.                             li i
5.                       )
6.                      )
7.                      ((< ln sl)
8.                       (setq sl ln
9.                             se en
10.                             si i
11.                       )
12.                      )
13.                )

What if the first segment encountered is the shortest?

[ronjonp]

Well since I had a base to start with from the other challenge Lists ename param length.

"((<Entity name: 7f7db5855f0> 7 1546.45) (<Entity name: 7f7db424400> 28 11.227))"
Program running time: 250 msecs.

I get this:
"((<Nome entità: 7ffff34d5f0> 7 1546.45) (<Nome entità: 7ffff359ac0> 1 0.0))"

I get that too after I redownloaded the file. My cleanup routines must have erased that 0 length polyline off to the right.

[ronjonp]

Code - Auto/Visual Lisp: [Select]

1.                (cond ((< ll ln)
2.                       (setq ll ln
3.                             le en
4.                             li i
5.                       )
6.                      )
7.                      ((< ln sl)
8.                       (setq sl ln
9.                             se en
10.                             si i
11.                       )
12.                      )
13.                )

What if the first segment encountered is the shortest?

You'd think the results would be wrong but I can't break it.  I guess the easiest thing to do is put them back into if statements ... the speed is the same. 

[Lee Mac]

Code - Auto/Visual Lisp: [Select]

1.                (cond ((< ll ln)
2.                       (setq ll ln
3.                             le en
4.                             li i
5.                       )
6.                      )
7.                      ((< ln sl)
8.                       (setq sl ln
9.                             se en
10.                             si i
11.                       )
12.                      )
13.                )

What if the first segment encountered is the shortest?

You'd think the results would be wrong but I can't break it.  I guess the easiest thing to do is put them back into if statements ... the speed is the same. 

Try the program on a new drawing with the following LWPolyline:

Code: [Select]

(entmake
   '(
        (0 . "LWPOLYLINE")
        (100 . "AcDbEntity")
        (100 . "AcDbPolyline")
        (90 . 4)
        (70 . 0)
        (10 0.0 0.0)
        (10 1.0 0.0)
        (10 3.0 0.0)
        (10 8.0 0.0)
        (210 0.0 0.0 1.0)
    )
)
 

[ronjonp]

Modified code above  . It's hard to slip one by the master. 

[Lee Mac]

Modified code above  . It's hard to slip one by the master. 

Master of OCD 

[ronjonp]

Whatever it is ... you're good at it  :kewl:

[Lee Mac]

Whatever it is ... you're good at it  :kewl:

Cheers dude