### Author Topic: Help Finding Block Route  (Read 15123 times)

0 Members and 1 Guest are viewing this topic.

#### ronjonp

• Needs a day job
• Posts: 7327
##### Re: Help Finding Block Route
« Reply #15 on: August 11, 2013, 06:44:48 PM »
Yep, looks like the solution.

I don't understand, this:

This reeks of Dijkstra's algorithm...

Seems like a perfectly good response to the question:

Could someone help out or at least get me started on the thought process?

Amongst the other responses in the thread. It identifies the problem, a way to solve it and antes up pseudo code to boot.

What's the problem?

Huh?

Thanks guys .. will take a look at it on Monday. Have a nice weekend.
« Last Edit: August 11, 2013, 06:50:49 PM by ronjonp »

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

#### ymg

• Swamp Rat
• Posts: 725
##### Re: Help Finding Block Route
« Reply #16 on: August 12, 2013, 11:57:32 AM »
Ronjomp,

If it is really Dijkstra that you are after, the routine itself is not so bad to program.

The challenging part is to get the input (the graph) in correctly. You basically needs your nodes and edges and their weight (distance).
We could select it from a dwg , assuming your nodes are block and your edges would be polylines.  But this does impose good discipline as you do your drawing.

Here is a link: A Note on Two Problems in Connexion with Graphs to his original paper.

He was a man of few words and a great mind !

ymg

#### Krushert

• Seagull
• Posts: 13656
• FREE BEER Tomorrow!!
##### Re: Help Finding Block Route
« Reply #17 on: August 13, 2013, 04:29:19 PM »
Ron,

You are probably looking for code approach but I will throw out another method of skinning the cat.

Question though; would the the control wires be on identifiable with layer name or something?  A home run polyline from each remote point back to home and it length and other pertinent data can be extracted utilizing AutoCADs DataExtraction Wizard.

Check out the attached spreadsheet that I just did yesterday for tallying up cracks and spalls in concrete.  The wizard will dump to a AutoCAD table or Excel.
I + XI = X is true ...  ... if you change your perspective.

I no longer CAD or Model, I just hang out here picking up the empties beer cans

#### ronjonp

• Needs a day job
• Posts: 7327
##### Re: Help Finding Block Route
« Reply #18 on: August 13, 2013, 04:41:21 PM »
Krushert,

Unfortunately the routes do not exist. I need to automate a way to figure these out .

Thanks.

Ron

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

#### Krushert

• Seagull
• Posts: 13656
• FREE BEER Tomorrow!!
##### Re: Help Finding Block Route
« Reply #19 on: August 13, 2013, 04:43:14 PM »
Whoops!  I thought they were already created.

I will go back to my cracks now.  Yes I am drawing more crack.
I + XI = X is true ...  ... if you change your perspective.

I no longer CAD or Model, I just hang out here picking up the empties beer cans

#### ronjonp

• Needs a day job
• Posts: 7327
##### Re: Help Finding Block Route
« Reply #20 on: August 13, 2013, 05:02:15 PM »
Whoops!  I thought they were already created.

I will go back to my cracks now.  Yes I am drawing more crack.

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

#### ymg

• Swamp Rat
• Posts: 725
##### Re: Help Finding Block Route
« Reply #21 on: August 14, 2013, 04:46:31 PM »
RonJomp,

In the attached image, do you have a node at position 8.

If it is the case, with Dijkstra  your return would be 7-6-8-4-3-2-1-0

If you don't means you have a branch from 4 to 5 and 5 to 6
but no branch from 4 to 6. In this case the return would be
7-6-5-4-3-2-1-0

In other word if you have a junction box at 8, it should be a node.

ymg

#### ronjonp

• Needs a day job
• Posts: 7327
##### Re: Help Finding Block Route
« Reply #22 on: August 15, 2013, 10:32:19 AM »
My thoughts were to compile a list of points based on each polyline vertex (yellow x's in the image below) . So there would be a "node" at 8 because it's an end point of a polyline.

Thanks for the reply

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

#### ymg

• Swamp Rat
• Posts: 725
##### Re: Help Finding Block Route
« Reply #23 on: August 16, 2013, 05:22:35 PM »
Ronjomp,

Here is my implementation of Dijkstra's algorithm plus a link http://tech-algorithm.com/articles/dijkstra-algorithm/
to probably the clearest article I've seen on it.  The test graph is the same as in this article.

You will still have to come up with a way to transform a selection into a valid graph.
There, It very much depends on how you draft your conduits.

ymg

Code - Auto/Visual Lisp: [Select]
1. (defun c:test ()
2.    (setq nodes '("a" "b" "c" "d" "e" "f" "g" "h")
3.          edges '(("a" "b" 1)
4.                  ("a" "e" 2)
5.                  ("a" "f" 1)
6.                  ("b" "c" 2)
7.                  ("b" "g" 1)
8.                  ("c" "d" 1)
9.                  ("d" "e" 1)
10.                  ("d" "g" 2)
11.                  ("d" "h" 0.5)
12.                  ("e" "f" 2)
13.                  ("g" "h" 0.5)
14.                 )
15.   )
16.
17.   (print (minpath "g" "f" nodes edges))
18.
19.   (princ)
20. )
21.
22. ; Find the path of minimum total length between two given nodes g and f.      ;
23. ; Using Dijkstra Algorithm                                                    ;
24. ;                                                                             ;
25. ; See http://tech-algorithm.com/articles/dijkstra-algorithm/                  ;
26. ;                                                                             ;
27. ; Written by ymg   August 2013                                                ;
28.
29. (defun minpath (g f nodes edges / )
30.         (setq   nodes (vl-remove g nodes)
31.                 openl (list (list g 0 nil))
32.               closedl nil
33.         )
34.         (foreach n nodes
35.              (setq nodes (subst (list n 0 nil) n nodes))
36.         )
37.         (while (not (= (caar closedl) f))
38.             (setq nodname (caar openl)
39.                   totdist (cadar openl)
40.                   closedl (cons (car openl) closedl)
41.                     openl (cdr openl)
42.                   clnodes (mapcar 'car closedl)
43.
44.             )
45.             (foreach e edges
46.                  (setq brname nil)
47.                  (if (= (car e) nodname) (setq brname (cadr e)))
48.                  (if (= (cadr e) nodname) (setq brname (car e)))
49.
50.                  (if brname
51.                        (setq new (list brname (+ (caddr e) totdist) nodname))
52.                        (cond
53.                           ((member brname clnodes))
54.                           ((setq oldpos (vl-position brname (mapcar 'car openl)))
55.                              (setq old (nth oldpos openl))
56.                              (if (< (cadr new) (cadr old))
57.                                 (setq openl (subst new old openl))
58.                              )
59.                           )
60.                           (t (setq openl (cons new openl)))
61.                        )
62.                        (setq edges (vl-remove e edges))
63.                     )
64.                  )
65.             )
66.             (setq openl (vl-sort openl (function (lambda (a b) (< (cadr a) (cadr b))))))
67.         )
68.         (setq minpath (list (car closedl)))
69.         (foreach n closedl
70.             (if (= (car n) (caddr (car minpath)))
71.               (setq minpath (cons n minpath))
72.             )
73.         )
74.   )
75.

#### ronjonp

• Needs a day job
• Posts: 7327
##### Re: Help Finding Block Route
« Reply #24 on: August 16, 2013, 08:53:15 PM »
Thanks ymg ..I'll take a look on Monday. Have a nice weekend.

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

#### Kerry

• Mesozoic relic
• Seagull
• Posts: 11654
• class keyThumper<T>:ILazy<T>
##### Re: Help Finding Block Route
« Reply #25 on: August 16, 2013, 09:35:07 PM »

I haven't read through the entire thread, but I think you'll need a node at each block location and each pline intersection so that your edges can be defined --- that applies if the edge distance (traversal) is important.

I see the problem in 2 parts.
Defining the data. ie: node locations and edge distances.
Determining the traversal.
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<--

#### ymg

• Swamp Rat
• Posts: 725
##### Re: Help Finding Block Route
« Reply #26 on: August 17, 2013, 12:56:38 PM »
Quote
Unfortunately the routes do not exist. I need to automate a way to figure these out .

Ronjomp,

Based on that quote, If it is automatic conduit layout that you are after, the problem is much more complicated
than simply following a route in a graph.

All kind of complications arises when you try to define the constraints.

Here is a link to a recent patent http://www.google.com/patents/WO2013086135A1?cl=en.

Even reading this it is not very clear how they do it.

In the litterature there is also some apps for laying out connection that are somewhat related.

So I am afraid that the problem is really hard.

ymg

#### ymg

• Swamp Rat
• Posts: 725
##### Re: Help Finding Block Route
« Reply #27 on: August 19, 2013, 01:51:18 PM »
Ronjomp,

If my assumptions are right, what you are trying to achieve is:  Given a set of instruments, find a route that will minimize the length of  conduits/wire to connect them all.

This leads you to Minimum Spanning Tree (MST)

You also probably want your conduits to run parrallel to the building lines. So you are now looking for:

Rectilinear Minimum Spanning Tree (RMST).

For this the problem is tractable. Look at the following link:

Efficient minimum spanning tree construction without Delaunay triangulation

In there you’ll find some pseudocode describing an efficient way to go about it. What you would do is simply select all the blocks without any connections (No need for LWPolyline joining the blocks) and you could generate the RMST.

However your problem does not stop there.  Because by inserting junction boxes on your conduits network,  you still can minimize the length of it. So this leads you to another beast that they call:

Rectilinear Steiner Minimum Tree (RSMT)

There the problem becomes very difficult.  Here is a quote from the next paper I propose to you:

Quote
However, Garey and Johnson [3] prove that the RSMT problem is NP-complete, indicating that a polynomial-time algorithm to compute an optimal RSMT is unlikely to exist.

It does not mean that the problem cannot be resolved but that a closed solution in reasonable computing time probably does  not exist.  However some heuristic can approach the solution in computable time.

In this paper:

An Efficient Rectilinear Steiner Minimum Tree Algorithm Based on Ant Colony Optimization

They managed with their Aco-Steiner procedure to get a near optimal solution in about 50 iterations. They also give some pseudocode for achieving it.

Now enough Blah, Blah you got some coding to do .

ymg
« Last Edit: August 19, 2013, 04:13:52 PM by ymg »

#### ronjonp

• Needs a day job
• Posts: 7327
##### Re: Help Finding Block Route
« Reply #28 on: August 19, 2013, 04:48:47 PM »
YMG,

Thanks for looking into this for me. Unfortunately I have some "real" work to do    right now so this is on the back burner. I hope to look at it later in the month.

Thanks,

Ron

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

#### ribarm

• Gator
• Posts: 2527
• Marko Ribar, architect
##### Re: Help Finding Block Route
« Reply #29 on: August 20, 2013, 11:35:41 AM »
I feel I should thank to ymg for brilliant Dijikstra algorithm... So here are some codes based on it...

THIS IS FOR TIN NETWORK

Code - Auto/Visual Lisp: [Select]
1. (defun unique ( linlst )
2.   (if (car linlst) (cons (car linlst) (unique (_vl-remove (car linlst) (_vl-remove (list (cadar linlst) (caar linlst)) (cdr linlst) 1e-6) 1e-6))))
3. )
4.
5. (defun _vl-remove ( el lst fuzz )
6.   (vl-remove-if '(lambda ( x ) (and (equal (car x) (car el) fuzz) (equal (cadr x) (cadr el) fuzz))) lst)
7. )
8.
9. (defun eraseduplin ( ss / i lin p1 p2 linlst linlstn )
10.   (setq i -1)
11.   (while (setq lin (ssname ss (setq i (1+ i))))
12.     (setq p1 (cdr (assoc 10 (entget lin)))
13.           p2 (cdr (assoc 11 (entget lin)))
14.     )
15.     (setq linlst (cons (list p1 p2) linlst))
16.     (entdel lin)
17.   )
18.   (setq linlstn (unique linlst))
19.   (foreach lin linlstn
20.     (entmake (list '(0 . "LINE") (cons 10 (car lin)) (cons 11 (cadr lin))))
21.   )
22. )
23.
24. (defun AssocOn ( SearchTerm Lst func fuzz )
25.   (car
26.     (vl-member-if
27.         (lambda (pair) (equal SearchTerm (apply func (list pair)) fuzz))
28.       )
29.       lst
30.     )
31.   )
32. )
33.
34. ; Find the path of minimum total length between two given nodes g and f.      ;
35. ; Using Dijkstra Algorithm                                                    ;
36. ;                                                                             ;
37. ; See http://tech-algorithm.com/articles/dijkstra-algorithm/                  ;
38. ;                                                                             ;
39. ; Written by ymg   August 2013                                                ;
40.
41. (defun minpath ( g f nodes edges s / brname clnodes closedl dst1 dst2 m minpath mp new nodname old oldpos openl totdist )
42.   (setq nodes   (vl-remove g nodes)
43.         openl   (list (list g 0 nil))
44.         closedl nil
45.   )
46.   (foreach n nodes
47.     (setq nodes (subst (list n 0 nil) n nodes))
48.   )
49.   (while (not (equal (caar closedl) f 1e-6))
50.     (setq nodname (caar openl)
51.           totdist (cadar openl)
52.           closedl (cons (car openl) closedl)
53.           openl   (cdr openl)
54.           clnodes (mapcar 'car closedl)
55.
56.     )
57.     (foreach e edges
58.       (setq brname nil)
59.       (if (equal (car e) nodname 1e-6)
60.         (setq brname (cadr e))
61.       )
62.       (if (equal (cadr e) nodname 1e-6)
63.         (setq brname (car e))
64.       )
65.
66.       (if brname
67.           (setq new (list brname (+ (caddr e) totdist) nodname))
68.           (cond
69.             ((member brname clnodes))
70.             ((setq oldpos (vl-position brname (mapcar 'car openl)))
71.              (setq old (nth oldpos openl))
72.              (if (< (cadr new) (cadr old))
73.                (setq openl (subst new old openl))
74.              )
75.             )
76.             (t (setq openl (cons new openl)))
77.           )
78.           (setq edges (vl-remove e edges))
79.         )
80.       )
81.     )
82.     (setq
83.       openl (vl-sort openl
84.                      (function (lambda (a b) (< (cadr a) (cadr b))))
85.             )
86.     )
87.   )
88.   (setq minpath (list (car closedl)))
89.   (setq dst1 (cadr (car closedl)))
90.   (setq m 1)
91.   (foreach k closedl
92.     (setq dst2 (cadr k))
93.     (if (not (equal dst1 dst2 1e-6)) (setq m (1+ m) dst1 dst2))
94.   )
95.   (repeat m
96.     (foreach n closedl
97.       (if (equal (car n) (caddr (car minpath)) 1e-6)
98.         (setq mp (cons n mp))
99.       )
100.     )
101.     (setq
102.       mp (vl-sort mp
103.                   (function (lambda (a b) (s (vl-position (assocon (caddr a) closedl 'car 1e-6) closedl) (vl-position (assocon (caddr b) closedl 'car 1e-6) closedl))))
104.          )
105.     )
106.     (setq minpath (cons (car mp) minpath))
107.     (setq mp nil)
108.   )
109.   (vl-remove nil minpath)
110. )
111.
112. (defun make3dpl ( ptlst )
113.     (list
114.       '(0 . "POLYLINE")
115.       '(100 . "AcDbEntity")
116.       '(100 . "AcDb3dPolyline")
117.       '(66 . 1)
118.       '(62 . 3)
119.       '(10 0.0 0.0 0.0)
120.       '(70 . 8)
121.       '(210 0.0 0.0 1.0)
122.     )
123.   )
124.   (foreach pt ptlst
125.       (list
126.         '(0 . "VERTEX")
127.         '(100 . "AcDbEntity")
128.         '(100 . "AcDbVertex")
129.         '(100 . "AcDb3dPolylineVertex")
130.         (cons 10 pt)
131.         '(70 . 32)
132.       )
133.     )
134.   )
135.     (list
136.       '(0 . "SEQEND")
137.       '(100 . "AcDbEntity")
138.     )
139.   )
140. )
141.
142. (defun c:shorttinpath ( / osm ss i 3df lin p1 p2 p3 linlst ptlst g f dijkstra1 ptlstpth1 dijkstra2 ptlstpth2 )
143.   (setq osm (getvar 'osmode))
144.   (setq ss (ssget "_:L" '((0 . "3DFACE") (8 . "*TIN"))))
145.   (setq i -1)
146.   (while (setq 3df (ssname ss (setq i (1+ i))))
147.     (setq p1 (cdr (assoc 11 (entget 3df)))
148.           p2 (cdr (assoc 12 (entget 3df)))
149.           p3 (cdr (assoc 13 (entget 3df)))
150.     )
151.     (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
152.     (entmake (list '(0 . "LINE") (cons 10 p2) (cons 11 p3)))
153.     (entmake (list '(0 . "LINE") (cons 10 p3) (cons 11 p1)))
154.   )
155.   (setq ss (ssget "_X" (list '(0 . "LINE") (cons 8 (getvar 'clayer)))))
156.   (eraseduplin ss)
157.   (setq ss (ssget "_X" (list '(0 . "LINE") (cons 8 (getvar 'clayer)))))
158.   (setq i -1)
159.   (while (setq lin (ssname ss (setq i (1+ i))))
160.     (setq p1 (cdr (assoc 10 (entget lin)))
161.           p2 (cdr (assoc 11 (entget lin)))
162.     )
163.     (setq linlst (cons (list p1 p2 (distance p1 p2)) linlst))
164.     (setq ptlst (cons p1 ptlst) ptlst (cons p2 ptlst))
165.     (entdel lin)
166.   )
167.   (setq ptlst (acet-list-remove-duplicates ptlst 1e-6))
168.   (setvar 'osmode 1)
169.   (setq g (getpoint "\nPick starting point on TIN : ")
170.         f (getpoint "\nPick ending point on TIN : ")
171.   )
172.   (setq dijkstra1 (minpath g f ptlst linlst >))
173.   (setq ptlstpth1 (mapcar 'car dijkstra1))
174.   (setq dijkstra2 (minpath f g ptlst linlst >))
175.   (setq ptlstpth2 (mapcar 'car dijkstra2))
176.   (setq dijkstra3 (minpath g f ptlst linlst <))
177.   (setq ptlstpth3 (mapcar 'car dijkstra3))
178.   (setq dijkstra4 (minpath f g ptlst linlst <))
179.   (setq ptlstpth4 (mapcar 'car dijkstra4))
180.   (make3dpl ptlstpth1)
181.   (make3dpl ptlstpth2)
182.   (make3dpl ptlstpth3)
183.   (make3dpl ptlstpth4)
184.   (setvar 'osmode osm)
185.   (prompt "\nShortest path length is : ") (princ (rtos (cadr (last dijkstra1)))) (prompt " - you should check length of all 4 3d polylines to match data")
186.   (textscr)
187.   (princ)
188. )
189.

THIS IS FOR LINES NETWORK

Code - Auto/Visual Lisp: [Select]
1. ; Find the path of minimum total length between two given nodes g and f.      ;
2. ; Using Dijkstra Algorithm                                                    ;
3. ;                                                                             ;
4. ; See http://tech-algorithm.com/articles/dijkstra-algorithm/                  ;
5. ;                                                                             ;
6. ; Written by ymg   August 2013                                                ;
7.
8. (defun minpath ( g f nodes edges s / brname clnodes closedl dst1 dst2 m minpath mp new nodname old oldpos openl totdist )
9.   (setq nodes   (vl-remove g nodes)
10.         openl   (list (list g 0 nil))
11.         closedl nil
12.   )
13.   (foreach n nodes
14.     (setq nodes (subst (list n 0 nil) n nodes))
15.   )
16.   (while (not (equal (caar closedl) f 1e-6))
17.     (setq nodname (caar openl)
18.           totdist (cadar openl)
19.           closedl (cons (car openl) closedl)
20.           openl   (cdr openl)
21.           clnodes (mapcar 'car closedl)
22.
23.     )
24.     (foreach e edges
25.       (setq brname nil)
26.       (if (equal (car e) nodname 1e-6)
27.         (setq brname (cadr e))
28.       )
29.       (if (equal (cadr e) nodname 1e-6)
30.         (setq brname (car e))
31.       )
32.
33.       (if brname
34.           (setq new (list brname (+ (caddr e) totdist) nodname))
35.           (cond
36.             ((member brname clnodes))
37.             ((setq oldpos (vl-position brname (mapcar 'car openl)))
38.              (setq old (nth oldpos openl))
39.              (if (< (cadr new) (cadr old))
40.                (setq openl (subst new old openl))
41.              )
42.             )
43.             (t (setq openl (cons new openl)))
44.           )
45.           (setq edges (vl-remove e edges))
46.         )
47.       )
48.     )
49.     (setq
50.       openl (vl-sort openl
51.                      (function (lambda (a b) (< (cadr a) (cadr b))))
52.             )
53.     )
54.   )
55.   (setq minpath (list (car closedl)))
56.   (setq dst1 (cadr (car closedl)))
57.   (setq m 1)
58.   (foreach k closedl
59.     (setq dst2 (cadr k))
60.     (if (not (equal dst1 dst2 1e-6)) (setq m (1+ m) dst1 dst2))
61.   )
62.   (repeat m
63.     (foreach n closedl
64.       (if (equal (car n) (caddr (car minpath)) 1e-6)
65.         (setq mp (cons n mp))
66.       )
67.     )
68.     (setq
69.       mp (vl-sort mp
70.                   (function (lambda (a b) (s (vl-position (assocon (caddr a) closedl 'car 1e-6) closedl) (vl-position (assocon (caddr b) closedl 'car 1e-6) closedl))))
71.          )
72.     )
73.     (setq minpath (cons (car mp) minpath))
74.     (setq mp nil)
75.   )
76.   (vl-remove nil minpath)
77. )
78.
79. (defun AssocOn ( SearchTerm Lst func fuzz )
80.   (car
81.     (vl-member-if
82.         (lambda (pair) (equal SearchTerm (apply func (list pair)) fuzz))
83.       )
84.       lst
85.     )
86.   )
87. )
88.
89. (defun make3dpl ( ptlst )
90.     (list
91.       '(0 . "POLYLINE")
92.       '(100 . "AcDbEntity")
93.       '(100 . "AcDb3dPolyline")
94.       '(66 . 1)
95.       '(62 . 3)
96.       '(10 0.0 0.0 0.0)
97.       '(70 . 8)
98.       '(210 0.0 0.0 1.0)
99.     )
100.   )
101.   (foreach pt ptlst
102.       (list
103.         '(0 . "VERTEX")
104.         '(100 . "AcDbEntity")
105.         '(100 . "AcDbVertex")
106.         '(100 . "AcDb3dPolylineVertex")
107.         (cons 10 pt)
108.         '(70 . 32)
109.       )
110.     )
111.   )
112.     (list
113.       '(0 . "SEQEND")
114.       '(100 . "AcDbEntity")
115.     )
116.   )
117. )
118.
119. (defun c:shortlinespath ( / osm ss i lin p1 p2 linlst ptlst g f dijkstra1 ptlstpth1 dijkstra2 ptlstpth2 )
120.   (setq osm (getvar 'osmode))
121.   (setq ss (ssget "_:L" '((0 . "LINE"))))
122.   (setq i -1)
123.   (while (setq lin (ssname ss (setq i (1+ i))))
124.     (setq p1 (cdr (assoc 10 (entget lin)))
125.           p2 (cdr (assoc 11 (entget lin)))
126.     )
127.     (setq linlst (cons (list p1 p2 (distance p1 p2)) linlst))
128.     (setq ptlst (cons p1 ptlst) ptlst (cons p2 ptlst))
129.   )
130.   (setq ptlst (acet-list-remove-duplicates ptlst 1e-6))
131.   (setvar 'osmode 1)
132.   (setq g (getpoint "\nPick starting point on LINES NETWORK : ")
133.         f (getpoint "\nPick ending point on LINES NETWORK : ")
134.   )
135.   (setq dijkstra1 (minpath g f ptlst linlst >))
136.   (setq ptlstpth1 (mapcar 'car dijkstra1))
137.   (setq dijkstra2 (minpath f g ptlst linlst >))
138.   (setq ptlstpth2 (mapcar 'car dijkstra2))
139.   (setq dijkstra3 (minpath g f ptlst linlst <))
140.   (setq ptlstpth3 (mapcar 'car dijkstra3))
141.   (setq dijkstra4 (minpath f g ptlst linlst <))
142.   (setq ptlstpth4 (mapcar 'car dijkstra4))
143.   (make3dpl ptlstpth1)
144.   (make3dpl ptlstpth2)
145.   (make3dpl ptlstpth3)
146.   (make3dpl ptlstpth4)
147.   (setvar 'osmode osm)
148.   (prompt "\nShortest path length is : ") (princ (rtos (cadr (last dijkstra1)))) (prompt " - you should check length of all 4 3d polylines to match data")
149.   (textscr)
150.   (princ)
151. )
152.

And this one removes duplicate lines and 0 lines - it's different from overkill, for it doesn't combine overlapped lines into big line - it just removes sufficient ones...

Code: [Select]
(defun unique ( linlst )
(if (car linlst) (cons (car linlst) (unique (_vl-remove (car linlst) (_vl-remove (list (cadar linlst) (caar linlst)) (cdr linlst) 1e-6) 1e-6))))
)

(defun _vl-remove ( el lst fuzz )
(vl-remove-if '(lambda ( x ) (and (equal (car x) (car el) fuzz) (equal (cadr x) (cadr el) fuzz))) lst)
)

(defun eraseduplin ( ss / i lin p1 p2 lay linlst linlstn )
(setq i -1)
(while (setq lin (ssname ss (setq i (1+ i))))
(setq p1 (cdr (assoc 10 (entget lin)))
p2 (cdr (assoc 11 (entget lin)))
lay (cdr (assoc 8 (entget lin)))
)
(setq linlst (cons (list p1 p2) linlst))
(entdel lin)
)
(setq linlstn (unique linlst))
(foreach lin linlstn
(entmake (list '(0 . "LINE") (cons 8 lay) (cons 10 (car lin)) (cons 11 (cadr lin))))
)
)

(defun c:eraseduplines-0lines ( / ss s i lin )
(setq ss (ssget "_:L" '((0 . "LINE"))))
(setq i -1)
(while (setq lin (ssname ss (setq i (1+ i))))
(if (equal (cdr (assoc 10 (entget lin))) (cdr (assoc 11 (entget lin))) 1e-6) (entdel lin) (ssadd lin s))
)
(eraseduplin s)
(princ)
)

(defun c:ed0l nil (c:eraseduplines-0lines))

M.R.
« Last Edit: August 22, 2013, 06:09:36 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)