Jump to content
EniSan

Possible paths and ordered according to criteria

Recommended Posts

EniSan

Hello, I'm a beginner in autolisp and I'm having trouble making a code that does the following:
I provide a list L containing some sublists and two points S and F belonging to the sublists. I want obtain a return list R containing all possible paths starting at S and ending at F ordered by total path length (last element of each sublist).
Example:

 

(setq S (list 3.0 0.0 1.5))
(setq F (list 2.5 4.5 3.0))

(setq L
    (list
        (list (list 3.0 0.0 1.5) (list 0.0 2.5 1.5) (list 3.90512))
        (list (list 0.0 2.5 1.5) (list 0.0 2.5 3.0) (list 2.5 3.5 3.0) (list 4.19258))
        (list (list 3.0 0.0 1.5) (list 5.0 0.0 1.5) (list 5.0 2.5 1.5) (list 4.5))
        (list (list 5.0 2.5 1.5) (list 2.5 3.5 3.0) (list 3.08221))
        (list (list 5.0 2.5 1.5) (list 5.0 6.5 1.5) (list 4.0))
        (list (list 2.5 3.5 3.0) (list 5.0 2.5 1.5) (list 3.08221))
        (list (list 2.5 3.5 3.0) (list 2.5 4.5 3.0) (list 1.0))
        (list (list 2.5 3.5 3.0) (list 0.0 2.5 3.0) (list 0.0 2.5 1.5) (list 4.19258))
        (list (list 5.0 6.5 1.5) (list 5.0 2.5 1.5) (list 4.0))
        (list (list 5.0 6.5 1.5) (list 5.0 6.5 3.0) (list 2.5 5.5 3.0) (list 4.19258))
        (list (list 5.0 6.5 1.5) (list 5.0 6.5 0.0) (list 2.0 7.5 0.0) (list 2.0 7.5 0.3) (list 4.96228))
        (list (list 2.5 5.5 3.0) (list 0.8 6.0 0.0) (list 3.48425))
        (list (list 2.5 5.5 3.0) (list 5.0 6.5 3.0) (list 5.0 6.5 1.5) (list 4.19258))
        (list (list 2.5 5.5 3.0) (list 2.5 4.5 3.0) (list 1.0))
        (list (list 2.0 7.5 0.3) (list 2.0 7.5 0.0) (list 5.0 6.5 0.0) (list 5.0 6.5 1.5) (list 4.96228))
        (list (list 2.0 7.5 0.3) (list 2.0 7.5 0.0) (list 0.8 6.0 0.0) (list 2.22094))
        (list (list 0.8 6.0 0.0) (list 2.5 5.5 3.0) (list 3.48425))
        (list (list 0.8 6.0 0.0) (list 2.0 7.5 0.0) (list 2.0 7.5 0.3) (list 2.22094))
    )
)

 

The expected return


R = ((((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0))(8.58221))

(((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0)) (9.0977))

(((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (13.69258))

(((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (20.16747))

(((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (20.37249))

(((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (26.84738)))

 

I tried to get the return using foreach inside a while loop but I can only get infinite loop.
Can someone help me?
Thank you.

 

Share this post


Link to post
Share on other sites
devitg

Please correct me , but as far as I can see , there is no such list , that hold  s and f . 

 

It seem to be you are selecting  polylines ,  with the same start and end points having unequal length. 

 

Please broaden your concept, or explain WHAT to do , and not HOW to do. It is common misunderstanding when asking for help. 

 

Best regards

 

 

 

 

 

 

 

Share this post


Link to post
Share on other sites
BIGAL
Posted (edited)

like Devitg your S & F are a single point, but the next list is made up of a list of 3 points, so what is shortest path compared to the  3points need an image. Are the 3 points 3dfaces triangles etc.

 

Is this slicing 3dfaces as in contours etc ?

Edited by BIGAL

Share this post


Link to post
Share on other sites
devitg

I did a dwg with such points , there in no one that hold S and F , I add a list to the L

(SETQ S (LIST 3.0 0.0 1.5))
(SETQ F (LIST 2.5 4.5 3.0))
(setq SF-DIST (DISTANCE S F ))  

(SETQ L-LIST
       (LIST
         (LIST (LIST 3.0 0.0 1.5) (LIST 0.0 2.5 1.5) (LIST 3.90512))
         (LIST (LIST 0.0 2.5 1.5) (LIST 0.0 2.5 3.0) (LIST 2.5 3.5 3.0) (LIST 4.19258))
         (LIST (LIST 3.0 0.0 1.5) (LIST 5.0 0.0 1.5) (LIST 5.0 2.5 1.5) (LIST 4.5))
         (LIST (LIST 5.0 2.5 1.5) (LIST 2.5 3.5 3.0) (LIST 3.08221))
         (LIST (LIST 5.0 2.5 1.5) (LIST 5.0 6.5 1.5) (LIST 4.0))
         (LIST (LIST 2.5 3.5 3.0) (LIST 5.0 2.5 1.5) (LIST 3.08221))
         (LIST (LIST 2.5 3.5 3.0) (LIST 2.5 4.5 3.0) (LIST 1.0))
         (LIST (LIST 2.5 3.5 3.0) (LIST 0.0 2.5 3.0) (LIST 0.0 2.5 1.5) (LIST 4.19258))
         (LIST (LIST 5.0 6.5 1.5) (LIST 5.0 2.5 1.5) (LIST 4.0))
         (LIST (LIST 5.0 6.5 1.5) (LIST 5.0 6.5 3.0) (LIST 2.5 5.5 3.0) (LIST 4.19258))
         (LIST (LIST 5.0 6.5 1.5) (LIST 5.0 6.5 0.0) (LIST 2.0 7.5 0.0) (LIST 2.0 7.5 0.3) (LIST 4.96228))
         (LIST (LIST 2.5 5.5 3.0) (LIST 0.8 6.0 0.0) (LIST 3.48425))
         (LIST (LIST 2.5 5.5 3.0) (LIST 5.0 6.5 3.0) (LIST 5.0 6.5 1.5) (LIST 4.19258))
         (LIST (LIST 2.5 5.5 3.0) (LIST 2.5 4.5 3.0) (LIST 1.0))
         (LIST (LIST 2.0 7.5 0.3) (LIST 2.0 7.5 0.0) (LIST 5.0 6.5 0.0) (LIST 5.0 6.5 1.5) (LIST 4.96228))
         (LIST (LIST 2.0 7.5 0.3) (LIST 2.0 7.5 0.0) (LIST 0.8 6.0 0.0) (LIST 2.22094))
         (LIST (LIST 0.8 6.0 0.0) (LIST 2.5 5.5 3.0) (LIST 3.48425))
         (LIST (LIST 0.8 6.0 0.0) (LIST 2.0 7.5 0.0) (LIST 2.0 7.5 0.3) (LIST 2.22094))
         (list s f (LIST SF-DIST)) ;; new list to match S and F 
         
         )
      )

And it give ONE red 3dpoly . 

 

NO ONE START AND F.dwg ONE START AND F.dwg

Share this post


Link to post
Share on other sites
devitg
51 minutes ago, BIGAL said:

like Devitg your S & F are a single point, but the next list is made up of a list of 3 points, so what is shortest path compared to the  3points need an image. Are the 3 points 3dfaces triangles etc.

 

Is this slicing 3dfaces as in contours etc ?

Hi BIGAL , it seem to be it are 3dpoly points , as some list have 3 and 4  points + the distance

 

         (LIST (LIST 2.0 7.5 0.3) (LIST 2.0 7.5 0.0) (LIST 5.0 6.5 0.0) (LIST 5.0 6.5 1.5) (LIST 4.96228))
         (LIST (LIST 5.0 6.5 1.5) (LIST 5.0 6.5 3.0) (LIST 2.5 5.5 3.0) (LIST 4.19258))
         (LIST (LIST 5.0 6.5 1.5) (LIST 5.0 6.5 0.0) (LIST 2.0 7.5 0.0) (LIST 2.0 7.5 0.3) (LIST 4.96228))

 

 

 

Share this post


Link to post
Share on other sites
EniSan

Thanks for the comments devitg and BIGAL.
S and F are the Start and Final points of a hypothetical electrical circuit that I created as an exercise. All L sublists are sections of conduit through which the wires will pass. In both L and R, the first point of the sublist is one end, the penultimate point of the sublist is the other end, the last element of each sublist represents its length and the intermediate points are the curve points.
The objective is to know all the ways to connect the point S to the F using the parts (sublists) of L to compose the sublists of R. So if the shortest path (first sublist of R) is not possible for any reason, choose the second shortest path (second sublist of R) and so on.

Share this post


Link to post
Share on other sites
marko_ribar
Posted (edited)

Here is my attempt, but it's just an attempt... I built trees with branches... After trees are built you still have to convert all possible paths to linear forms - not like tree (nested lists)... Anyway this one was tricky and for me and plus I don't really have a time to play further... I hope you can skin something from my silly coding...

 

(setq S (list 3.0 0.0 1.5))
(setq F (list 2.5 4.5 3.0))

(setq L
    (list
        (list (list 3.0 0.0 1.5) (list 0.0 2.5 1.5) (list 3.90512))
        (list (list 0.0 2.5 1.5) (list 0.0 2.5 3.0) (list 2.5 3.5 3.0) (list 4.19258))
        (list (list 3.0 0.0 1.5) (list 5.0 0.0 1.5) (list 5.0 2.5 1.5) (list 4.5))
        (list (list 5.0 2.5 1.5) (list 2.5 3.5 3.0) (list 3.08221))
        (list (list 5.0 2.5 1.5) (list 5.0 6.5 1.5) (list 4.0))
        (list (list 2.5 3.5 3.0) (list 5.0 2.5 1.5) (list 3.08221))
        (list (list 2.5 3.5 3.0) (list 2.5 4.5 3.0) (list 1.0))
        (list (list 2.5 3.5 3.0) (list 0.0 2.5 3.0) (list 0.0 2.5 1.5) (list 4.19258))
        (list (list 5.0 6.5 1.5) (list 5.0 2.5 1.5) (list 4.0))
        (list (list 5.0 6.5 1.5) (list 5.0 6.5 3.0) (list 2.5 5.5 3.0) (list 4.19258))
        (list (list 5.0 6.5 1.5) (list 5.0 6.5 0.0) (list 2.0 7.5 0.0) (list 2.0 7.5 0.3) (list 4.96228))
        (list (list 2.5 5.5 3.0) (list 0.8 6.0 0.0) (list 3.48425))
        (list (list 2.5 5.5 3.0) (list 5.0 6.5 3.0) (list 5.0 6.5 1.5) (list 4.19258))
        (list (list 2.5 5.5 3.0) (list 2.5 4.5 3.0) (list 1.0))
        (list (list 2.0 7.5 0.3) (list 2.0 7.5 0.0) (list 5.0 6.5 0.0) (list 5.0 6.5 1.5) (list 4.96228))
        (list (list 2.0 7.5 0.3) (list 2.0 7.5 0.0) (list 0.8 6.0 0.0) (list 2.22094))
        (list (list 0.8 6.0 0.0) (list 2.5 5.5 3.0) (list 3.48425))
        (list (list 0.8 6.0 0.0) (list 2.0 7.5 0.0) (list 2.0 7.5 0.3) (list 2.22094))
    )
)

;| - return
(
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0)) (8.58221))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0)) (9.0977))
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (13.69258))
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (20.16747))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (20.37249))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (26.84738))
)
|;

(defun processtrees ( L S F / nextbranches recurse unique ll lll loop tree trees treesold branches )

  (defun nextbranches ( l1 l )
    (vl-remove-if-not '(lambda ( x ) (equal (last l1) (car x) 1e-6)) l)
  )

  (defun recurse ( l tree )
    (if (listp (car l))
      (mapcar '(lambda ( a ) (cons (car a) (recurse (mapcar '(lambda ( x ) (if (assoc x tree) (list (assoc x tree)) (list x))) (cadr a)) tree))) l)
    )
  )

  (defun unique ( l )
    (if l (cons (car l) (unique (vl-remove-if '(lambda ( x ) (equal x (car l) 1e-6)) l))))
  )

  (setq l (mapcar '(lambda ( x ) (vl-remove-if '(lambda ( y ) (equal y (last x))) x)) L))
  (setq ll (vl-remove-if-not '(lambda ( x ) (equal (car x) S 1e-6)) l))
  (setq lll (vl-remove-if '(lambda ( x ) (vl-position x ll)) l))
  (setq tree ll loop t)
  (while loop
    (setq treesold trees)
    (foreach l1 tree
      (setq branches (nextbranches l1 (vl-remove l1 lll)))
      (if branches
        (progn
          (setq branches (list l1 branches))
          (setq tree (subst branches l1 tree))
        )
        (setq tree (vl-remove l1 tree))
      )
    )
    (if (null trees)
      (setq trees tree)
      (setq trees (recurse trees tree))
    )
    (setq tree (unique (apply 'append (mapcar 'cadr tree))))
    (if (equal treesold trees 1e-6)
      (setq loop nil)
    )
  )
  trees
)

;;; (processtrees l s f)

Regards, M.R.

Edited by marko_ribar

Share this post


Link to post
Share on other sites
devitg
11 hours ago, EniSan said:

Thanks for the comments devitg and BIGAL.
S and F are the Start and Final points of a hypothetical electrical circuit that I created as an exercise. All L sublists are sections of conduit through which the wires will pass. In both L and R, the first point of the sublist is one end, the penultimate point of the sublist is the other end, the last element of each sublist represents its length and the intermediate points are the curve points.
The objective is to know all the ways to connect the point S to the F using the parts (sublists) of L to compose the sublists of R. So if the shortest path (first sublist of R) is not possible for any reason, choose the second shortest path (second sublist of R) and so on.

Please clear , why there is no sublist at  L that hold  S and F  ? 

Or did I not understood the problem 

 . 

Share this post


Link to post
Share on other sites
ronjonp

You might look at THIS code to find the shortest path.

Share this post


Link to post
Share on other sites
EniSan
11 hours ago, devitg said:

Please clear , why there is no sublist at  L that hold  S and F  ? 

Or did I not understood the problem 

 . 

Hello devitg. I will try to explain it better.
Each 3D coordinate within the sublists of L are ends or curves of conduits previously existing in a hypothetical installation. If there was a sublist of L that simultaneously contained S and F, it would probably be the first item of R because it would be the shortest possible path between points S and F on the condition that it only uses items from L.
The challenge in this is to compose R associating the possible and immutable parts existing (sublists of L) because the wires of our circuit must necessarily pass through the conduits and it is desirable to know which are the shortest possible paths to provide more savings.
So any other 3D point at the ends of any sublist of L could be chosen as S or F. If you look at the values of the sublists of R in the initial post you will notice that they all start at S, end at F and contain the total length of the path composed only of the sublists of L.
Example:
(nth 0 R) = (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0)) (8.58221 ))
It is given by the association of (nth 2 L), (nth 3 L), (nth 6 L) adding their respective lengths and placing the resulting sum in the last element. Thus the shortest path from S to F under the desired conditions measures 8.58221 and is composed of 3 elements of L (which are stretches of conduits).

 

Share this post


Link to post
Share on other sites
EniSan
13 hours ago, marko_ribar said:

Here is my attempt, but it's just an attempt... I built trees with branches... After trees are built you still have to convert all possible paths to linear forms - not like tree (nested lists)... Anyway this one was tricky and for me and plus I don't really have a time to play further... I hope you can skin something from my silly coding...

 


(setq S (list 3.0 0.0 1.5))
(setq F (list 2.5 4.5 3.0))

(setq L
    (list
        (list (list 3.0 0.0 1.5) (list 0.0 2.5 1.5) (list 3.90512))
        (list (list 0.0 2.5 1.5) (list 0.0 2.5 3.0) (list 2.5 3.5 3.0) (list 4.19258))
        (list (list 3.0 0.0 1.5) (list 5.0 0.0 1.5) (list 5.0 2.5 1.5) (list 4.5))
        (list (list 5.0 2.5 1.5) (list 2.5 3.5 3.0) (list 3.08221))
        (list (list 5.0 2.5 1.5) (list 5.0 6.5 1.5) (list 4.0))
        (list (list 2.5 3.5 3.0) (list 5.0 2.5 1.5) (list 3.08221))
        (list (list 2.5 3.5 3.0) (list 2.5 4.5 3.0) (list 1.0))
        (list (list 2.5 3.5 3.0) (list 0.0 2.5 3.0) (list 0.0 2.5 1.5) (list 4.19258))
        (list (list 5.0 6.5 1.5) (list 5.0 2.5 1.5) (list 4.0))
        (list (list 5.0 6.5 1.5) (list 5.0 6.5 3.0) (list 2.5 5.5 3.0) (list 4.19258))
        (list (list 5.0 6.5 1.5) (list 5.0 6.5 0.0) (list 2.0 7.5 0.0) (list 2.0 7.5 0.3) (list 4.96228))
        (list (list 2.5 5.5 3.0) (list 0.8 6.0 0.0) (list 3.48425))
        (list (list 2.5 5.5 3.0) (list 5.0 6.5 3.0) (list 5.0 6.5 1.5) (list 4.19258))
        (list (list 2.5 5.5 3.0) (list 2.5 4.5 3.0) (list 1.0))
        (list (list 2.0 7.5 0.3) (list 2.0 7.5 0.0) (list 5.0 6.5 0.0) (list 5.0 6.5 1.5) (list 4.96228))
        (list (list 2.0 7.5 0.3) (list 2.0 7.5 0.0) (list 0.8 6.0 0.0) (list 2.22094))
        (list (list 0.8 6.0 0.0) (list 2.5 5.5 3.0) (list 3.48425))
        (list (list 0.8 6.0 0.0) (list 2.0 7.5 0.0) (list 2.0 7.5 0.3) (list 2.22094))
    )
)

;| - return
(
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0)) (8.58221))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0)) (9.0977))
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (13.69258))
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (20.16747))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (20.37249))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (26.84738))
)
|;

(defun processtrees ( L S F / nextbranches recurse unique ll lll loop tree trees treesold branches )

  (defun nextbranches ( l1 l )
    (vl-remove-if-not '(lambda ( x ) (equal (last l1) (car x) 1e-6)) l)
  )

  (defun recurse ( l tree )
    (if (listp (car l))
      (mapcar '(lambda ( a ) (cons (car a) (recurse (mapcar '(lambda ( x ) (if (assoc x tree) (list (assoc x tree)) (list x))) (cadr a)) tree))) l)
    )
  )

  (defun unique ( l )
    (if l (cons (car l) (unique (vl-remove-if '(lambda ( x ) (equal x (car l) 1e-6)) l))))
  )

  (setq l (mapcar '(lambda ( x ) (vl-remove-if '(lambda ( y ) (equal y (last x))) x)) L))
  (setq ll (vl-remove-if-not '(lambda ( x ) (equal (car x) S 1e-6)) l))
  (setq lll (vl-remove-if '(lambda ( x ) (vl-position x ll)) l))
  (setq tree ll loop t)
  (while loop
    (setq treesold trees)
    (foreach l1 tree
      (setq branches (nextbranches l1 (vl-remove l1 lll)))
      (if branches
        (progn
          (setq branches (list l1 branches))
          (setq tree (subst branches l1 tree))
        )
        (setq tree (vl-remove l1 tree))
      )
    )
    (if (null trees)
      (setq trees tree)
      (setq trees (recurse trees tree))
    )
    (setq tree (unique (apply 'append (mapcar 'cadr tree))))
    (if (equal treesold trees 1e-6)
      (setq loop nil)
    )
  )
  trees
)

;;; (processtrees l s f)

Regards, M.R.

Thanks for the contribution marko_ribar.
I will try to convert the given return into a list.

Share this post


Link to post
Share on other sites
EniSan
10 hours ago, ronjonp said:

You might look at THIS code to find the shortest path.

Thanks for the contribution ronjonp.
I looked at the post and I think it's similar to what I want.
But I was unable to run the code because the following functions are not working in my autocad:
vlax-curve-getclosestpointto
acet-list-remove-duplicates

I also didn't quite understand how to create edges in my case. In addition to being a beginner and not fully understanding the use of cons mapcar and lambda.
 

Share this post


Link to post
Share on other sites
marko_ribar
Posted (edited)

Now I analyzed your partial sub lists of points and came to conclusion that you actually have the same paths only with reversing some of them... When you process those, it may came to infinite cycling between 2 of them (opposites)... So now I decided to exclude some of them as sufficient and now I discarded poor recursion that don't do all possibilities to the end... All I managed now is finding connections between each of them searching from starting lists of points... So if you can, also skin something from this... I commented my observations and I suggest that you accept them as good facts and use my revised original list of sub lists...

 

(setq S (list 3.0 0.0 1.5))
(setq F (list 2.5 4.5 3.0))

(setq L
    (list
        (list (list 0.0 2.5 1.5) (list 0.0 2.5 3.0) (list 2.5 3.5 3.0) (list 4.19258)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 2.5 3.5 3.0) (list 0.0 2.5 3.0) (list 0.0 2.5 1.5) (list 4.19258)) ;;; These two are the same only reversed causing never ending looping
        (list (list 5.0 2.5 1.5) (list 2.5 3.5 3.0) (list 3.08221)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 2.5 3.5 3.0) (list 5.0 2.5 1.5) (list 3.08221)) ;;; These two are the same only reversed causing never ending looping
        (list (list 5.0 6.5 1.5) (list 5.0 6.5 0.0) (list 2.0 7.5 0.0) (list 2.0 7.5 0.3) (list 4.96228)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 2.0 7.5 0.3) (list 2.0 7.5 0.0) (list 5.0 6.5 0.0) (list 5.0 6.5 1.5) (list 4.96228)) ;;; These two are the same only reversed causing never ending looping
        (list (list 2.0 7.5 0.3) (list 2.0 7.5 0.0) (list 0.8 6.0 0.0) (list 2.22094)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 0.8 6.0 0.0) (list 2.0 7.5 0.0) (list 2.0 7.5 0.3) (list 2.22094)) ;;; These two are the same only reversed causing never ending looping
        (list (list 5.0 6.5 1.5) (list 5.0 6.5 3.0) (list 2.5 5.5 3.0) (list 4.19258)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 2.5 5.5 3.0) (list 5.0 6.5 3.0) (list 5.0 6.5 1.5) (list 4.19258)) ;;; These two are the same only reversed causing never ending looping
        (list (list 0.8 6.0 0.0) (list 2.5 5.5 3.0) (list 3.48425)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 2.5 5.5 3.0) (list 0.8 6.0 0.0) (list 3.48425)) ;;; These two are the same only reversed causing never ending looping
        (list (list 5.0 2.5 1.5) (list 5.0 6.5 1.5) (list 4.0)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 5.0 6.5 1.5) (list 5.0 2.5 1.5) (list 4.0)) ;;; These two are the same only reversed causing never ending looping
        (list (list 3.0 0.0 1.5) (list 0.0 2.5 1.5) (list 3.90512))
        (list (list 3.0 0.0 1.5) (list 5.0 0.0 1.5) (list 5.0 2.5 1.5) (list 4.5))
        (list (list 2.5 3.5 3.0) (list 2.5 4.5 3.0) (list 1.0))
        (list (list 2.5 5.5 3.0) (list 2.5 4.5 3.0) (list 1.0))
    )
)

;| - return
(
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0)) (8.58221))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0)) (9.0977))
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (13.69258))
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (20.16747))

  last 2 results are somewhat bad as they are using excluded ((2.5 3.5 3.0) (5.0 2.5 1.5))

  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (20.37249))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (26.84738))
)
|;

(defun processtrees ( L S F / nextbranches unique ll lll loop tree treex trees treesold branches flag )

  (defun nextbranches ( l1 l )
    (vl-remove-if-not '(lambda ( x ) (equal (last l1) (car x) 1e-6)) l)
  )

  (defun unique ( l )
    (if l (cons (car l) (unique (vl-remove-if '(lambda ( x ) (equal x (car l) 1e-6)) l))))
  )

  (setq l (mapcar '(lambda ( x ) (vl-remove-if '(lambda ( y ) (equal y (last x))) x)) L))
  (setq ll (vl-remove-if-not '(lambda ( x ) (equal (car x) S 1e-6)) l))
  (setq lll (vl-remove-if '(lambda ( x ) (vl-position x ll)) l))
  (setq tree ll loop t)
  (while loop
    (setq treesold trees)
    (foreach l1 tree
      (if (null flag)
        (setq tree nil)
      )
      (setq branches (nextbranches l1 (vl-remove l1 lll)))
      (if branches
        (progn
          (setq treex (mapcar '(lambda ( x ) (list l1 x)) branches))
          (if treex
            (setq trees (append treex trees))
          )
          (setq treex nil)
        )
        (progn
          (setq treex l1)
          (if treex
            (setq trees (cons treex trees))
          )
          (setq treex nil)
        )
      )
      (setq flag t)
      (setq tree (append tree branches))
    )
    (setq flag nil)
    (if (equal treesold (setq trees (unique trees)) 1e-6)
      (setq loop nil)
    )
  )
  trees
)

;;; (processtrees l s f)

 

Edited by marko_ribar

Share this post


Link to post
Share on other sites
marko_ribar
Posted (edited)

I've extended my latest code, and I did get those 4 solutions with my revised initial list... So in initial list there must be no reversals... Here you go :

 

(setq S (list 3.0 0.0 1.5))
(setq F (list 2.5 4.5 3.0))

(setq L
    (list
        (list (list 0.0 2.5 1.5) (list 0.0 2.5 3.0) (list 2.5 3.5 3.0) (list 4.19258)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 2.5 3.5 3.0) (list 0.0 2.5 3.0) (list 0.0 2.5 1.5) (list 4.19258)) ;;; These two are the same only reversed causing never ending looping
        (list (list 5.0 2.5 1.5) (list 2.5 3.5 3.0) (list 3.08221)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 2.5 3.5 3.0) (list 5.0 2.5 1.5) (list 3.08221)) ;;; These two are the same only reversed causing never ending looping
        (list (list 5.0 6.5 1.5) (list 5.0 6.5 0.0) (list 2.0 7.5 0.0) (list 2.0 7.5 0.3) (list 4.96228)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 2.0 7.5 0.3) (list 2.0 7.5 0.0) (list 5.0 6.5 0.0) (list 5.0 6.5 1.5) (list 4.96228)) ;;; These two are the same only reversed causing never ending looping
        (list (list 2.0 7.5 0.3) (list 2.0 7.5 0.0) (list 0.8 6.0 0.0) (list 2.22094)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 0.8 6.0 0.0) (list 2.0 7.5 0.0) (list 2.0 7.5 0.3) (list 2.22094)) ;;; These two are the same only reversed causing never ending looping
        (list (list 5.0 6.5 1.5) (list 5.0 6.5 3.0) (list 2.5 5.5 3.0) (list 4.19258)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 2.5 5.5 3.0) (list 5.0 6.5 3.0) (list 5.0 6.5 1.5) (list 4.19258)) ;;; These two are the same only reversed causing never ending looping
        (list (list 0.8 6.0 0.0) (list 2.5 5.5 3.0) (list 3.48425)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 2.5 5.5 3.0) (list 0.8 6.0 0.0) (list 3.48425)) ;;; These two are the same only reversed causing never ending looping
        (list (list 5.0 2.5 1.5) (list 5.0 6.5 1.5) (list 4.0)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 5.0 6.5 1.5) (list 5.0 2.5 1.5) (list 4.0)) ;;; These two are the same only reversed causing never ending looping
        (list (list 3.0 0.0 1.5) (list 0.0 2.5 1.5) (list 3.90512))
        (list (list 3.0 0.0 1.5) (list 5.0 0.0 1.5) (list 5.0 2.5 1.5) (list 4.5))
        (list (list 2.5 3.5 3.0) (list 2.5 4.5 3.0) (list 1.0))
        (list (list 2.5 5.5 3.0) (list 2.5 4.5 3.0) (list 1.0))
    )
)
(setq l (mapcar '(lambda ( x ) (vl-remove-if '(lambda ( y ) (equal y (last x))) x)) L))

;| - return
(
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0)) (8.58221))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0)) (9.0977))
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (13.69258))
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (20.16747))

  last 2 results are somewhat bad as they are using excluded ((2.5 3.5 3.0) (5.0 2.5 1.5))

  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (20.37249))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (26.84738))
)
|;

(defun processtrees ( L S F / nextbranches unique processtrees-trees k k-rec ll lll loop tree treex trees treesold branches flag lo )

  (defun nextbranches ( l1 l )
    (vl-remove-if-not '(lambda ( x ) (equal (last l1) (car x) 1e-6)) l)
  )

  (defun unique ( l )
    (if l (cons (car l) (unique (vl-remove-if '(lambda ( x ) (equal x (car l) 1e-6)) l))))
  )

  (defun processtrees-trees ( trees / z b ql )
    (setq lo l z -1)
    (foreach x l
      (setq z (1+ z))
      (setq ql (vl-remove-if '(lambda ( y ) (not (equal (last x) (car y) 1e-6))) trees))
      (foreach q ql
        (if (not (vl-position (append (nth z l) q) l))
          (setq l (mapcar '(lambda ( a ) (if (null b) (setq b 0) (setq b (1+ b))) (if (= b z) (append a q) a)) l))
        )
      )
      (setq b nil)
    )
    (if (not (equal lo l 1e-6))
      (processtrees-trees trees)
      l
    )
  )

  (defun k-rec ( xl trees / xx xll )
    (if (null k)
      (setq k 1)
    )
    (foreach x xl
      (setq k (+ k (if (setq xx (vl-remove-if-not '(lambda ( a ) (equal (last (last x)) (caar a) 1e-6)) trees)) (1- (length xx)) 0)))
      (setq xll (append xx xll))
    )
    (if xll
      (k-rec xll trees)
      k
    )
  )

  (setq ll (vl-remove-if-not '(lambda ( x ) (equal (car x) S 1e-6)) l))
  (setq lll (vl-remove-if '(lambda ( x ) (vl-position x ll)) l))
  (setq tree ll loop t)
  (while loop
    (setq treesold trees)
    (foreach l1 tree
      (if (null flag)
        (setq tree nil)
      )
      (setq branches (nextbranches l1 (vl-remove l1 lll)))
      (if branches
        (progn
          (setq treex (mapcar '(lambda ( x ) (list l1 x)) branches))
          (if treex
            (setq trees (append treex trees))
          )
          (setq treex nil)
        )
        (progn
          (setq treex l1)
          (if treex
            (setq trees (cons treex trees))
          )
          (setq treex nil)
        )
      )
      (setq flag t)
      (setq tree (unique (append tree branches)))
    )
    (setq flag nil)
    (if (equal treesold (setq trees (unique trees)) 1e-6)
      (setq loop nil)
    )
  )
  (setq l (vl-remove-if-not '(lambda ( x ) (vl-position S (car x))) trees))
  (foreach x l
    (setq k (k-rec (list x) trees))
    (repeat (1- k)
      (setq l (cons x l))
    )
    (setq k nil)
  )
  (setq l (processtrees-trees trees))
  (setq l (vl-remove-if '(lambda ( x ) (not (equal (last (last x)) F 1e-6))) l))
  (setq l (mapcar '(lambda ( x ) (unique x)) l))
  (setq l (vl-sort l '(lambda ( a b ) (< (apply '+ (mapcar 'distance (apply 'append a) (cdr (apply 'append a)))) (apply '+ (mapcar 'distance (apply 'append b) (cdr (apply 'append b))))))))
)

;;; (processtrees l s f)
;;; (processtrees (mapcar 'reverse l) f s)

Regards, M.R.

HTH.

Edited by marko_ribar

Share this post


Link to post
Share on other sites
EniSan
Posted (edited)
6 hours ago, marko_ribar said:

I've extended my latest code, and I did get those 4 solutions with my revised initial list... So in initial list there must be no reversals... Here you go :

 


(setq S (list 3.0 0.0 1.5))
(setq F (list 2.5 4.5 3.0))

(setq L
    (list
        (list (list 0.0 2.5 1.5) (list 0.0 2.5 3.0) (list 2.5 3.5 3.0) (list 4.19258)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 2.5 3.5 3.0) (list 0.0 2.5 3.0) (list 0.0 2.5 1.5) (list 4.19258)) ;;; These two are the same only reversed causing never ending looping
        (list (list 5.0 2.5 1.5) (list 2.5 3.5 3.0) (list 3.08221)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 2.5 3.5 3.0) (list 5.0 2.5 1.5) (list 3.08221)) ;;; These two are the same only reversed causing never ending looping
        (list (list 5.0 6.5 1.5) (list 5.0 6.5 0.0) (list 2.0 7.5 0.0) (list 2.0 7.5 0.3) (list 4.96228)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 2.0 7.5 0.3) (list 2.0 7.5 0.0) (list 5.0 6.5 0.0) (list 5.0 6.5 1.5) (list 4.96228)) ;;; These two are the same only reversed causing never ending looping
        (list (list 2.0 7.5 0.3) (list 2.0 7.5 0.0) (list 0.8 6.0 0.0) (list 2.22094)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 0.8 6.0 0.0) (list 2.0 7.5 0.0) (list 2.0 7.5 0.3) (list 2.22094)) ;;; These two are the same only reversed causing never ending looping
        (list (list 5.0 6.5 1.5) (list 5.0 6.5 3.0) (list 2.5 5.5 3.0) (list 4.19258)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 2.5 5.5 3.0) (list 5.0 6.5 3.0) (list 5.0 6.5 1.5) (list 4.19258)) ;;; These two are the same only reversed causing never ending looping
        (list (list 0.8 6.0 0.0) (list 2.5 5.5 3.0) (list 3.48425)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 2.5 5.5 3.0) (list 0.8 6.0 0.0) (list 3.48425)) ;;; These two are the same only reversed causing never ending looping
        (list (list 5.0 2.5 1.5) (list 5.0 6.5 1.5) (list 4.0)) ;;; These two are the same only reversed causing never ending looping
;        (list (list 5.0 6.5 1.5) (list 5.0 2.5 1.5) (list 4.0)) ;;; These two are the same only reversed causing never ending looping
        (list (list 3.0 0.0 1.5) (list 0.0 2.5 1.5) (list 3.90512))
        (list (list 3.0 0.0 1.5) (list 5.0 0.0 1.5) (list 5.0 2.5 1.5) (list 4.5))
        (list (list 2.5 3.5 3.0) (list 2.5 4.5 3.0) (list 1.0))
        (list (list 2.5 5.5 3.0) (list 2.5 4.5 3.0) (list 1.0))
    )
)

;| - return
(
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0)) (8.58221))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0)) (9.0977))
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (13.69258))
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (20.16747))

  last 2 results are somewhat bad as they are using excluded ((2.5 3.5 3.0) (5.0 2.5 1.5))

  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (20.37249))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (26.84738))
)
|;

(defun processtrees ( L S F / nextbranches unique processtrees-trees k k-rec ll lll loop tree treex trees treesold branches flag lo )

  (defun nextbranches ( l1 l )
    (vl-remove-if-not '(lambda ( x ) (equal (last l1) (car x) 1e-6)) l)
  )

  (defun unique ( l )
    (if l (cons (car l) (unique (vl-remove-if '(lambda ( x ) (equal x (car l) 1e-6)) l))))
  )

  (defun processtrees-trees ( trees / z b q )
    (setq lo l z -1)
    (foreach x l
      (setq z (1+ z))
      (setq q (car (vl-remove-if '(lambda ( y ) (not (equal (last x) (car y) 1e-6))) trees)))
      (setq l (mapcar '(lambda ( a ) (if (null b) (setq b 0) (setq b (1+ b))) (if (= b z) (append a q) a)) l))
      (setq b nil)
      (setq trees (vl-remove q trees))
    )
    (if (not (equal lo l 1e-6))
      (processtrees-trees trees)
      l
    )
  )

  (defun k-rec ( xl trees )
    (if (null k)
      (setq k 1)
    )
    (foreach x xl
      (setq k (+ k (if (setq xl (vl-remove-if-not '(lambda ( a ) (equal (last (last x)) (caar a) 1e-6)) trees)) (1- (length xl)) 0)))
    )
    (if xl
      (k-rec xl trees)
      k
    )
  )

  (setq l (mapcar '(lambda ( x ) (vl-remove-if '(lambda ( y ) (equal y (last x))) x)) L))
  (setq ll (vl-remove-if-not '(lambda ( x ) (equal (car x) S 1e-6)) l))
  (setq lll (vl-remove-if '(lambda ( x ) (vl-position x ll)) l))
  (setq tree ll loop t)
  (while loop
    (setq treesold trees)
    (foreach l1 tree
      (if (null flag)
        (setq tree nil)
      )
      (setq branches (nextbranches l1 (vl-remove l1 lll)))
      (if branches
        (progn
          (setq treex (mapcar '(lambda ( x ) (list l1 x)) branches))
          (if treex
            (setq trees (append treex trees))
          )
          (setq treex nil)
        )
        (progn
          (setq treex l1)
          (if treex
            (setq trees (cons treex trees))
          )
          (setq treex nil)
        )
      )
      (setq flag t)
      (setq tree (unique (append tree branches)))
    )
    (setq flag nil)
    (if (equal treesold (setq trees (unique trees)) 1e-6)
      (setq loop nil)
    )
  )
  (setq l (vl-remove-if-not '(lambda ( x ) (vl-position S (car x))) trees))
  (foreach x l
    (setq k (k-rec (list x) trees))
    (repeat (1- k)
      (setq l (cons x l))
    )
    (setq k nil)
  )
  (setq l (processtrees-trees trees))
  (setq l (vl-remove-if '(lambda ( x ) (not (equal (last (last x)) F 1e-6))) l))
  (setq l (mapcar '(lambda ( x ) (unique x)) l))
  (setq l (vl-sort l '(lambda ( a b ) (< (apply '+ (mapcar 'distance (apply 'append a) (cdr (apply 'append a)))) (apply '+ (mapcar 'distance (apply 'append b) (cdr (apply 'append b))))))))
)

;;; (processtrees l s f)

Regards, M.R.

HTH.

 

Thanks marko_ribar. It worked well for this specific case. But if you switch S and F, the return is nil. Therefore, it is necessary to work with all sublists of L. Perhaps something like described below solve the problem. Removing from L only the reversal of an used item to avoid infinite loop. But I don't know where to put it in your code. I am not yet familiar with the use of lambda, mapcar, apply and cons. So,I still don't fully understand your code.

(foreach item L
	(if (= used_item t)
		(progn
			(setq reversal (append (cdr (reverse item)) (list (last item))))
			(setq L (vl-remove reversal L))
		)
	)
)

 

Edited by EniSan

Share this post


Link to post
Share on other sites
marko_ribar

If you want to switch S with F and F with S, then you have to use the same list I provided with all items reversed and with also exclusion of those that were excluded already... You simply can't make normal + reversal in the same time - it will cause infinite looping...

Share this post


Link to post
Share on other sites
marko_ribar

I found one blunder in my posted code... I believe that this (k-rec) sub should actually be :

 

...
  (defun k-rec ( xl trees / xx xll )
    (if (null k)
      (setq k 1)
    )
    (foreach x xl
      (setq k (+ k (if (setq xx (vl-remove-if-not '(lambda ( a ) (equal (last (last x)) (caar a) 1e-6)) trees)) (1- (length xx)) 0)))
      (setq xll (append xx xll))
    )
    (if xll
      (k-rec xll trees)
      k
    )
  )
...

Now there is no explanation as it involves imagination and thoughts about what it does and processes, but although the final result is the same, I strongly believe I am right and I fixed this... There may be more blunders, but now I am not so sure in that statement... Anyway revision came in the right time for you to make your revision and overwrite old version...

Regards, M.R.

Share this post


Link to post
Share on other sites
marko_ribar

I've found another one... This sub should actually be :

 

...
  (defun processtrees-trees ( trees / z b ql )
    (setq lo l z -1)
    (foreach x l
      (setq z (1+ z))
      (setq ql (vl-remove-if '(lambda ( y ) (not (equal (last x) (car y) 1e-6))) trees))
      (foreach q ql
        (if (not (vl-position (append (nth z l) q) l))
          (setq l (mapcar '(lambda ( a ) (if (null b) (setq b 0) (setq b (1+ b))) (if (= b z) (append a q) a)) l))
        )
      )
      (setq b nil)
    )
    (if (not (equal lo l 1e-6))
      (processtrees-trees trees)
      l
    )
  )
...

I've found this with reversed example... If you now copy my entire code I posted and use it with : (processtrees (mapcar 'reverse l) F S), it should give you 4 paths exactly the same as with : (processtrees l S F) only reversed... I had to mod this sub as it was wrong way to remove elements from list of sub lists of pairs : trees... This is the only way to process correctly both situations and normal and reversed... As I stated already initial list must not have both normals and reversals at the same time - it will loop endlessly...

Regards, M.R.

Share this post


Link to post
Share on other sites
tombu
On 7/10/2020 at 9:08 PM, EniSan said:
Thanks for the contribution ronjonp.
I looked at the post and I think it's similar to what I want.
But I was unable to run the code because the following functions are not working in my autocad:
vlax-curve-getclosestpointto
acet-list-remove-duplicates

I also didn't quite understand how to create edges in my case. In addition to being a beginner and not fully understanding the use of cons mapcar and lambda.
 

I've seen vlax-curve-getclosestpointto used in 2004 lisp, you're showing as using 2007? Haven't checked the code but if 

(vl-load-com)

isn't in there add it to acaddoc.lsp to make sure visual lisp functions will always work.

You need Express Tools installed for acet-list-remove-duplicates or other "acet-" functions to work.

Share this post


Link to post
Share on other sites
marko_ribar
Posted (edited)

Here are my latest results... As you can see reversals and normals are included in main list and I coded that it don't loop endlessly... But as I struggled quite a bit to get this results I won't post my sub routine unless I get some compensation for my efforts... I don't think I'll develop it further more and if you are interested in current results and want to use it based on them, you can contact me on : ribarm@gmail.com ... You can think about some compensation or small fee, but I am not willing to share it public...

 

(setq S (list 3.0 0.0 1.5))
(setq F (list 2.5 4.5 3.0))

(setq L
    (list
        (list (list 0.0 2.5 1.5) (list 0.0 2.5 3.0) (list 2.5 3.5 3.0) (list 4.19258))
        (list (list 5.0 2.5 1.5) (list 2.5 3.5 3.0) (list 3.08221))
        (list (list 5.0 6.5 1.5) (list 5.0 6.5 0.0) (list 2.0 7.5 0.0) (list 2.0 7.5 0.3) (list 4.96228))
        (list (list 2.0 7.5 0.3) (list 2.0 7.5 0.0) (list 0.8 6.0 0.0) (list 2.22094))
        (list (list 5.0 6.5 1.5) (list 5.0 6.5 3.0) (list 2.5 5.5 3.0) (list 4.19258))
        (list (list 0.8 6.0 0.0) (list 2.5 5.5 3.0) (list 3.48425))
        (list (list 5.0 2.5 1.5) (list 5.0 6.5 1.5) (list 4.0))
        (list (list 3.0 0.0 1.5) (list 0.0 2.5 1.5) (list 3.90512))
        (list (list 3.0 0.0 1.5) (list 5.0 0.0 1.5) (list 5.0 2.5 1.5) (list 4.5))
        (list (list 2.5 3.5 3.0) (list 2.5 4.5 3.0) (list 1.0))
        (list (list 2.5 5.5 3.0) (list 2.5 4.5 3.0) (list 1.0))
    )
)
(setq L (mapcar '(lambda ( x ) (vl-remove-if '(lambda ( y ) (equal y (last x))) x)) L))
(setq L (append L (mapcar 'reverse L)))

;| - request
(
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0)) (8.58221))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0)) (9.0977))
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (13.69258))
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (20.16747))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (20.37249))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)) (26.84738))
)

- new result by sub routine

(
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0)))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (2.5 4.5 3.0)))
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)))
  (((3.0 0.0 1.5) (5.0 0.0 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)))
  (((3.0 0.0 1.5) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (0.0 2.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 6.5 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (2.5 4.5 3.0)))
)

(
  (((2.5 4.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 0.0 1.5) (3.0 0.0 1.5)))
  (((2.5 4.5 3.0) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (0.0 2.5 3.0) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (3.0 0.0 1.5)))
  (((2.5 4.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (5.0 6.5 3.0) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 0.0 1.5) (3.0 0.0 1.5)))
  (((2.5 4.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (5.0 6.5 0.0) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (5.0 0.0 1.5) (3.0 0.0 1.5)))
  (((2.5 4.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (5.0 6.5 3.0) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (0.0 2.5 3.0) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (3.0 0.0 1.5)))
  (((2.5 4.5 3.0) (2.5 5.5 3.0)) ((2.5 5.5 3.0) (0.8 6.0 0.0)) ((0.8 6.0 0.0) (2.0 7.5 0.0) (2.0 7.5 0.3)) ((2.0 7.5 0.3) (2.0 7.5 0.0) (5.0 6.5 0.0) (5.0 6.5 1.5)) ((5.0 6.5 1.5) (5.0 2.5 1.5)) ((5.0 2.5 1.5) (2.5 3.5 3.0)) ((2.5 3.5 3.0) (0.0 2.5 3.0) (0.0 2.5 1.5)) ((0.0 2.5 1.5) (3.0 0.0 1.5)))
)
|;

Regards, M.R.

Edited by marko_ribar

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...