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

0 Members and 1 Guest are viewing this topic.

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1535
  • Moscow (Russia)
(Challenge) To draw the shortest lwpolyline
« on: September 25, 2009, 09:22:35 AM »
Hello!
I wish to offer you the next competition.
It is given: the list of points
It is necessary: to draw lwpolyline passing through all points.

I think, it is necessary to pay attention on length lwpolyline.
Two lists of points are attached.
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1535
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #1 on: September 25, 2009, 10:05:24 AM »
Explanation
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

VovKa

  • Swamp Rat
  • Posts: 1046
  • Ukraine
Re: (Challenge) To draw the shortest lwpolyline
« Reply #2 on: September 25, 2009, 10:12:23 AM »
seems that Evgeniy is trying to spoil other people's friday night :)

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1535
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #3 on: September 25, 2009, 10:14:34 AM »
seems that Evgeniy is trying to spoil other people's friday night :)

On the native land of a forum, now morning!
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

CAB

  • Global Moderator
  • Seagull
  • Posts: 10324
Re: (Challenge) To draw the shortest lwpolyline
« Reply #4 on: September 25, 2009, 11:13:42 AM »
Oh, The Traveling Salesman Problem.
Wish I had time today but a deadline calls.  :?
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1535
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #5 on: September 25, 2009, 11:39:16 AM »
Well, I do not put deadline.

Enjoy the task! :)
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

Lee Mac

  • Seagull
  • Posts: 12112
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #6 on: September 25, 2009, 11:55:35 AM »
Nice challenge Evgeniy - I doubt my code will be a match for you guru's but I'll happily take up the challenge  :evil:

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1535
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #7 on: September 25, 2009, 11:59:40 AM »
I see, it is necessary to lay out a simple code, I am fast it I will make!
Any code, will be better...
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1535
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #8 on: September 25, 2009, 12:15:55 PM »
Code: [Select]
(defun make-lwpolyline(l / e)
 ;;(make-lwpolyline lst)
 (setq e (entmakex (append (list '(0 . "LWPOLYLINE")
                                 '(100 . "AcDbEntity")
                                 '(67 . 0)
                                 '(410 . "Model")
                                 '(8 . "Kant")
                                 '(62 . 3)
                                 '(100 . "AcDbPolyline")
                                 (cons 90 (length l))
                                 '(70 . 1)
                           ) ;_  list
                           (mapcar (function (lambda (a) (cons 10 a))) l)
                   ) ;_  append
         ) ;_  entmakex
 ) ;_  setq
 (Princ (strcat "\n length lwpolyline "
                (rtos (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) 2 4)
                " mm."
        ) ;_  strcat
 ) ;_  Princ
 (Princ)
) ;_  defun
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

Lee Mac

  • Seagull
  • Posts: 12112
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #9 on: September 25, 2009, 12:27:45 PM »
This probably isn't worth posting, but my first feeble attempt:

Code: [Select]
(defun mkPoly (lst / lst tmp ply)
  (setq tmp (car lst))

  (setq lst
    (mapcar
      (function
        (lambda (x)
          (cons 10 x)))
      (cons tmp
        (vl-sort (cdr lst)
          (function
            (lambda (a b)
              (< (distance tmp a)
                   (distance tmp b))))))))


  (setq ply
    (entmakex
      (append (list (cons 0 "LWPOLYLINE")
                    (cons 100 "AcDbEntity")
                    (cons 100 "AcDbPolyline")
                    (cons 90 (length lst))
                    (cons 70 1))
              lst)))

  (princ (strcat "\nPolyline Length: " (rtos (vlax-curve-getDistatParam ply
                                               (vlax-curve-getEndParam ply)) 2 4) " mm."))
  (princ))

Code: [Select]
lst-a : Polyline Length: 18161.6874 mm.

lst-b : Polyline Length: 5383.8140 mm.

 

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1535
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #10 on: September 25, 2009, 12:38:26 PM »
The interesting approach, for the chaotic list, results is better than the starting list.
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

ronjonp

  • Needs a day job
  • Posts: 6805
Re: (Challenge) To draw the shortest lwpolyline
« Reply #11 on: September 25, 2009, 12:41:12 PM »
Here's mine:
Code: [Select]
(defun rjp-sortpt2pt (pt lst / tmp newlst)
  (defun dsort (pt lst / d1 d2)
    (vl-sort lst (function (lambda (d1 d2) (< (distance pt d1) (distance pt d2)))))
  )
  (setq tmp (dsort pt lst))
  (repeat (length lst)
    (setq tmp (dsort (car tmp) tmp)
 newlst (cons (car tmp) newlst)
 tmp (vl-remove (car tmp) tmp)
    )
  )
  (reverse newlst)
)
(make-lwpolyline (rjp-sortpt2pt (car lst-a) lst-a))
;;3908.169
(make-lwpolyline (rjp-sortpt2pt (car lst-b) lst-b))
;;3206.567
« Last Edit: September 26, 2009, 11:31:54 AM by ronjonp »

Windows 10 x64 - AutoCAD /C3D 2019

Custom Build PC

Lee Mac

  • Seagull
  • Posts: 12112
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #12 on: September 25, 2009, 12:46:30 PM »
Nice one Ron,

I tried a different approach, but I think mine misses a few points  :oops:

Code: [Select]
(defun mkPoly (lst / rslt tmp lst ply)
 
  (setq rslt (list (car lst)))
  (while (setq lst (cdr lst))
    (setq tmp (car rslt))
    (setq rslt
      (cons
        (car (vl-sort lst
               (function
                 (lambda (a b)
                   (< (distance tmp a)
                        (distance tmp b)))))) rslt)))

  (setq ply
    (entmakex
      (append (list (cons 0 "LWPOLYLINE")
                    (cons 100 "AcDbEntity")
                    (cons 100 "AcDbPolyline")
                    (cons 90 (length rslt))
                    (cons 70 1))
              (mapcar (function (lambda (x) (cons 10 x))) rslt))))

  (princ (strcat "\nPolyline Length: " (rtos (vlax-curve-getDistatParam ply
                                               (vlax-curve-getEndParam ply)) 2 4) " mm."))
  (princ))

Code: [Select]
lst-a  Polyline Length: 968.1675 mm.

lst-b Polyline Length: 1019.6264 mm.

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1535
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #13 on: September 25, 2009, 12:48:34 PM »
Hello Ron.
I liked your code!
My code, much more long...
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

nullptr

  • BricsCAD
  • Needs a day job
  • Posts: 6820
  • AKA Daniel
Re: (Challenge) To draw the shortest lwpolyline
« Reply #14 on: September 25, 2009, 12:49:29 PM »
heres mine ... am I even close?