Welcome,
Guest
. Please
login
or
register
.
1 Hour
1 Day
1 Week
1 Month
Forever
Login with username, password and session length
News:
Home
Help
Login
Register
TheSwamp
»
Code Red
»
AutoLISP (Vanilla / Visual)
»
Topic:
Shortest Path between two points on grid and cover all points
« previous
next »
Print
Pages:
1
[
2
]
All
|
Go Down
Author
Topic: Shortest Path between two points on grid and cover all points (Read 11892 times)
0 Members and 1 Guest are viewing this topic.
ribarm
Gator
Posts: 3263
Marko Ribar, architect
WWW
Re: Shortest Path between two points on grid and cover all points
«
Reply #15 on:
January 04, 2019, 05:03:45 AM »
My latest revision according to newly posted code for 2D TSP topic started by Evgeniy Elpanov...
Code - Auto/Visual Lisp:
[Select]
(
defun
c:TSP
-
2D
-
MR
-
START
-
END
(
/
car
-
sort plstdiff processrs ss ti i pl pln k plp pld pll d r rr ppp lil lii1 lii2 lil1 lil2 lil3 ip f kk n
)
;;; (car-sort '(2 4 1 3 5 1) '<) => nil
;;; (car-sort '(2 4 1 3 5 1) '<=) => 1
(
defun
car
-
sort
(
l f
/
removenth r k
)
(
defun
removenth
(
l n
/
k
)
(
setq
k
-
1
)
(
vl
-
remove
-
if
(
function
(
lambda
(
x
)
(
=
(
setq
k
(
1+
k
)
)
n
)
)
)
l
)
)
(
setq
k
-
1
)
(
vl-some
(
function
(
lambda
(
a
)
(
setq
k
(
1+
k
)
)
(
if
(
vl-every
(
function
(
lambda
(
x
)
(
apply
f
(
list
a x
)
)
)
)
(
removenth l k
)
)
(
setq
r a
)
)
)
)
l
)
r
)
(
defun
plstdiff
(
l1 l2
)
(
foreach
p l1
(
setq
l2
(
vl-remove
p l2
)
)
)
l2
)
(
defun
processrs
(
r
/
rr
)
(
foreach
xx r
(
if
(
and
(
null
f
)
(
if
(
equal
xx pln
)
(
setq
ppp pl
)
(
setq
ppp
(
plstdiff xx pl
)
)
)
)
(
foreach
p ppp
(
setq
k
-
1
)
(
repeat
(
1-
(
length
xx
)
)
(
setq
k
(
1+
k
)
)
(
setq
plp
(
reverse
(
member
(
nth
k xx
)
(
reverse
xx
)
)
)
)
(
setq
pls
(
cdr
(
member
(
nth
k xx
)
xx
)
)
)
(
setq
pll
(
append
plp
(
list
p
)
pls
)
)
(
setq
rr
(
cons
pll rr
)
)
)
)
(
setq
f t
)
)
)
(
if
f
(
progn
(
setq
pl
nil
)
r
)
(
if
(
=
kk n
)
(
progn
(
setq
kk
0
)
(
setq
rr
(
mapcar
(
function
(
lambda
(
x
)
(
list
(
apply
(
function
+
)
(
mapcar
(
function
(
lambda
(
a b
)
(
distance
a b
)
)
)
x
(
cdr
x
)
)
)
x
)
)
)
rr
)
)
(
setq
rr
(
list
(
cadr
(
car
-
sort rr
(
function
(
lambda
(
a b
)
(
<=
(
car
a
)
(
car
b
)
)
)
)
)
)
)
)
)
rr
)
)
)
(
setq
ss
(
ssget
'
(
(
0
.
"POINT"
)
)
)
)
(
repeat
(
setq
i
(
sslength
ss
)
)
(
setq
pl
(
cons
(
mapcar
(
function
+
)
'
(
0
0
)
(
cdr
(
assoc
10
(
entget
(
ssname
ss
(
setq
i
(
1-
i
)
)
)
)
)
)
)
pl
)
)
)
(
initget
1
)
(
setq
sp
(
mapcar
(
function
+
)
'
(
0
0
)
(
trans
(
getpoint
"
\n
Start/end point from selection set : "
)
1
0
)
)
)
(
initget
1
)
(
setq
ep
(
mapcar
(
function
+
)
'
(
0
0
)
(
trans
(
getpoint
"
\n
End/start point from selection set : "
)
1
0
)
)
)
(
initget
6
)
(
setq
n
(
getint
"
\n
Specify speed factor - reliability - [1-fast/2-slow] <1> : "
)
)
(
if
(
null
n
)
(
setq
n
1
)
)
(
setq
ti
(
car
(
_vl-times
)
)
)
(
setq
pln
(
list
sp ep
)
)
(
setq
pl
(
vl-remove
sp pl
)
pl
(
vl-remove
ep pl
)
)
(
setq
kk
0
)
(
while
pl
(
setq
kk
(
1+
kk
)
)
(
if
(
null
rr
)
(
setq
rr
(
processrs
(
list
pln
)
)
)
(
setq
rr
(
processrs rr
)
)
)
)
(
setq
rr
(
mapcar
(
function
(
lambda
(
x
)
(
list
(
apply
(
function
+
)
(
mapcar
(
function
(
lambda
(
a b
)
(
distance
a b
)
)
)
x
(
cdr
x
)
)
)
x
)
)
)
rr
)
)
(
setq
pln
(
cadr
(
car
-
sort rr
(
function
(
lambda
(
a b
)
(
<=
(
car
a
)
(
car
b
)
)
)
)
)
)
)
(
setq
lil
(
mapcar
(
function
(
lambda
(
a b
)
(
list
a b
)
)
)
pln
(
cdr
pln
)
)
)
(
while
(
vl-some
(
function
(
lambda
(
li1
)
(
vl-some
(
function
(
lambda
(
li2
)
(
if
(
and
(
setq
ip
(
inters
(
car
li1
)
(
cadr
li1
)
(
car
li2
)
(
cadr
li2
)
)
)
(
not
(
equal
ip
(
car
li1
)
1e
-
8
)
)
(
not
(
equal
ip
(
cadr
li1
)
1e
-
8
)
)
(
not
(
equal
ip
(
car
li2
)
1e
-
8
)
)
(
not
(
equal
ip
(
cadr
li2
)
1e
-
8
)
)
)
(
setq
lii1 li1 lii2 li2
)
)
)
)
(
vl-remove
li1 lil
)
)
)
)
lil
)
(
if
(
>
(
vl-position
lii1 lil
)
(
vl-position
lii2 lil
)
)
(
mapcar
(
function
set
)
'
(
lii1 lii2
)
(
list
lii2 lii1
)
)
)
(
setq
lil1
(
reverse
(
cdr
(
member
lii1
(
reverse
lil
)
)
)
)
)
(
setq
lil2
(
cdr
(
member
lii2
(
reverse
(
cdr
(
member
lii1 lil
)
)
)
)
)
)
(
setq
lil3
(
cdr
(
member
lii2 lil
)
)
)
(
setq
lil
(
append
lil1
(
list
(
list
(
car
lii1
)
(
car
lii2
)
)
)
(
mapcar
(
function
reverse
)
lil2
)
(
list
(
list
(
cadr
lii1
)
(
cadr
lii2
)
)
)
lil3
)
)
)
(
setq
pln
(
append
(
mapcar
(
function
car
)
lil
)
(
list
(
cadr
(
last
lil
)
)
)
)
)
(
setq
d
(
apply
(
function
+
)
(
mapcar
(
function
(
lambda
(
a b
)
(
distance
a b
)
)
)
pln
(
cdr
pln
)
)
)
)
(
entmake
(
append
(
list
'
(
0
.
"LWPOLYLINE"
)
'
(
100
.
"AcDbEntity"
)
'
(
100
.
"AcDbPolyline"
)
(
cons
90
(
length
pln
)
)
(
cons
70
(
*
(
getvar
'plinegen
)
128
)
)
'
(
38
.
0.0
)
)
(
mapcar
(
function
(
lambda
(
x
)
(
cons
10
x
)
)
)
pln
)
(
list
'
(
210
0.0
0.0
1.0
)
'
(
62
.
1
)
)
)
)
(
prompt
"
\n
Distance : "
)
(
princ
(
rtos
d
2
50
)
)
(
prompt
"
\n
Elapsed time : "
)
(
princ
(
rtos
(
/
(
-
(
car
(
_vl-times
)
)
ti
)
1000.0
)
2
50
)
)
(
prompt
" seconds..."
)
(
princ
)
)
Regards, M.R.
«
Last Edit: January 04, 2019, 09:51:39 AM by ribarm
»
Logged
Marko Ribar, d.i.a.
(graduated engineer of architecture)
M.R. on Youtube
ahsattarian
Newt
Posts: 112
Re: Shortest Path between two points on grid and cover all points
«
Reply #16 on:
December 16, 2020, 01:54:59 AM »
This Helps U :
Code - Auto/Visual Lisp:
[Select]
(
defun
c:tsp
(
)
(
setq
ss
(
ssget
'
(
(
0
.
"point"
)
)
)
)
(
cond
(
(
<
(
sslength
ss
)
2
)
(
exit
)
)
)
(
setq
li1
nil
)
(
setq
li2
nil
)
(
setq
k
-
1
)
(
setq
n
(
sslength
ss
)
)
(
repeat
n
(
setq
k
(
1+
k
)
)
(
setq
s
(
ssname
ss k
)
)
(
setq
en
(
entget
s
)
)
(
setq
po
(
cdr
(
assoc
10
en
)
)
)
(
if
(
<
k
3
)
(
setq
li1
(
append
(
list
po
)
li1
)
)
(
setq
li2
(
append
(
list
po
)
li2
)
)
)
)
(
foreach
po li2
(
setq
lii
nil
)
(
setq
k
-
1
)
(
setq
n
(
length
li1
)
)
(
repeat
n
(
setq
k
(
1+
k
)
)
(
setq
po1
(
nth
k li1
)
)
(
if
(
/=
k
(
1-
(
length
li1
)
)
)
(
setq
po2
(
nth
(
1+
k
)
li1
)
)
(
progn
(
setq
po1
(
nth
0
li1
)
)
(
setq
po2
(
nth
(
1-
(
length
li1
)
)
li1
)
)
)
)
(
setq
lii
(
append
(
list
(
list
po1 po po2
)
)
lii
)
)
)
(
setq
dili
nil
)
(
foreach
a lii
(
setq
po1
(
nth
0
a
)
)
(
setq
po2
(
nth
1
a
)
)
(
setq
po3
(
nth
2
a
)
)
(
setq
d12
(
distance
po1 po2
)
)
(
setq
d23
(
distance
po2 po3
)
)
(
setq
d13
(
distance
po1 po3
)
)
(
setq
di
(
-
(
+
d12 d23
)
d13
)
)
(
setq
dili
(
append
(
list
di
)
dili
)
)
)
(
setq
dimin
(
apply
'
min
dili
)
)
(
setq
k
0
)
(
while
(
<
k
(
length
dili
)
)
(
cond
(
(
=
dimin
(
nth
k dili
)
)
(
setq
i k
)
(
setq
k
(
length
dili
)
)
)
)
(
setq
k
(
1+
k
)
)
)
(
setq
li3
nil
)
(
setq
ii
(
1+
i
)
)
(
if
(
<
ii
(
length
li1
)
)
(
progn
(
setq
k
0
)
(
setq
flag
0
)
(
while
(
<
k
(
length
li1
)
)
(
if
(
and
(
=
k ii
)
(
=
flag
0
)
)
(
progn
(
setq
li3
(
append
(
list
po
)
li3
)
)
(
setq
flag
1
)
)
(
progn
(
setq
li3
(
append
(
list
(
nth
k li1
)
)
li3
)
)
(
setq
k
(
1+
k
)
)
)
)
)
)
(
setq
li3
(
append
(
list
po
)
li1
)
)
)
(
setq
li1 li3
)
)
(
command
"pline"
)
(
foreach
po li1
(
command
po
)
)
(
command
"close"
)
(
princ
)
)
Logged
Print
Pages:
1
[
2
]
All
|
Go Up
« previous
next »
TheSwamp
»
Code Red
»
AutoLISP (Vanilla / Visual)
»
Topic:
Shortest Path between two points on grid and cover all points
Author
Topic: Shortest Path between two points on grid and cover all points (Read 11892 times)
