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

0 Members and 1 Guest are viewing this topic.

VovKa

  • Swamp Rat
  • Posts: 1144
  • Ukraine
Re: (Challenge) To draw the shortest lwpolyline
« Reply #60 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: 1540
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #61 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...
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

Lee Mac

  • Seagull
  • Posts: 12254
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #62 on: September 28, 2009, 01:16:43 PM »
Lee, it crashes almost all the time for me. I can't even test your code :(

Clean from a code recursion...

Sorry Elpanov, I don't follow you  :?

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1540
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #63 on: September 28, 2009, 01:33:54 PM »
Quote
; error: Exception occurred: 0xC0000005 (Access Violation)
; warning: unwind skipped on unknown exception

It is a memory error, it often cause recursion, by too deep calls.

recursion:
Code: [Select]
(defun vlax-list->2D-point (lst)
    (if lst
      (cons (list (car lst) (cadr lst))
            (vlax-list->2D-point (cddr lst)))))

Still, such error is caused by such code:
Code: [Select]
(setq miP (apply 'mapcar (cons 'min lst)))
  (setq maP (apply 'mapcar (cons 'max lst)))

There was a theme, about such error:
Error lisp (autocad 2008)
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

VovKa

  • Swamp Rat
  • Posts: 1144
  • Ukraine
Re: (Challenge) To draw the shortest lwpolyline
« Reply #64 on: September 28, 2009, 02:35:13 PM »
Evgeniy, as Lee've already guessed it is (vlax-put 'Coordinates ...) that issues the error.

Lee Mac

  • Seagull
  • Posts: 12254
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #65 on: September 28, 2009, 06:40:17 PM »
Evgeniy, as Lee've already guessed it is (vlax-put 'Coordinates ...) that issues the error.

My code seems to work fine when testing, but I have had issues with that in the past.  :-(

VovKa

  • Swamp Rat
  • Posts: 1144
  • Ukraine
Re: (Challenge) To draw the shortest lwpolyline
« Reply #66 on: September 29, 2009, 11:35:05 AM »
By the way, I am not assured, that my result the shortest!
i think it's time to post your code, Evgeniy.
i've tested Lee's a bit, and sometimes it's mistaken.
so, seeing your code is essential :)

Lee Mac

  • Seagull
  • Posts: 12254
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #67 on: September 29, 2009, 01:56:49 PM »
I think so too  8-)

Mine is messy with all the alterations I've made to it  :oops:

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1540
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #68 on: September 29, 2009, 02:22:33 PM »
I think so too  8-)

Mine is messy with all the alterations I've made to it  :oops:

Well, tomorrow I will show the code

i think it's time to post your code, Evgeniy.
i've tested Lee's a bit, and sometimes it's mistaken.
so, seeing your code is essential :)

Where your variant?  :police:
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

Lee Mac

  • Seagull
  • Posts: 12254
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #69 on: September 29, 2009, 05:34:54 PM »
Quote
Where your variant?  :police:

Hehe cheeky  ^-^

VovKa

  • Swamp Rat
  • Posts: 1144
  • Ukraine
Re: (Challenge) To draw the shortest lwpolyline
« Reply #70 on: September 29, 2009, 06:06:54 PM »
Where your variant?  :police:
come on, i remember you saying that you're not interested in a bruteforce solution? :)
ok, here i go
Code: [Select]
(defun vk_GetPerimeter (CoordsList)
(apply '+
(mapcar (function (lambda (p1 p2) (distance p1 p2)))
CoordsList
(cons (last CoordsList) CoordsList)
)
)
       )
       (defun vk_GetPermutations (lst)
(if (cdr lst)
   (apply 'append
  (mapcar (function (lambda (e1)
      (mapcar (function (lambda (e2) (cons e1 e2)))
      (vk_GetPermutations (vl-remove e1 lst))
      )
    )
  )
  lst
  )
   )
   (list lst)
)
       )
       (defun mkPoly (lst / mlst mdst dst)
(setq lst  (vk_GetPermutations lst)
       mlst (car lst)
       mdst (vk_GetPerimeter mlst)
)
(foreach chain (cdr lst)
   (if (< (setq dst (vk_GetPerimeter chain)) mdst)
     (setq mdst dst
   mlst chain
     )
   )
)
mlst
       )
as any bruteforce attack it is one hundred percent foolproof and one billion percent slow :)
don't even try it on lists longer than 10 points

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1540
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #71 on: September 30, 2009, 08:42:34 AM »
Code: [Select]
(test lst-b) =>> "Polyline Length: 2521.6043 mm."
Code: [Select]
(defun test (l / D D1 E ENT EP LL LS P)
 (setq ll  (list (apply (function mapcar) (cons (function min) l))
                 (apply (function mapcar) (cons (function max) l))
           ) ;_  append
       ll  (list (car ll) (list (caadr ll) (cadar ll)) (cadr ll) (list (caar ll) (cadadr ll)))
       ent (entmakex (append (list '(0 . "LWPOLYLINE")
                                   '(100 . "AcDbEntity")
                                   '(8 . "temp")
                                   '(62 . 1)
                                   '(100 . "AcDbPolyline")
                                   (cons 90 (length l))
                                   '(70 . 1)
                             ) ;_  list
                             (mapcar (function (lambda (a) (cons 10 a))) ll)
                     ) ;_  append
           ) ;_  entmakex
       l   (mapcar
            (function cddr)
            (vl-sort
             (mapcar (Function (lambda (a / b)
                                (cons (distance a (setq b (vlax-curve-getClosestPointTo ent a)))
                                      (cons (vlax-curve-getParamAtPoint ent b) a)
                                ) ;_  cons
                               ) ;_  lambda
                     ) ;_  Function
                     l
             ) ;_  mapcar
             (function (lambda (a b)
                        (if (equal (car a) (car b) 1)
                         (<= (cadr a) (cadr b))
                         (< (car a) (car b))
                        ) ;_  if
                       ) ;_  lambda
             ) ;_  function
            ) ;_  vl-sort
           ) ;_  mapcar
       ls  l
 ) ;_  setq
 (foreach a ll (setq ls (vl-remove a ls)))
 (foreach a ls
  (setq p (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent a))
        p (if (zerop (rem p 1.))
           (if (zerop p)
            (vlax-curve-getEndParam ent)
            (1- p)
           ) ;_  if
           (fix p)
          ) ;_  if
        p (vlax-curve-getPointAtParam ent p)
        p (list 10 (car p) (cadr p))
  ) ;_  setq
  (entmod (append (reverse (member p (reverse (entget ent))))
                  (list (cons 10 a))
                  (cdr (member p (entget ent)))
          ) ;_  append
  ) ;_  entmod
 ) ;_  foreach
 (foreach a l (setq ll (vl-remove a ll)))
 (entmod (vl-remove-if (function (lambda (a) (member (cdr a) ll))) (entget ent)))
 (setq l  (mapcar (function cdr)
                  (vl-remove-if-not (function (lambda (a) (= (car a) 10))) (entget ent))
          ) ;_  mapcar
       l  (mapcar (function list) (cons (last l) l) l)
       ep (length l)
 ) ;_  setq
 (foreach a l
  (setq e (entget ent)
        d (vlax-curve-getDistAtParam ent ep)
  ) ;_  setq
  (entmod (vl-remove (cons 10 (car a)) (vl-remove (cons 10 (cadr a)) e)))
  (setq p (vlax-curve-getPointAtParam
           ent
           (fix (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent (car a))))
          ) ;_  vlax-curve-getPointAtParam
        p (list 10 (car p) (cadr p))
  ) ;_  setq ;_  setq
  (entmod (append (reverse (member p (reverse (entget ent))))
                  (list (cons 10 (car a)))
                  (cdr (member p (entget ent)))
          ) ;_  append
  ) ;_  entmod
  (setq p (vlax-curve-getPointAtParam
           ent
           (fix (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent (cadr a))))
          ) ;_  vlax-curve-getPointAtParam
        p (list 10 (car p) (cadr p))
  ) ;_  setq
  (entmod (append (reverse (member p (reverse (entget ent))))
                  (list (cons 10 (cadr a)))
                  (cdr (member p (entget ent)))
          ) ;_  append
  ) ;_  entmod
  (if (<= d (setq d1 (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))))
   (entmod e)
   (setq d d1
         e (entget ent)
   ) ;_  setq
  ) ;_  if
  (entmod (vl-remove (cons 10 (car a)) (vl-remove (cons 10 (cadr a)) e)))
  (setq p (vlax-curve-getPointAtParam
           ent
           (fix (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent (cadr a))))
          ) ;_  vlax-curve-getPointAtParam
        p (list 10 (car p) (cadr p))
  ) ;_  setq
  (entmod (append (reverse (member p (reverse (entget ent))))
                  (list (cons 10 (cadr a)))
                  (cdr (member p (entget ent)))
          ) ;_  append
  ) ;_  entmod
  (setq p (vlax-curve-getPointAtParam
           ent
           (fix (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent (car a))))
          ) ;_  vlax-curve-getPointAtParam
        p (list 10 (car p) (cadr p))
  ) ;_  setq
  (entmod (append (reverse (member p (reverse (entget ent))))
                  (list (cons 10 (car a)))
                  (cdr (member p (entget ent)))
          ) ;_  append
  ) ;_  entmod
  (if (<= d (setq d1 (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))))
   (entmod e)
   (setq d d1
         e (entget ent)
   ) ;_  setq
  ) ;_  if
 ) ;_  foreach
 (princ (strcat "\nPolyline Length: " (rtos d 2 4) " mm."))
 (princ)
)
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

Lee Mac

  • Seagull
  • Posts: 12254
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #72 on: September 30, 2009, 08:53:27 AM »
Nice code - works well for lst-b, but you get a freaky result for lst-a  :lol:

I haven't studied your code in depth yet Elpanov, but I shall look at how you changed the points - I think the entmod method is much more reliable than vlax-put...


ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1540
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #73 on: September 30, 2009, 08:56:25 AM »
Nice code - works well for lst-b, but you get a freaky result for lst-a  :lol:

I haven't studied your code in depth yet Elpanov, but I shall look at how you changed the points - I think the entmod method is much more reliable than vlax-put...


For lst-a at me other code...
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1540
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #74 on: September 30, 2009, 09:26:00 AM »
Code: [Select]
(test lst-a) =>> "Polyline Length: 3709.0142 mm."
Code: [Select]
(defun test (l / A B D E LL P PL)
   (setq p  (car l)
         pl (list p)
         l  (cdr l)
   ) ;_  setq
   (while l
    (setq b (car l)
          d (distance p (car l))
    ) ;_  setq
    (foreach a l
     (if (<= (setq e (distance p a)) d)
      (setq b a
            d e
      ) ;_  setq
     ) ;_  if
    ) ;_  foreach
    (setq pl (cons b pl)
          l  (vl-remove b l)
          p  b
          b  (car l)
    ) ;_  setq
   ) ;_  while
   (setq e  nil
         l  pl
         ll l
   ) ;_  setq
   (while (and (not e) ll)
    (setq e  t
          ll l
    ) ;_  setq
    (while (and e ll)
     (setq ll (if (listp (caar ll))
               ll
               (mapcar (function list) (cons (last ll) ll) ll)
              ) ;_  if
           a  (car ll)
           pl (vl-remove-if (function (lambda (b) (or (member (car a) b) (member (cadr a) b))))
                            (cdr ll)
              ) ;_  vl-remove-if
           ll (cdr ll)
     ) ;_  setq
     (while (and pl (setq b (car pl)) (not (inters (car a) (cadr a) (car b) (cadr b))))
      (setq pl (cdr pl))
     ) ;_  while
     (if pl
      (progn (setq l (append (member (car a) l) (reverse (cdr (member (car a) (reverse l)))))
                   l (append (list (car a)) (member (car b) (reverse (cdr l))) (member (cadr b) l))
                   e nil
             ) ;_  setq
      ) ;_  progn
     ) ;_  if
    ) ;_  while
   ) ;_  while
   (setq e (entmakex (append (list '(0 . "LWPOLYLINE")
                                   '(100 . "AcDbEntity")
                                   '(8 . "temp")
                                   '(62 . 1)
                                   '(100 . "AcDbPolyline")
                                   (cons 90 (length l))
                                   '(70 . 1)
                             ) ;_  list
                             (mapcar (function (lambda (a) (cons 10 a))) l)
                     ) ;_  append
           ) ;_  entmakex
   ) ;_  setq
   (princ (strcat "\nPolyline Length: "
                  (rtos (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) 2 4)
                  " mm."
          ) ;_  strcat
   ) ;_  princ
   (princ)
  )
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/