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

0 Members and 1 Guest are viewing this topic.

#### ribarm

• Gator
• Posts: 3187
• Marko Ribar, architect
##### Re: (Challenge) To draw the shortest lwpolyline
« Reply #195 on: July 28, 2022, 08:12:47 AM »
Here is my revision for sphere body aspect...
Still it needs further debugging, but it's much better now then before... It should work faster and you can go and above 10 pts, but I am usually doing 10 and it may crash even then sometimes...

Regards, M.R.
« Last Edit: July 30, 2022, 08:31:59 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### ribarm

• Gator
• Posts: 3187
• Marko Ribar, architect
##### Re: (Challenge) To draw the shortest lwpolyline
« Reply #196 on: July 30, 2022, 05:21:14 PM »
TSP - TRANSFORMATION SPHERE POINTS TO 2D PLANAR DIAGRAM

Firstly let's analyze something about SPHERE properties...
Let's say that we know area of sphere which is derived from integral calculus - it goes something if I can recall 2*2R*pi*int(cos x)|0->(pi/2)... When we compute we get 4*R^2*pi...
Now let's analyze something more visual about how equatorial distance shrinks from 2*r*pi to 0 all the way to the poles...
What would you say - it looks familiar to something like when r=R*cos(beta) goes from R to 0 => beta goes from 0 to pi/2; in the same time equatorial distance changes from 2*R*pi to 0, with the same relation as we wrote 2*r*pi...
So we can say it clearly that area of hemisphere is similar to half of ellipse with a=R*pi and b=R*4/pi... Can we assume that area of sphere is 2 areas of those half ellipses representing hemispheres, or just single ellipse area = a*b*pi = R*pi*R*4/pi*pi = 4*R^2*pi...
But can we see from that ellipse real longitude and latitude 2D diagram of points that are graphically identical to 3D sphere body... I don't really know, but it looks that that representation don't fulfill real spherical geometrical properties... Then what picture should be more appropriate... I am guessing something like circle, but with what radius? Let's see : area of circle = R^2*pi and area of sphere = 4*R^2*pi... Let's now say R of sphere is r... So we get R^2*pi=4*r^2*pi... From here we can say 4*r^2=R^2 and we have here R=2*r, so radius of circle is actually diameter of sphere... And that's it... That's the most appropriate picture... But now what? If we randomly place points on sphere what can we say about their transformation to diagram... Firstly for RND points on sphere we can say that the most appropriate representation of adequate coordinate system is not cartezian, but spherical, so we have angle in plane (along Z axis) - alpha and angle in vertical plane of sphere origin and first projection of 3D point - beta, last figure important and constant in relation of sphere origin and 3D point is their distance - R (radius)...
So we can say : pt=R*cos(beta)*cos(alpha),R*cos(beta)*sin(alpha),R*sin(beta)...
And on the 2D diagram we analyzed (r of diagram = 2R), so pt=r/2*cos(beta)*cos(alpha),r/2*cos(beta)*sin(alpha),r/2*sin(beta)...
Now let's analyze 2 RND points on 2D diagram : pt1 and pt2; we can see that :
delta X = abs(r/2*cos(beta1-beta2)*cos(alpha1-alpha2));
delta Y = abs(r/2*cos(beta1-beta2)*sin(alpha1-alpha2));
delta Z = abs(r/2*sin(beta1-beta2));
If we assume that in 2D diagram points represent spherical 3D points, we can say that if we solve TSP in 2D diagram it's not really fulfilling all relations that are correct in terms of areal relation... We can assume that if X axis of 2D diagram represent equatorial circular length, we should say that -X=>+X = 2*R*pi and in 2D diagram -X=>+X = 2*r = (4*R)!... So real 2D representation that is adequate for representing relations are not static, but dynamic; it references rotation along Y axis of 2D diagram in which all points rotate and change their positions assuming that rotational angle is something dynamic and goes from 0 to 2*pi radians... So if we say that 0 rotation is = +X axis, X=R*cos(beta)*cos(0) on sphere and it would be X=r/2*cos(beta)*cos(0) on diagram and if rotation angle is pi/2 then X=(R or r/2)*cos(beta)*cos(pi/2) = 0 [cos(pi/2)=0], meaning somewhere on Y axis points (from (-R or -r/2) to (R or r/2)) and so on, and so on... But when we say Y axis on 2D diagram, we are thinking on Z axis on sphere, so pt=X,Y on 2D diagram is actually pt=r/2*cos(beta)*cos(alpha),r/2*sin(beta) and on sphere already stated pt=X,Y,Z=R*cos(beta)*cos(alpha),R*cos(beta)*sin(alpha),R*sin(beta)...
Now let's see what real distance between 2 points are... D=sqrt[(delta X)^2+(delta Y)^2+(delta Z)^2], but this is somewhat not so elegant for thinking... Firstly, if we know delta elevation between 2 points, we can say that delta Z is dependable from delta beta angle, so delta beta = asin [(delta Z)/R]; now if we know delta beta, we can say delta alpha = acos [R*cos(delta beta)]... Now if we have delta alpha and delta beta, we can have delta gamma which is actually value of real 3D arc length times R... Simply by Pitagora : delta gamma ^2 = delta alpha ^2 + delta beta ^2; delta gamma = sqrt (delta alpha ^2 + delta beta ^2)... 3D arc length = ARC = R*sqrt[{acos[R*cos{asin[(delta Z)/R]}]}^2+{asin[(delta Z)/R]}^2]...
Now let's concentrate on real 2D situation that's not dependable of rotation around Y axis of 2D diagram or Z axis of 3D sphere...
So we have real arc lengths dependable of : gamma1 (p1-p2), gamma2 (p2-p3), gamma3 (p1-p3), ...
Actually we found combinations of all point pairs between each points without repetitions...
(foreach p1 plst
(setq plst (cdr plst))
(foreach p2 plst
(setq p1p2arclenlst (cons (list p1 p2 (arclen p1 p2)) p1p2arclenlst))
)
)
So we map points : p1, p2, p3, ... dependable of 2D triangulation diagram where all arcs lengths are real distances and neither of triangles must not cross previous triangle, or be inside possible larger one (we have 2 solutions of circle-circle intersections for constructing triangulations between 2 points...)...
Possible start p1=0,0; p2=arclen(p1,p2),0; p3=arclen(p1,p3)*cos(a),arclen(p1,p3)*sin(a) = ci(p1,arclen(p1,p3))Xci(p2,arclen(p2,p3)); p4= ci(p1,arclen(p1,p4))Xci(p3,arclen(p3,p4)) or ci(p2,arclen(p2,p4))Xci(p3,arclen(p3,p4)) -- already here we have branching and we must decide which path is better from p1 or p2 --; then for p5 branching through p1-p4 or p3-p4 or through p2-p4 or p3-p4 ...
We solve 2D TSP on triangulation and we remember correct order of point list...
That would be good only if triangulation would satisfy real disposition which would assume that all relations between points are compact and unique... According to branching, that would not be correct, so we still must go through 2D diagram and create rotational dynamic TSP solutions based on sample rotational angle incrementations from 0 to 2*pi radians...
Transformational formula for 3D sphere to 2D diagram is like already stated :
pt=X,Y=r/2*cos(beta)*cos(alpha),r/2*sin(beta); but let's say that rotational angle is theta, so :
pt=X*cos(theta),Y=r/2*cos(theta)*cos(beta)*cos(alpha),r/2*sin(beta)...
Now for theta1, theta2,..., theta11 ; we could have TSP1, TSP2,..., TSP11 with incremental rotational angle of 30 degree...
But could we use real distances for TSP algorithm instead of used (distance) function, something like :
(defun _distance ( p1 p2 / d R ) ;; used bp as lexical global as 3D sphere center ;;
(setq R (distance bp p1))
(setq d (* R (sqrt (+ (expt (acos (* R (cos (asin (/ (abs (cadr (mapcar (function -) p2 p1))) R))))) 2) (expt (asin (/ (abs (cadr (mapcar (function -) p2 p1))) R)) 2)))))
)
and just replace in the code of TSP : "(distance " with "(_distance "...
Finally, what should we do with different TSP mapped point lists if they differ...
Beside this, given the fact that projection have from elevation view of 2D diagram likewise TOP and BACK sides, we could have overlapping points that are opposed to each other... So each TSP solution is TOP+BACK (alpha(0,pi) and alpha(pi,2*pi))...
Final conclusion :
From complexity reasons, 2D TSP is not really useful in terms of transformations from 3D spherical points distribution, further more to dissect even more, when we assume that we dynamically watched rotational dispositions of points along Y axis - corresponding to Z rotation of sphere, we could say that we watched longitudinal section of sphere and we looked points only from projection of Z axis of 2D diagram or some axis in XY plane of 3D sphere; so here we could say that we could have rotational axis from any direction around Z of 2D diagram, meaning infinite number of axises but from only single longitudinal section/elevation plane of view, whereas we could also say that that 2D diagram could have also been viewed from any Y rotational angle of diagram / Z rotational angle of sphere, meaning infinite number of elevations times infinite number of axises of each elevation = infinite^2 number of TSP solutions all with (TOP+BACK) representations of point distributions...
This all is so sad, but true...

So long from me,
Regards, M.R.

[EDIT]
Fooling we around about 2D TSP algorithm, it simply states that just by changing point data from 2D to 3D, we are in condition to solve 3D TSP... Simply we replace Convex Hull with 3D Convex Hull, where we are using TOP projection and FRONT one in case that in first projection (TOP) we have overlappings of points with different elevation...

Now for spherical aspect - we use RND points on sphere, and for intersection checking, we have 2 vectors - 2 tetives of sphere, so we find plane 2 points + origin of sphere, and 2nd plane (similary) => we find vector of intersection of 2 planes with origin as origin of sphere and 2nd point with distance R... So if that line intersect both tetives, then it's crossing and we then continue with reconstructing, by taking 2 shortest tetives and removing 2 originals...

Sincerely, yours, M.R.
[/EDIT]

TSP – TAČKE TRANSFORMACIJE SFERE U 2D PLANARNI DIJAGRAM

Prvo hajde da analiziramo nešto o svojstvima SFERE...
Recimo da znamo površinu sfere koja je izvedena iz integralnog računa - nešto ide ako mogu da se setim 2*2R*pi*int(cos x)|0->(pi/2)... Kada izračunamo dobijamo 4*R^2*pi...
Hajde sada da analiziramo nešto vizuelnije o tome kako se ekvatorijalna udaljenost smanjuje sa 2*r*pi na 0 sve do polova...
Šta biste rekli - izgleda poznato kao kada r=R*cos(beta) ide od R do 0 => beta ide od 0 do pi/2; u isto vreme ekvatorijalna udaljenost se menja sa 2*R*pi na 0, sa istim odnosom kao što smo napisali 2*r*pi...
Dakle, možemo jasno reći da je oblast hemisfere slična polovini elipse sa a=R*pi i b=R*4/pi... Možemo li pretpostaviti da je površina sfere 2 oblasti tih poluelipsi koje predstavljaju hemisfere, ili samo jedna oblast elipse = a*b*pi = R*pi*R*4/pi*pi = 4*R^2*pi...
Ali da li možemo da vidimo iz te elipse stvarnu dužinu i širinu 2D dijagram tačaka koje su grafički identične telu 3D sfere... Ne znam zaista, ali izgleda da taj prikaz ne ispunjava stvarna sferna geometrijska svojstva... Koja bi onda slika bila prikladnija... Pretpostavljam nešto kao krug, ali sa kojim radijusom? Da vidimo: površina kruga = R^2*pi i površina sfere = 4*R^2*pi... Recimo sada da je R sfere r... Dakle, dobijamo R^2*pi=4*r ^2*pi... Odavde možemo reći 4*r^2=R^2 i imamo R=2*r, dakle poluprečnik kruga je zapravo prečnik sfere... I to je to... To je najprikladnija slika... Ali šta sad? Ako nasumično postavimo tačke na sferu, šta možemo reći o njihovoj transformaciji u dijagram...
Sada da vidimo koliko je stvarno rastojanje između 2 tačke... D=sqrt[(delta X)^2+(delta Y)^2+(delta Z)^2], ali ovo donekle nije tako elegantno za razmišljanje. Prvo, ako znamo delta elevaciju između 2 tačke, možemo reći da je delta Z zavisna od delta beta ugla, tako da je delta beta = asin [(delta Z)/R]; sada ako znamo delta beta, možemo reći delta alfa = acos [R*cos(delta beta)]... Sada ako imamo delta alfa i delta beta, možemo imati delta gama što je zapravo vrednost stvarne dužine 3D luka puta R... Jednostavno od Pitagore : delta gama ^2 = delta alfa ^2 + delta beta ^2; delta gama = sqrt (delta alfa ^2 + delta beta ^2)... 3D dužina luka = ARC = R*sqrt[{acos[R*cos{asin[(delta Z)/R]}]}^2+ {asin[(delta Z)/R]}^2]...
Sada hajde da se koncentrišemo na stvarnu 2D situaciju koja ne zavisi od rotacije oko Y ose 2D dijagrama ili Z ose 3D sfere...
Dakle, imamo stvarne dužine luka zavisne od: gamma1 (p1-p2), gamma2 (p2-p3), gamma3 (p1-p3), ...
Zapravo smo pronašli kombinacije svih parova tačaka između svake tačke bez ponavljanja...
(foreach p1 plst
(setq plst (cdr plst))
(foreach p2 plst
(setq p1p2arclenlst (cons (lista p1 p2 (arclen p1 p2)) p1p2arclenlst))
)
)
Dakle, mapiramo tačke: p1, p2, p3, ... zavisno od 2D triangulacionog dijagrama gde su sve dužine lukova realne udaljenosti i nijedan od trouglova ne sme da prelazi prethodni trougao, ili da bude unutar moguće većeg trougla (imamo 2 rešenja kružnice - kružne preseke za konstruisanje triangulacija između 2 tačke...)...
Mogući početak p1=0,0; p2=arclen(p1,p2),0; p3=arclen(p1,p3)*cos(a),arclen(p1,p3)*sin(a) = ci(p1,arclen(p1,p3))Xci(p2,arclen(p2,p3)); p4= ci(p1,arclen(p1,p4))Xci(p3,arclen(p3,p4)) ili ci(p2,arclen(p2,p4))Xci(p3,arclen(p3,p4)) -- već ovde imamo grananje i moramo odlučiti koji je put bolji od p1 ili p2 --; zatim za p5 grananje kroz p1-p4 ili p3-p4 ili kroz p2-p4 ili p3-p4 ...
Rešavamo 2D TSP na triangulaciji i pamtimo tačan redosled liste tačaka...
To bi bilo dobro samo ako bi triangulacija zadovoljila realnu dispoziciju koja bi pretpostavljala da su sve relacije između tačaka kompaktne i jedinstvene... Prema grananju, to ne bi bilo tačno, tako da ipak moramo proći kroz 2D dijagram i kreirati rotaciono dinamička TSP rešenja na osnovu povećanja ugla rotacije uzorka od 0 do 2*pi radijana...
Transformaciona formula za 3D sferu u 2D dijagram je kao što je već rečeno:
pt=X,Y=r/2*cos(beta)*cos(alfa),r/2*sin(beta); ali recimo da je rotacioni ugao teta, dakle:
pt=X*cos(teta),Y=r/2*cos(teta)*cos(beta)*cos(alfa),r/2*sin(beta)...
Sada za theta1, theta2,..., theta11; mogli bismo da imamo TSP1, TSP2,..., TSP11 sa inkrementalnim rotacionim uglom od 30 stepeni...
Ali da li bismo mogli da koristimo stvarne udaljenosti za TSP algoritam umesto korišćene funkcije (distance), nešto poput:
(defun _distance ( p1 p2 / d R ) ;; koristi se bp kao leksička globala kao centar 3D sfere ;;
(setq R (distance bp p1))
(setq d (* R (sqrt (+ (expt (acos (* R (cos (asin (/ (abs (cadr (mapcar (function -) p2 p1))) R))))) 2) (expt (asin (/ (abs (cadr (mapcar (function -) p2 p1))) R)) 2)))))
)
i samo zamenite u kodu TSP-a: "(distance " sa "(_distance "...
Konačno, šta da radimo sa različitim TSP mapiranim listama tačaka ako se razlikuju...
Osim toga, s obzirom na činjenicu da projekcije imaju sa visinskog pogleda 2D dijagrama isto tako GORNU i ZADNJU stranu, mogli bismo imati tačke preklapanja koje su suprotne jedna drugoj... Dakle, svako TSP rešenje je TOP+NAZAD (alfa(0,pi) i alfa(pi,2*pi))...
Konačan zaključak:
Iz razloga složenosti, 2D TSP nije baš koristan u smislu transformacija iz distribucije 3D sfernih tačaka, dalje da bi se secirao još više, kada pretpostavimo da smo dinamički posmatrali rotacione dispozicije tačaka duž Y ose – što odgovara Z rotaciji sfere, mi bi mogli reći da smo posmatrali uzdužni presek sfere i posmatrali tačke samo iz projekcije Z ose 2D dijagrama ili neke ose u XY ravni 3D sfere; tako da ovde možemo reći da bismo mogli da imamo ose rotacije iz bilo kog smera oko Z 2D dijagrama, što znači beskonačan broj osa, ali samo iz jednog uzdužnog preseka/visinske ravni, dok bismo takođe mogli reći da je taj 2D dijagram takođe mogao biti posmatran iz bilo kog Y rotacionog ugla dijagrama / Z rotacionog ugla sfere, što znači beskonačan broj elevacija puta beskonačan broj osa svake elevacije = beskonačan^2 broj TSP rešenja sva sa (TOP+NAZAD) prikazima tačaka distribucije...
Sve je ovo tužno, ali istinito...

Tako dugo od mene,
Pozdrav, M.R.

[EDIT]
Glupirali se mi oko 2D TSP algoritma, on jednostavno kaže da samo promenom podataka o tačkama iz 2D u 3D, mi smo u stanju da rešimo 3D TSP... Jednostavno zamenimo Convex Hull sa 3D Convex Hull, gde koristimo TOP projekciju i FRONTALNU u slučaju da u prvoj projekciji (TOP) imamo preklapanja tačaka sa različitim elevacijama...

Sada za sferni aspekt - koristimo RND tačke na sferi, a za proveru preseka imamo 2 vektora - 2 tetive sfere, tako da nalazimo ravan 2 tačke + centar sfere, i 2 ravan (slicno) => nalazimo vektor preseka od 2 ravni sa centrom sfere i drugom tačkom sa rastojanjem R... Dakle, ako ta linija seče obe tetive, onda se javlja ukrštanje i onda nastavljamo sa rekonstrukcijom, uzimajući 2 najkraće tetive i uklanjajući 2 originalne...

S poštovanjem, M.R.
[/EDIT]
« Last Edit: August 02, 2022, 12:46:42 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### VovKa

• Water Moccasin
• Posts: 1617
• Ukraine
##### Re: (Challenge) To draw the shortest lwpolyline
« Reply #197 on: July 30, 2022, 05:29:19 PM »
So long from me,
this might be the longest post here on theswamp

#### ribarm

• Gator
• Posts: 3187
• Marko Ribar, architect
##### Re: (Challenge) To draw the shortest lwpolyline
« Reply #198 on: July 31, 2022, 08:20:38 AM »
So, I've done everything based on TSP-all.lsp (2D algortihm)... It should work well now for every situation (2D, 3D space points, 3D spherical points) with RND points or selection set of points, blocks or circles...

So, it may occur something strange, like in my latest testings - on one place on sphere path crossed, and BTW. with some small arcs, it must skip them as (MR:3parc) can't always create ARC in 3D...

That's all...
So long from me...
Enjoy...
M.R.
« Last Edit: January 04, 2023, 09:13:53 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### ribarm

• Gator
• Posts: 3187
• Marko Ribar, architect
##### Re: (Challenge) To draw the shortest lwpolyline
« Reply #199 on: October 12, 2022, 04:10:54 AM »
Interesting approach by CADaSchtroumpf at autodesk forums by using temporary ellipse entity for sorting points... It should be very fast... I'll see to implement intersections checking... It's not difficult - just use that what I posted for @ahsattarian...

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/challenge-generate-n-closed-plines-from-n-groups-of-points/m-p/11476934/highlight/true#M437651

Regards, M.R.
« Last Edit: October 12, 2022, 07:03:02 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### ScottMC

• Newt
• Posts: 191
##### Re: (Challenge) To draw the shortest lwpolyline
« Reply #200 on: October 12, 2022, 12:56:45 PM »
Interesting approach by CADaSchtroumpf at autodesk forums by using temporary ellipse entity for sorting points... It should be very fast... I'll see to implement intersections checking... It's not difficult - just use that what I posted for @ahsattarian...

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/challenge-generate-n-closed-plines-from-n-groups-of-points/m-p/11476934/highlight/true#M437651

Regards, M.R.

Excellent and fast! Also nice to include circles and blocks. Gonna speriment 3D as it's used the most. Only had to comment a few on the 'sysvarpreset' list.

#### ribarm

• Gator
• Posts: 3187
• Marko Ribar, architect
##### Re: (Challenge) To draw the shortest lwpolyline
« Reply #201 on: December 23, 2022, 12:59:19 PM »
I don't know, but this option also exist... Something I called double greedy TSP...

Code - Auto/Visual Lisp: [Select]
1. (defun c:tsp-3d-space ( / *error* tttt car-sort collinear-p chkinters-p chkinters ss ti i pl c p1 p2 pp1 pp2 lst )
2.
3.   (defun *error* ( m )
4.     (if wcs
5.       (if ucsf
6.         (exe (list "_.UCS" "_P"))
7.       )
8.     )
9.     (while (= 8 (logand 8 (getvar (quote undoctl))))
10.       (if (not (exe (list "_.UNDO" "_E")))
11.         (if doc
12.           (vla-endundomark doc)
13.         )
14.       )
15.     )
16.     (if initvalueslst
18.     )
19.     (foreach fun (list (quote tttt) (quote vl-load) (quote exe) (quote cmdfun) (quote cmderr) (quote catch_cont) (quote apply_cadr->car) (quote ftoa))
20.       (setq fun nil)
21.     )
22.     (if doc
23.       (vla-regen doc acactiveviewport)
24.     )
25.     (if m
26.       (prompt m)
27.     )
28.     (princ)
29.   )
30.
31.   (defun tttt ( wcs / sysvarpreset sysvarlst sysvarvals ) ;;; wcs (T/nil) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;; vl-load exe cmdfun cmderr catch_cont apply_cadr->car ftoa - library sub functions common for standard template initialization ;;;
32.
37.           )
38.         )
39.       )
40.       (or doc (setq doc (vla-get-activedocument cad)))
41.       (or alo (setq alo (vla-get-activelayout doc)))
42.       (or spc (setq spc (vla-get-block alo)))
43.     )
44.
45.     ;;; sometimes not needed to use/initialize AxiveX Visual Lisp extensions - (comment/uncomment) following line ;;;
47.
48.     (defun exe ( tokenslist )
49.       ( (lambda ( tokenslist / ctch )
50.           (if (vl-catch-all-error-p (setq ctch (cmdfun tokenslist t)))
51.               (cmderr tokenslist)
52.               (catch_cont ctch)
53.             )
54.               (while (< 0 (getvar (quote cmdactive)))
55.                 (vl-cmdf "")
56.               )
57.               t
58.             )
59.           )
60.         )
61.         tokenslist
62.       )
63.     )
64.
65.     (defun cmdfun ( tokenslist flag / ctch ) ;;; tokenslist - command parameters list of strings ;;; flag - if "t" specified, upon successful execution returns t, otherwise if "nil" specified, return is always nil no matter what outcome of function execution is - it should be successful anyway if specified tokenslist was hardcoded correctly... ;;;
66.       (if command-s
67.         (if flag
68.           (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist))))
69.             flag
70.             ctch
71.           )
72.           (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist)))
73.             ctch
74.           )
75.         )
76.         (if flag
77.           (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function vl-cmdf) tokenslist))))
78.             flag
79.             ctch
80.           )
81.           (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command) tokenslist)))
82.             ctch
83.           )
84.         )
85.       )
86.     )
87.
88.     (defun cmderr ( tokenslist ) ;;; tokenslist - list of tokens representing command syntax at which used (cmdfun) failed with successful execution ;;;
89.       (prompt (strcat "\ncommand execution failure... error at used command tokenslist : " (vl-prin1-to-string tokenslist)))
90.     )
91.
92.     (defun catch_cont ( ctch / gr )
93.       (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...")
94.         (and
95.           (vl-catch-all-error-p (or ctch (setq ctch (vl-catch-all-apply (function /) (list 1 0)))))
97.           (/= (car gr) 3)
98.           (not (equal gr (list 2 13)))
99.         )
100.       )
101.       (if (vl-catch-all-error-p ctch)
102.         ctch
103.       )
104.     )
105.
106.     (defun apply_cadr->car ( sysvarvaluepair / ctch )
107.       (setq ctch (vl-catch-all-apply (function setvar) sysvarvaluepair))
108.       (if (vl-catch-all-error-p ctch)
109.           (prompt (strcat "\ncatched error on setting system variable : " (vl-prin1-to-string (vl-symbol-name (car sysvarvaluepair))) " with value : " (vl-prin1-to-string (cadr sysvarvaluepair))))
110.           (catch_cont ctch)
111.         )
112.       )
113.     )
114.
115.     (defun ftoa ( n / m a s b )
116.       (if (numberp n)
117.           (setq m (fix ((if (< n 0) - +) n 1e-8)))
118.           (setq a (abs (- n m)))
119.           (setq m (itoa m))
120.           (setq s "")
121.           (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0))))
122.             (setq s (strcat s (itoa b)))
123.             (setq a (- (* a 10.0) b))
124.           )
125.           (if (= (type n) (quote int))
126.             m
127.             (if (= s "")
128.               m
129.               (if (and (= m "0") (< n 0))
130.                 (strcat "-" m "." s)
131.                 (strcat m "." s)
132.               )
133.             )
134.           )
135.         )
136.       )
137.     )
138.
139.     (setq sysvarpreset
140.       (list
141.         (list (quote cmdecho) 0)
142.         (list (quote 3dosmode) 0)
143.         (list (quote osmode) 0)
144.         (list (quote unitmode) 0)
145.         (list (quote cmddia) 0)
146.         (list (quote ucsvp) 0)
147.         (list (quote ucsortho) 0)
148.         (list (quote projmode) 0)
149.         (list (quote orbitautotarget) 0)
150.         (list (quote insunits) 0)
151.         (list (quote hpseparate) 0)
152.         (list (quote hpgaptol) 0)
153.         (list (quote halogap) 0)
154.         (list (quote edgemode) 0)
155.         (list (quote pickdrag) 0)
156.         (list (quote qtextmode) 0)
157.         (list (quote dragsnap) 0)
158.         (list (quote angdir) 0)
159.         (list (quote aunits) 0)
160.         (list (quote limcheck) 0)
161.         (list (quote gridmode) 0)
162.         (list (quote nomutt) 0)
163.         (list (quote apbox) 0)
164.         (list (quote attdia) 0)
165.         (list (quote blipmode) 0)
166.         (list (quote copymode) 0)
169.         (list (quote filedia) 1)
170.         (list (quote autosnap) 1)
171.         (list (quote objectisolationmode) 1)
172.         (list (quote highlight) 1)
173.         (list (quote lispinit) 1)
174.         (list (quote layerpmode) 1)
175.         (list (quote fillmode) 1)
176.         (list (quote dragmodeinterrupt) 1)
177.         (list (quote dispsilh) 1)
178.         (list (quote fielddisplay) 1)
179.         (list (quote deletetool) 1)
180.         (list (quote delobj) 1)
181.         (list (quote dblclkedit) 1)
182.         (list (quote attreq) 1)
183.         (list (quote explmode) 1)
184.         (list (quote frameselection) 1)
185.         (list (quote ltgapselection) 1)
186.         (list (quote pickfirst) 1)
187.         (list (quote plinegen) 1)
188.         (list (quote plinetype) 1)
189.         (list (quote peditaccept) 1)
190.         (list (quote solidcheck) 1)
191.         (list (quote visretain) 1)
192.         (list (quote regenmode) 1)
193.         (list (quote celtscale) 1.0)
194.         (list (quote ltscale) 1.0)
195.         (list (quote osnapcoord) 2)
196.         (list (quote grips) 2)
197.         (list (quote dragmode) 2)
198.         (list (quote lunits) 2)
199.         (list (quote pickstyle) 3)
200.         (list (quote navvcubedisplay) 3)
201.         (list (quote pickauto) 3)
202.         (list (quote draworderctl) 3)
203.         (list (quote expert) 5)
204.         (list (quote auprec) 6)
205.         (list (quote luprec) 6)
206.         (list (quote pickbox) 6)
207.         (list (quote aperture) 6)
208.         (list (quote osoptions) 7)
209.         (list (quote dimzin) 8)
210.         (list (quote pdmode) 35)
211.         (list (quote pdsize) -1.5)
212.         (list (quote celweight) -1)
213.         (list (quote cecolor) "BYLAYER")
214.         (list (quote celtype) "ByLayer")
215.         (list (quote clayer) "0")
216.       )
217.     )
218.     (setq sysvarlst (mapcar (function car) sysvarpreset))
219.     (setq sysvarvals (mapcar (function cadr) sysvarpreset))
220.     (setq sysvarvals
221.       (vl-remove nil
222.           (function (lambda ( x )
223.             (if (getvar x) (nth (vl-position x sysvarlst) sysvarvals))
224.           ))
225.           sysvarlst
226.         )
227.       )
228.     )
229.     (setq sysvarlst
230.       (vl-remove-if-not
231.         (function (lambda ( x )
232.           (getvar x)
233.         ))
234.         sysvarlst
235.       )
236.     )
237.     (setq initvalueslst
238.           (list
239.             sysvarlst
240.             (mapcar (function getvar) sysvarlst)
241.           )
242.         )
243.       )
244.     )
245.         (list
246.           sysvarlst
247.           sysvarvals
248.         )
249.       )
250.     )
251.     (while (= 8 (logand 8 (getvar (quote undoctl))))
252.       (if (not (exe (list "_.UNDO" "_E")))
253.         (if doc
254.           (vla-endundomark doc)
255.         )
256.       )
257.     )
258.     (if (not (exe (list "_.UNDO" "_M")))
259.       (if doc
260.         (vla-startundomark doc)
261.       )
262.     )
263.     (if wcs
264.       (if (= 0 (getvar (quote worlducs)))
265.           (exe (list "_.UCS" "_W"))
266.           (setq ucsf t)
267.         )
268.       )
269.     )
270.     wcs
271.   )
272.
273.   (defun car-sort ( lst cmp / rtn )
274.     (setq rtn (car lst))
275.     (foreach itm (cdr lst)
276.       (if (apply cmp (list itm rtn))
277.         (setq rtn itm)
278.       )
279.     )
280.     rtn
281.   )
282.
283.   (defun collinear-p ( p1 p p2 )
284.     (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
285.   )
286.
287.   (defun chkinters-p ( pl / r )
288.     (or lil (setq lil (mapcar (function list) pl (append (cdr pl) (list (car pl))))))
290.     (setq lil nil)
291.     r
292.   )
293.
294.   (defun chkinters ( pl / processlil done r lill ilil iip )
295.
296.     (defun processlil ( ilil lil / pre mid suf ret )
297.       (setq pre (reverse (cdr (member (car ilil) (reverse lil)))))
298.       (setq mid (cdr (member (car ilil) lil)))
299.       (setq mid (cdr (member (cadr ilil) (reverse mid))))
300.       (setq mid (mapcar (function reverse) mid))
301.       (setq suf (cdr (member (cadr ilil) lil)))
302.       (setq ret (append pre (list (list (car (car ilil)) (car (cadr ilil)))) mid (list (list (cadr (car ilil)) (cadr (cadr ilil)))) suf))
303.       ret
304.     )
305.
306.     (or lil (setq lil (mapcar (function list) pl (append (cdr pl) (list (car pl))))))
307.     (while (not done)
309.       (cond
310.         ( (and ilil (equal iip (caddr ilil) 1e-6))
311.           (setq lil (processlil ilil lil))
312.         )
313.         ( (and ilil (equal (caar ilil) (caddr ilil) 1e-6))
314.           (cond
315.             ( (and (not (equal (caar ilil) (caadr ilil) 1e-6)) (not (equal (caar ilil) (cadadr ilil) 1e-6)))
316.               (setq lil (processlil ilil lil))
317.             )
318.             ( (equal (caar ilil) (caadr ilil) 1e-6)
319.               (setq lil (processlil ilil lil))
320.             )
323.               (setq lil (processlil ilil lil))
324.             )
325.           )
326.         )
328.           (cond
330.               (setq ilil (subst (assoc (cadar ilil) lil) (car ilil) ilil))
331.               (setq lil (processlil ilil lil))
332.             )
334.               (setq ilil (subst (assoc (cadar ilil) lil) (car ilil) ilil))
335.               (setq lil (processlil ilil lil))
336.             )
338.               (setq ilil (subst (assoc (cadar ilil) lil) (car ilil) ilil))
340.               (setq lil (processlil ilil lil))
341.             )
342.           )
343.         )
345.           (cond
346.             ( (and (not (equal (caadr ilil) (caar ilil) 1e-6)) (not (equal (caadr ilil) (cadar ilil) 1e-6)))
347.               (setq lil (processlil ilil lil))
348.             )
349.             ( (equal (caadr ilil) (caar ilil) 1e-6)
350.               (setq lil (processlil ilil lil))
351.             )
353.               (setq ilil (subst (assoc (caadr ilil) lil) (car ilil) ilil))
354.               (setq lil (processlil ilil lil))
355.             )
356.           )
357.         )
359.           (cond
362.               (setq lil (processlil ilil lil))
363.             )
366.               (setq lil (processlil ilil lil))
367.             )
370.               (setq ilil (subst (assoc (cadar ilil) lil) (car ilil) ilil))
371.               (setq lil (processlil ilil lil))
372.             )
373.           )
374.         )
375.         ( t (setq done t) )
376.       )
377.     )
378.     (setq r (mapcar (function car) lil))
379.     (setq lil nil)
380.     r
381.   )
382.
383.   (tttt t) ;;; initializing default error handler and setting of system variables ;;;
384.   (prompt "\nSelect 3d points, blocks or circles...")
385.   (if (setq ss (ssget (list (cons 0 "POINT,INSERT,CIRCLE"))))
386.       (setq ti (car (_vl-times)))
387.       (repeat (setq i (sslength ss))
388.         (setq pl (cons (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))) pl))
389.       )
390.       (setq pl (vl-sort pl (function (lambda ( a b ) (if (= (car a) (car b)) (if (= (cadr a) (cadr b)) (> (caddr a) (caddr b)) (> (cadr a) (cadr b))) (> (car a) (car b)))))))
391.       (if (vl-every (function (lambda ( x ) (equal (caddr x) 0.0 1e-6))) pl)
392.         (setq c (list (car-sort (mapcar (function car) pl) (function >)) (car-sort (mapcar (function cadr) pl) (function >))) pl (mapcar (function (lambda ( p ) (list (car p) (cadr p)))) pl))
393.         (setq c (list (car-sort (mapcar (function car) pl) (function >)) (car-sort (mapcar (function cadr) pl) (function >)) (car-sort (mapcar (function caddr) pl) (function >))))
394.       )
395.       (setq p1 c)
396.       (setq p2 (car-sort (vl-remove p1 pl) (function (lambda ( q p ) (< (distance p1 q) (distance p1 p))))))
397.       (setq lst (cons p2 lst))
398.       (setq p1 p2)
399.       (setq p2 (car-sort (vl-remove p1 pl) (function (lambda ( q p ) (< (distance p1 q) (distance p1 p))))))
400.       (setq lst (cons p2 lst))
401.       (setq pl (vl-remove p1 pl) pl (vl-remove p2 pl))
402.       (while pl
403.         (setq pp1 (car-sort pl (function (lambda ( q p ) (< (distance p1 q) (distance p1 p))))))
404.         (setq pp2 (car-sort pl (function (lambda ( q p ) (< (distance p2 q) (distance p2 p))))))
405.         (if (< (distance p1 pp1) (distance p2 pp2))
406.             (setq lst (append lst (list pp1)))
407.             (setq pl (vl-remove pp1 pl))
408.             (setq p1 pp1)
409.           )
410.             (setq lst (cons pp2 lst))
411.             (setq pl (vl-remove pp2 pl))
412.             (setq p2 pp2)
413.           )
414.         )
415.       )
416.       (if (chkinters-p lst)
417.         (setq lst (chkinters lst))
418.       )
419.         (list
420.           (cons 0 "POLYLINE")
421.           (cons 100 "AcDbEntity")
422.           (cons 100 "AcDb3dPolyline")
423.           (cons 66 1)
424.           (list 10 0.0 0.0 0.0)
425.           (cons 70 9)
426.           (list 210 0.0 0.0 1.0)
427.         )
428.       )
429.       (foreach pt lst
430.           (list
431.             (cons 0 "VERTEX")
432.             (cons 100 "AcDbEntity")
433.             (cons 100 "AcDbVertex")
434.             (cons 100 "AcDb3dPolylineVertex")
435.             (cons 10 pt)
436.             (cons 70 32)
437.           )
438.         )
439.       )
440.         (list
441.           (cons 0 "SEQEND")
442.           (cons 100 "AcDbEntity")
443.         )
444.       )
445.       (prompt "\nPath length : ") (princ (atof (ftoa (apply (function +) (mapcar (function (lambda ( a b ) (distance a b))) lst (cdr lst))))))
446.       (prompt "\nElapsed time : ") (princ (atof (ftoa (- (car (_vl-times)) ti)))) (prompt " milliseconds...")
447.     )
448.     (prompt "\nEmpty selection set... Better luck next time...")
449.   )
450.   (*error* nil)
451. )
452.

Just for compare :

: TSP-3D-SPACE

Select 3d points, blocks or circles...
Select entities:all
Entities in set: 10000
Select entities:

Path length : 3726908.34978218
Elapsed time : 22659563.0 milliseconds...

https://www.theswamp.org/index.php?topic=30434.msg591329#msg591329

HTH.
M.R.
« Last Edit: January 08, 2023, 08:51:21 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### ribarm

• Gator
• Posts: 3187
• Marko Ribar, architect
##### Re: (Challenge) To draw the shortest lwpolyline
« Reply #202 on: December 30, 2022, 04:09:43 PM »
This is for faster computing by using DOUBLE GREEDY and AHS:TSP algorithm...

So long from me for now...
« Last Edit: January 20, 2023, 05:34:38 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### ribarm

• Gator
• Posts: 3187
• Marko Ribar, architect
##### Re: (Challenge) To draw the shortest lwpolyline
« Reply #203 on: January 02, 2023, 03:08:46 PM »
I need help in optimizing those 2 lisps attached here :
https://www.theswamp.org/index.php?topic=30434.msg610920#msg610920

I am afraid I can't quite get how record was beaten to be in shorter time difference...
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### ribarm

• Gator
• Posts: 3187
• Marko Ribar, architect
##### Re: (Challenge) To draw the shortest lwpolyline
« Reply #204 on: January 03, 2023, 11:54:43 AM »
I've hardcoded some starting inputs and summarize 2D solution to just TSP.lsp file...
Please, do not choose more than 200 pts... For large amount of points 10000 - use TSP-3D-space.lsp posted previously...
« Last Edit: January 08, 2023, 02:23:43 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### ribarm

• Gator
• Posts: 3187
• Marko Ribar, architect
##### Re: (Challenge) To draw the shortest lwpolyline
« Reply #205 on: January 05, 2023, 10:14:36 AM »
TSP.lsp is written, but I need help to make it work faster... Can someone with more experiences step in and try to investigate - perhaps create *.vlx, *.brx, *.arx, *.des, *.dll...
Not sure if Bricscad have NETLOAD command for *.dll (if someone convert successfully that TSP.lsp)...

[EDIT] : Yes Bricscad has implemented NETLOAD command... So C# and *.dll would be the most appropriate file after *.lsp I and others wrote... [/EDIT]

Thanks, M.R.
« Last Edit: January 25, 2023, 09:28:33 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### ribarm

• Gator
• Posts: 3187
• Marko Ribar, architect
##### Re: (Challenge) To draw the shortest lwpolyline
« Reply #206 on: January 08, 2023, 11:59:26 AM »
@gile

Can you try to convert lastly posted TSP.lsp to some kind of faster routine (TSP.dll)... What can we do when it's so slooow...

Anyway, I programmed it and it works well for me, it's just that it don't quite meet expectation time difference after finish...

Regards, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### ribarm

• Gator
• Posts: 3187
• Marko Ribar, architect
##### Re: (Challenge) To draw the shortest lwpolyline
« Reply #207 on: January 22, 2023, 01:39:21 PM »
@gile

Can you try to convert lastly posted TSP.lsp to some kind of faster routine (TSP.dll)... What can we do when it's so slooow...

Anyway, I programmed it and it works well for me, it's just that it don't quite meet expectation time difference after finish...

Regards, M.R.

@Gilles
Are you OK?

@Daniel
OK?
Marko Ribar, d.i.a. (graduated engineer of architecture)

#### It's Alive!

• Retired
• Needs a day job
• Posts: 8589
• AKA Daniel
##### Re: (Challenge) To draw the shortest lwpolyline
« Reply #208 on: January 22, 2023, 06:16:23 PM »
Can’t read lisp anymore, all I see is ilil ilil

#### It's Alive!

• Retired
• Needs a day job
• Posts: 8589
• AKA Daniel
##### Re: (Challenge) To draw the shortest lwpolyline
« Reply #209 on: January 22, 2023, 10:06:11 PM »
Here’s one to try

Code: [Select]
`(vlce_cheapestpath Strategy Scale points)`
Strategy
UNSET = 0; for the next add one, i'm too lazy
AUTOMATIC
PATH_CHEAPEST_ARC
PATH_MOST_CONSTRAINED_ARC
EVALUATOR_STRATEGY
SAVINGS
SWEEP
CHRISTOFIDES
ALL_UNPERFORMED
BEST_INSERTION
BEST_INSERTION
PARALLEL_CHEAPEST_INSERTION
SEQUENTIAL_CHEAPEST_INSERTION
LOCAL_CHEAPEST_INSERTION
LOCAL_CHEAPEST_COST_INSERTION
GLOBAL_CHEAPEST_ARC
LOCAL_CHEAPEST_ARC
FIRST_UNBOUND_MIN_VALUE

Scale = the library I used uses integers for distances, use the scale if working with small distances.

Points is your list of points, returns list pf points on success, otherwise your cpu will melt and bore a hole through the earth

ARX,BRX,GRX,ZRX... only tested with arx

« Last Edit: January 23, 2023, 08:34:01 AM by beck's bolero »