Author Topic: (Challenge) To draw the shortest lwpolyline  (Read 93640 times)

0 Members and 3 Guests are viewing this topic.

Lee Mac

  • Seagull
  • Posts: 12727
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #45 on: September 28, 2009, 10:03:38 AM »
I have updated my routine, but I'm still not as short as yours...  :|

Code: [Select]
(defun mkPoly (lst / mklw vlax-list->2D-point SubLst remove_nth
               
                     i x miP maP tmp lst nlst par ptlst obj)
  (vl-load-com)

  ;;(foreach pt lst (command "_.point" "_non" pt))

  (defun mklw (l / e)
    (entmakex (append (list (cons 0   "LWPOLYLINE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbPolyline")
                            (cons 90 (length l))
                            (cons 70 1))
                      (mapcar (function (lambda (a) (cons 10 a))) l))))

  (defun vlax-list->2D-point (lst)
    (if lst
      (cons (list (car lst) (cadr lst))
            (vlax-list->2D-point (cddr lst)))))

  (defun SubLst (lst i j / k)
    (setq k -1)
    (or j (setq j (length lst)))
    (vl-remove-if-not
      (function
        (lambda (x)
          (<= i (setq k (1+ k)) (+ i (1- j))))) lst))

  (defun remove_nth (k lst / j)
    (setq j -1)
    (vl-remove-if
      (function
        (lambda (x)
          (= k (setq j (1+ j))))) lst))

  (setq miP (apply 'mapcar (cons 'min lst)))
  (setq maP (apply 'mapcar (cons 'max lst)))

  (setq obj (vlax-ename->vla-object
              (mklw (list miP (list (car miP) (cadr maP)) maP (list (car maP) (cadr miP))))))

  (setq lst (vl-sort lst
              (function
                (lambda (a b) (< (distance (vlax-curve-getClosestPointto obj a) a)
                                 (distance (vlax-curve-getClosestPointto obj b) b))))))

  (setq nlst lst)
  (while (setq x (car nLst))
    (setq nLst (cdr nLst) par (fix (vlax-curve-getParamatPoint obj
                                     (vlax-curve-getClosestPointto obj x))))

    (setq ptlst (vlax-list->2D-point (vlax-get obj 'Coordinates)))

    (setq ptlst (append (SubLst ptlst 0 (1+ par)) (list x)
                        (SubLst ptlst   (1+ par) nil)))

    (vlax-put obj 'Coordinates (apply 'append ptlst)))

  (vlax-put obj 'Coordinates (apply 'append
                               (setq ptlst
                                 (vl-remove-if-not
                                   (function (lambda (x) (vl-position x lst))) ptlst))))

  (setq i -1)
  (repeat (length ptlst)
    (setq x (nth (setq i (1+ i)) ptlst))
   
    (vlax-put obj 'Coordinates (apply 'append (Remove_nth i ptlst)))

    (setq par (fix (vlax-curve-getParamatPoint obj
                     (vlax-curve-getClosestPointto obj x))))

    (setq ptlst (vlax-list->2D-point (vlax-get obj 'Coordinates)))

    (setq ptlst (append (SubLst ptlst 0 (1+ par)) (list x)
                        (SubLst ptlst   (1+ par) nil)))

    (vlax-put obj 'Coordinates (apply 'append ptlst)))

  (vlax-put obj 'Coordinates (apply 'append ptlst))
 
  (princ (strcat "\nPolyline Length: " (rtos (vla-get-Length obj) 2 2) " mm."))
  (princ))

Code: [Select]
Polyline Length: 2535.09 mm.


ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #46 on: September 28, 2009, 10:15:37 AM »


I have updated my routine, but I'm still not as short as yours...  





Your result is magnificent.
Using manual designing, not probably to make better!
Manual methods, it is impossible even to repeat your result, for reasonable time if to speak about a permanent job.


Lee Mac

  • Seagull
  • Posts: 12727
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #47 on: September 28, 2009, 10:21:04 AM »
Thanks ElpanovEvgeniy  :-)

I have used your "pair rearrangment" algorithm idea - and improved my result slightly  :-)

Code: [Select]
(defun mkPoly (lst / mklw vlax-list->2D-point SubLst remove_nth
               
                     i x miP maP tmp lst nlst par ptlst obj nlst nlen)
  (vl-load-com)

  (defun mklw (l / e)
    (entmakex (append (list (cons 0   "LWPOLYLINE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbPolyline")
                            (cons 90 (length l))
                            (cons 70 1))
                      (mapcar (function (lambda (a) (cons 10 a))) l))))

  (defun vlax-list->2D-point (lst)
    (if lst
      (cons (list (car lst) (cadr lst))
            (vlax-list->2D-point (cddr lst)))))

  (defun SubLst (lst i j / k)
    (setq k -1)
    (or j (setq j (length lst)))
    (vl-remove-if-not
      (function
        (lambda (x)
          (<= i (setq k (1+ k)) (+ i (1- j))))) lst))

  (defun remove_nth (k lst / j)
    (setq j -1)
    (vl-remove-if
      (function
        (lambda (x)
          (= k (setq j (1+ j))))) lst))

  (setq miP (apply 'mapcar (cons 'min lst)))
  (setq maP (apply 'mapcar (cons 'max lst)))

  (setq obj (vlax-ename->vla-object
              (mklw (list miP (list (car miP) (cadr maP)) maP (list (car maP) (cadr miP))))))

  (setq lst (vl-sort lst
              (function
                (lambda (a b) (< (distance (vlax-curve-getClosestPointto obj a) a)
                                 (distance (vlax-curve-getClosestPointto obj b) b))))))

  (setq nlst lst)
  (while (setq x (car nLst))
    (setq nLst (cdr nLst) par (fix (vlax-curve-getParamatPoint obj
                                     (vlax-curve-getClosestPointto obj x))))

    (setq ptlst (vlax-list->2D-point (vlax-get obj 'Coordinates)))

    (setq ptlst (append (SubLst ptlst 0 (1+ par)) (list x)
                        (SubLst ptlst   (1+ par) nil)))

    (vlax-put obj 'Coordinates (apply 'append ptlst)))

  (vlax-put obj 'Coordinates (apply 'append
                               (setq ptlst
                                 (vl-remove-if-not
                                   (function (lambda (x) (vl-position x lst))) ptlst))))

    (setq i -1)
    (repeat (length ptlst)
      (setq x (nth (setq i (1+ i)) ptlst))
     
      (vlax-put obj 'Coordinates (apply 'append (Remove_nth i ptlst)))
      (setq par (fix (vlax-curve-getParamatPoint obj
                       (vlax-curve-getClosestPointto obj x))))

      (setq ptlst (vlax-list->2D-point (vlax-get obj 'Coordinates)))

      (setq ptlst (append (SubLst ptlst 0 (1+ par)) (list x)
                          (SubLst ptlst   (1+ par) nil)))

      (vlax-put obj 'Coordinates (apply 'append ptlst)))

  (setq i -1)
  (repeat (- (length ptlst) 1)
    (setq x (nth (setq i (1+ i)) ptlst) y (nth (1+ i) ptlst))

    (vlax-put obj 'Coordinates (apply 'append ptlst))
    (setq len (vla-get-length obj))

    (setq nlst (append (SubLst ptlst 0 i) (list y x)
                       (Sublst ptlst (+ i 2) nil)))

    (vlax-put obj 'Coordinates (apply 'append nlst))
    (if (< (setq nlen (vla-get-length obj)) len)
      (setq ptlst nlst len nlen)))

  (vlax-put obj 'Coordinates (apply 'append ptlst))
 
  (princ (strcat "\nPolyline Length: " (rtos (vla-get-Length obj) 2 4) " mm."))
  (princ))





Almost there - although I don't think I'm anywhere near a Generic one!  :lol:

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #48 on: September 28, 2009, 10:30:16 AM »
Excellent result!
You very quickly understand an essence.

I shall dare to give one more advice.
Functions vlax-curve-* work much more quickly if it to transfer argument ename than object.
Especially strongly, it is appreciable on the contours having a plenty of segments.

Lee Mac

  • Seagull
  • Posts: 12727
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #49 on: September 28, 2009, 10:37:14 AM »
Excellent result!
You very quickly understand an essence.

I shall dare to give one more advice.
Functions vlax-curve-* work much more quickly if it to transfer argument ename than object.
Especially strongly, it is appreciable on the contours having a plenty of segments.

Thank you  :-)

I didn't realise that curve functions worked faster with enames... I thought they had the same performance with objects and enames... thanks for that.  :wink:

Lee Mac

  • Seagull
  • Posts: 12727
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #50 on: September 28, 2009, 10:39:12 AM »
Just had to test it :P

Code: [Select]
Elapsed milliseconds / relative speed for 16384 iteration(s):

    (vlax-curve-getEndParam ENT).....1233 / 1.43 <fastest>
    (vlax-curve-getEndParam OBJ).....1763 / 1.00 <slowest>

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #51 on: September 28, 2009, 10:48:38 AM »
Just had to test it :P

Code: [Select]
Elapsed milliseconds / relative speed for 16384 iteration(s):

    (vlax-curve-getEndParam ENT).....1233 / 1.43 <fastest>
    (vlax-curve-getEndParam OBJ).....1763 / 1.00 <slowest>

It is not enough, who knows. In the help autocad it is told, it is necessary to use curve-obj - VLA-object.
About an opportunity of use ename - it is not written.

Try to create a polygon "_polygon" with a lot of segments, for example 600 and try to compare speed for
vlax-curve-getDistAtPoint
You will be strongly surprised...

ps. If the polyline has arc segments, the difference is even more!
In my practice there was a difference in 200 times!

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #52 on: September 28, 2009, 10:59:43 AM »
It is very a pity, I hoped, in a theme will be more participants...

Earlier, themes with the name " (Challenge) *** " were more often also than participants was more.
Prompt me, it was very complex task or it was not interesting?
Probably, I have had time to offend?

Whether themes " (Challenge) *** " with tasks for algorithms are necessary or programming with comparison of quantity of lines and is interesting only to time of performance?


Lee Mac

  • Seagull
  • Posts: 12727
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #53 on: September 28, 2009, 11:08:41 AM »
It is very a pity, I hoped, in a theme will be more participants...

Earlier, themes with the name " (Challenge) *** " were more often also than participants was more.
Prompt me, it was very complex task or it was not interesting?
Probably, I have had time to offend?

Whether themes " (Challenge) *** " with tasks for algorithms are necessary or programming with comparison of quantity of lines and is interesting only to time of performance?

I think rather that this task is based more on the best Algorithm rather than the fastest programming solution, and hence knowledge of the language.

Therefore there are fewer "obvious" solutions.

Probably, I have had time to offend?

No, I very much doubt that.  :-)


T.Willey

  • Needs a day job
  • Posts: 5251
Re: (Challenge) To draw the shortest lwpolyline
« Reply #54 on: September 28, 2009, 11:12:13 AM »
I liked the idea, but I didn't have time to participate.  I don't think I have the knowledge either.  I would have to read the link supplied, and then come up with some code.  I might have some time this week, but no promises.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #55 on: September 28, 2009, 11:14:00 AM »

I think rather that this task is based more on the best Algorithm rather than the fastest programming solution, and hence knowledge of the language.


For the second list, we pressed out covering loop, and it was possible to inflate a bubble.
In general, it is possible to think up many different algorithms.
By the way, I am not assured, that my result the shortest!

VovKa

  • Water Moccasin
  • Posts: 1504
  • Ukraine
Re: (Challenge) To draw the shortest lwpolyline
« Reply #56 on: September 28, 2009, 11:29:22 AM »
Lee, your code crashes when supplied '((20.0 0.0) (80.0 0.0) (100.0 100.0) (0.0 100.0)) as an argument
Quote
; error: Exception occurred: 0xC0000005 (Access Violation)
; warning: unwind skipped on unknown exception

Lee Mac

  • Seagull
  • Posts: 12727
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #57 on: September 28, 2009, 11:34:05 AM »
Lee, your code crashes when supplied '((20.0 0.0) (80.0 0.0) (100.0 100.0) (0.0 100.0)) as an argument
Quote
; error: Exception occurred: 0xC0000005 (Access Violation)
; warning: unwind skipped on unknown exception

VovKa, I find I sometimes get those errors when using the 'Coordinates Property - I am not entirely sure what causes it though, I am not sure why my code would work with Evgeniy's long list of points as opposed to your 4 points.  :?

VovKa

  • Water Moccasin
  • Posts: 1504
  • Ukraine
Re: (Challenge) To draw the shortest lwpolyline
« Reply #58 on: September 28, 2009, 12:30:36 PM »
Lee, it crashes almost all the time for me. I can't even test your code :(

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #59 on: September 28, 2009, 12:34:20 PM »
Lee, it crashes almost all the time for me. I can't even test your code :(

Clean from a code recursion...