Jump to content

Possible paths and ordered according to criteria


EniSan

Recommended Posts

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.

 

Link to comment
Share on other sites

  • Replies 21
  • Created
  • Last Reply

Top Posters In This Topic

  • marko_ribar

    8

  • EniSan

    7

  • devitg

    4

  • BIGAL

    1

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

 

 

 

 

 

 

 

Link to comment
Share on other sites

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
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

 

 

 

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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
Link to comment
Share on other sites

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 

 . 

Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.
 
Link to comment
Share on other sites

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
Link to comment
Share on other sites

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
Link to comment
Share on other sites

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
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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
Link to comment
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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

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