### Author Topic: -={Challenge}=- a way through a labyrinth  (Read 10380 times)

0 Members and 1 Guest are viewing this topic.

#### mjfarrell

• Seagull
• Posts: 14441
• Every Student their own Lesson
##### Re: -={Challenge}=- a way through a labyrinth
« Reply #30 on: November 21, 2009, 11:02:34 AM »
interesting possible application to using this to program a tool(s) optimum cutting path....

what if the labyrinth were 3D?

crazy good work and interesting to watch the evolution!
Be your Best

Michael Farrell
http://primeservicesglobal.com/

#### Andrea

• Water Moccasin
• Posts: 2360
##### Re: -={Challenge}=- a way through a labyrinth
« Reply #31 on: November 21, 2009, 02:26:16 PM »
here's my new one..

Code: [Select]
`;| ;; FINDWAY in LABYRINTH ;; by: Andrea Andreetti nov. 20 2009 ;; |;(defun c:lab (/ p1)  (setq bpx nil)  (setq p1 (getpoint))  (setq sp (polar p1 2.35619 0.7071))  (setq bp1 p1)  (setq walllist nil) (setq l '( ( 1 1 1 1 1 0 2 0)  ( 0 0 1 0 1 1 1 0)  (-1 0 1 0 0 0 1 1)  ( 1 0 0 0 1 0 0 1)  ( 1 1 0 0 1 0 0 1)  ( 0 1 0 1 1 1 1 1)  ( 0 1 1 1 0 0 1 0)  ( 0 1 0 0 0 0 1 0) ))  ;;;  (setq l '((2 0 1 1 1 1 1 1 1 0 1 0 0 1 1 1);;;            (1 0 1 0 0 0 1 0 1 1 1 1 1 1 1 1);;;            (1 0 1 0 1 0 1 0 0 0 1 0 0 0 0 0);;;            (1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1);;;            (1 1 1 1 0 0 0 1 0 0 0 0 0 0 0 1);;;            (1 0 0 0 0 1 0 1 1 1 0 1 1 0 1 1);;;            (1 1 1 1 0 1 0 1 0 1 0 1 1 0 1 0);;;            (0 0 1 0 0 1 0 0 0 1 0 1 1 1 1 1);;;            (1 0 1 1 0 1 1 1 1 1 1 1 0 0 0 1);;;            (1 1 1 1 1 1 0 1 0 0 0 0 0 1 1 -1);;;           );;;  )  (labyrinth l p1)  (command "._rectang" "_non" sp "_non" lr))(defun labyrinth (lst p1)  (setq points nil)  (foreach n lst    (foreach x n      (setq points (append points (list p1)))      (if (= x 0)        (cube 0 p1)      )      (if (= x 2)        (progn          (setq _start p1)          (cube 2 p1)        )      )      (if (= x -1)        (progn          (setq _end p1)          (cube -1 p1)        )      )      (setq p1 (list (+ (car p1) 1.0) (cadr p1) (caddr p1)))    )    (setq p1 (list (car bp1) (- (cadr p1) 1.0) (caddr p1)))  ))(defun cube (value point / ul w1 w10 w11 w40 w73 w72)  (setq ul (polar point 2.35619 0.7071)        lr (polar point 5.49779 0.7071)  )  (if (not bpx)    (setq bpx ul)  )  (setq bp2 point)  (if (eq value 0)    (progn (command "._rectang" "_non" ul "_non" lr)           (setq walllist (append walllist (list point)))    )  )  (if (eq value 2)    (progn    (setq w1  "{\\fArial|b0|i0|c0|p34;\\C1;S}"          w10 _start          w11 _start    )    (setq Start-T (createMT w1 w10 w11))    )  )  (if (eq value -1)    (progn    (setq w1  "{\\fArial|b0|i0|c0|p34;\\C3;E}"          w10 _end          w11 _end     )    (setq End-T (createMT w1 w10 w11))    )  ))(defun createMT (w1 w10 w11)    (if (and w1 w10 w11 )    (entmakex (list (cons 0 "MTEXT")                                (cons 100 "AcDbEntity")                                (cons 100 "AcDbMText")                                (cons 1 w1)                                (cons 10 w10)                                (cons 11 w11)                                (cons 40 0.5)                                '(50 . 0.0)                                '(71 . 5)                                '(72 . 5)                                '(73 . 1)                                                          )                )    )  )(defun c:findway (/ nlstx nlst nextpoints _start _end dn)  (vl-load-com)  (vla-startundomark    (vla-get-activedocument (vlax-get-acad-object))  )  (setq nlstx nil        nlst nil        nextpoints nil  )  (setq _startx (cdr (assoc 10 (entget start-t))))  (setq dn (distance _startx (car points)))  (setq _start (car points))  (foreach n (cdr points)    (if (< (distance _startx n) dn)      (progn (setq dn (distance _startx n)) (setq _start n))    )  )  (setq _endx (cdr (assoc 10 (entget end-t))))  (setq dn (distance _endx (car points)))  (setq _end (car points))  (foreach n (cdr points)    (if (< (distance _endx n) dn)      (progn (setq dn (distance _endx n)) (setq _end n))    )  )  (way (list _start) walllist)  (foreach j nlstx (command "_point" j))  (vla-endundomark    (vla-get-activedocument (vlax-get-acad-object))  ))(defun way (nlst blst)    (setq rnlst (car (reverse nlst)))  (setq nextpoints (list (list (car rnlst) (1+ (cadr rnlst)) (caddr rnlst))                         (list (car rnlst) (1- (cadr rnlst)) (caddr rnlst))                         (list (1+ (car rnlst)) (cadr rnlst) (caddr rnlst))                         (list (1- (car rnlst)) (cadr rnlst) (caddr rnlst))                   )  )  (foreach n nextpoints    (if (eq (vl-princ-to-string n) (vl-princ-to-string _end))      (setq nlstx (append nlst (list _end)))    )    (if (and (> (car n) (car sp))             (< (car n) (car lr))             (> (cadr n) (cadr lr))             (< (cadr n) (cadr sp))             (not (member n blst))             (not (member n nlst))        )      (way (append nlst (list n)) walllist)    )  ))`

Keep smile...

#### Lee Mac

• Seagull
• Posts: 12226
• London, England
##### Re: -={Challenge}=- a way through a labyrinth
« Reply #32 on: November 21, 2009, 03:31:46 PM »
I just like to watch it

#### Kerry

• Mesozoic relic
• Seagull
• Posts: 11654
• class keyThumper<T>:ILazy<T>
##### Re: -={Challenge}=- a way through a labyrinth
« Reply #33 on: November 21, 2009, 11:54:19 PM »
Very nice Kerry!

This uses the "Dead-End Filling" algorithm... { but doesn't like voids...   }

< .... >

Thanks Lee ..

I had a look at the filling algorithm ... there are actually a few interesting options.

Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

#### Kerry

• Mesozoic relic
• Seagull
• Posts: 11654
• class keyThumper<T>:ILazy<T>
##### Re: -={Challenge}=- a way through a labyrinth
« Reply #34 on: November 21, 2009, 11:59:41 PM »
Andrea,

I didn't run your code .. just had a look at the source.

I think you need to devise a method to eliminate superfluous cells in your path list.

Regards
Kerry

Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

#### Lee Mac

• Seagull
• Posts: 12226
• London, England
##### Re: -={Challenge}=- a way through a labyrinth
« Reply #35 on: November 22, 2009, 07:24:12 AM »
Very nice Kerry!

This uses the "Dead-End Filling" algorithm... { but doesn't like voids...   }

< .... >

Thanks Lee ..

I had a look at the filling algorithm ... there are actually a few interesting options.

It seems to produce good results for a "simple" maze, but it will fail with loops and voids - I'm trying to figure out a way to detect loops and such, but it seems impossible using my current methods.

#### wizman

• Bull Frog
• Posts: 224
##### Re: -={Challenge}=- a way through a labyrinth
« Reply #36 on: November 22, 2009, 08:30:31 PM »
Good Thread Guys
interesting possible application to using this to program a tool(s) optimum cutting path....

what if the labyrinth were 3D?

crazy good work and interesting to watch the evolution!

i remember seeing this on jtb:http://blog.jtbworld.com/2009/02/space-filling-curves-in-theory-and.html

#### Kerry

• Mesozoic relic
• Seagull
• Posts: 11654
• class keyThumper<T>:ILazy<T>
##### Re: -={Challenge}=- a way through a labyrinth
« Reply #37 on: November 22, 2009, 11:36:41 PM »
interesting possible application to using this to program a tool(s) optimum cutting path....

what if the labyrinth were 3D?

crazy good work and interesting to watch the evolution!

I don't see the relationship between this and a cutting path optimiser ... care to elucidate ?

3d would be possible but I'd need an incentive
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

#### mjfarrell

• Seagull
• Posts: 14441
• Every Student their own Lesson
##### Re: -={Challenge}=- a way through a labyrinth
« Reply #38 on: November 23, 2009, 12:43:41 PM »
interesting possible application to using this to program a tool(s) optimum cutting path....

what if the labyrinth were 3D?

crazy good work and interesting to watch the evolution!

I don't see the relationship between this and a cutting path optimiser ... care to elucidate ?

3d would be possible but I'd need an incentive

From my perspective a tool path is much like a maze, only the goal is to remove material, and leave some behind; this seems like it would adapt to that purpose.
Be your Best

Michael Farrell
http://primeservicesglobal.com/

#### Lee Mac

• Seagull
• Posts: 12226
• London, England
##### Re: -={Challenge}=- a way through a labyrinth
« Reply #39 on: November 23, 2009, 01:27:48 PM »
Good Thread Guys
interesting possible application to using this to program a tool(s) optimum cutting path....

what if the labyrinth were 3D?

crazy good work and interesting to watch the evolution!

i remember seeing this on jtb:http://blog.jtbworld.com/2009/02/space-filling-curves-in-theory-and.html

Reminds me of:

http://www.theswamp.org/index.php?topic=30966.0

#### VovKa

• Swamp Rat
• Posts: 1099
• Ukraine
##### Re: -={Challenge}=- a way through a labyrinth
« Reply #40 on: November 23, 2009, 04:18:56 PM »
let Autodesk Map guys do the job
Code: [Select]
`(vl-load-com)(defun SolveLabyrinth       (SS StartPoint EndPoint / VariablesID TopologyName TopologyID TraceID Path)  (setq TopologyName "SolveLabyrinth")  (if (and (setq VariablesID (tpm_varalloc))    (tpm_varset VariablesID "CREATE_NODE" 0)    (tpm_mntbuild VariablesID TopologyName "" 2 nil SS)    (tpm_varfree VariablesID)    (setq TopologyID (tpm_acopen TopologyName nil))    (setq TraceID (tpm_tracealloc TopologyID))    (tpm_traceshort TraceID    (tpm_elemfind TopologyID 1 StartPoint)    (tpm_elemfind TopologyID 1 EndPoint)    )      )    (while (and (tpm_traceshortscan TraceID 3) (tpm_traceshortscan TraceID 3))      (setq Path      (cons        (entget (cdr (assoc -2 (tpm_elemget TopologyID (tpm_traceshortscan TraceID 0))))        )        Path      )      )    )  )  (tpm_tracefree TraceID)  (tpm_acclose TopologyID)  (tpm_mnterase TopologyName)  Path)(defun test (lst / SS StartPoint EndPoint lst y x Step)  (setq Step 10.0 SS   (ssadd) y    0  )  (mapcar (function     (lambda (r nr)       (setq x 0)       (mapcar (function (lambda (rc rnc nrc / p)   (setq p (list (* x Step) (* y Step)))   (if (and (not (zerop (* rc rnc))) (< (1+ x) (length r)))     (ssadd (entmakex (list (cons 0 "LINE")    (cons 10 p)    (list 11 (* (1+ x) Step) (* y Step))      )    )    SS     )   )   (if (and (not (zerop (* rc nrc))) (< (1+ (abs y)) (length lst)))     (ssadd (entmakex (list (cons 0 "LINE")    (cons 10 p)    (list 11 (* x Step) (* (1- y) Step))      )    )    SS     )   )   (cond ((= rc 2) (setq StartPoint p)) ((= rc -1) (setq EndPoint p))   )   (setq x (1+ x)) )       )       r       (append (cdr r) (list (car r)))       nr       )       (setq y (1- y))     )   )   lst   (append (cdr lst) (list (car lst)))  )  (if (and SS    (or StartPoint (setq StartPoint (getpoint "\nEntrance: ")))    (or EndPoint (setq EndPoint (getpoint StartPoint "\nExit: ")))      )    (foreach Ent (SolveLabyrinth SS StartPoint EndPoint)      (vla-put-Color (vlax-ename->vla-object (entmakex Ent)) 3)    )  ))(setq l '((2 0 1 1 1 1 1 1 1 0)          (1 0 1 0 0 0 1 0 1 1)          (1 0 1 0 1 0 1 0 0 0)          (1 0 1 1 1 0 1 1 0 1)          (1 1 1 1 0 0 0 1 0 1)          (1 0 0 0 0 1 0 1 1 1)          (1 1 1 1 0 1 0 1 0 1)          (0 0 1 0 0 1 0 0 0 1)          (1 0 1 1 0 1 1 1 0 1)          (1 1 1 1 1 1 0 1 0 -1)         ))(test l)`