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

0 Members and 1 Guest are viewing this topic.

#### mjfarrell

• Seagull
• Posts: 14442
• 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!

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)
)
)
)
)
)

(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)
(vla-startundomark
)
(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
)
)

(defun way (nlst blst)
(setq rnlst (car (reverse nlst)))
)
)
(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))
(not (member n blst))
(not (member n nlst))
)
(way (append nlst (list n)) walllist)
)
)
)

Keep smile...

#### Lee Mac

• Seagull
• Posts: 12255
• 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: 12255
• 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 »
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: 14442
• 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.

Michael Farrell
http://primeservicesglobal.com/

#### Lee Mac

• Seagull
• Posts: 12255
• London, England
##### Re: -={Challenge}=- a way through a labyrinth
« Reply #39 on: November 23, 2009, 01:27:48 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 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: 1144
• 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]
(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
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)