Topic: sort list of points

[ronjonp]

How would one go about sorting a list of points that are arranged in a snakelike pattern so that a polyline will connect them starting from one end and follow the "snakelike" path to the last point?

I've been testing using this but get wierd results sometimes:

 

Code: [Select]

(if (SETQ ss (ssget '((0 . "INSERT"))))
    (progn
      (setq index -1)
      (while (< (setq index (1+ index)) (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss index))
      xyz (vlax-get obj 'insertionpoint)
)
(setq ptlist (append ptlist (list xyz)))
      )
    )
  )

;;;Sorts by Y coord
(setq ptlisty (vl-sort ptlist
      (function (lambda (y1 y2)
  (< (cadr y1) (cadr y2))
)
      )
     )
)


;;;Sorts by X coord
(setq ptlistx (reverse (vl-sort ptlist
       (function (lambda (x1 x2)
   (< (car x1)(car x2))
)
       )
      )
     )
)

(setq ydist (distance (nth (-(length ptlisty)1) ptlisty) (nth 0 ptlisty)))
(setq xdist (distance (nth (-(length ptlistx)1) ptlistx) (nth 0 ptlistx)))

(if (> ydist xdist)
  (progn
    (foreach pt ptlisty
      (command "circle" pt "10" "")
    )
  )
  (progn
    (foreach pt ptlistx
      (command "circle" pt "10" "")
    )
  )
)

[T.Willey]

How about if you select the block to start, and then select the rest of the blocks, and then draw the pline in order of distance from one block the the other?  Would that work for you?

[ronjonp]

That sounds like it would work. Let me see if I can figure out how to do that .

[Serge J. Gianolla]

Hey Ron,
Are those point objects using AutoCAD points [where you can add some extended data] or blocks [add attributes as auto-indexing], then have a routine connect the "dots"? Alternatively, if you are a 100% sure that you are after the shortest distance, google for Travellin' Salesman equation! HTH.

Edit*: Just read your code and saw that your are using blocks! That'll teach me to read 1st - or maybe not  . I have also noticed that for you guys it is Traveling with one L for your search.

[ronjonp]

Ok so this is what I came up with...it works OK.

Code: [Select]

(defun c:x (/ ss index obj xyz ptlist ptlistx ptlisty ydist xdist pt)
  (if (SETQ ss (ssget '((0 . "INSERT"))))
    (progn
      (setq index -1)
      (while (< (setq index (1+ index)) (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss index))
      xyz (vlax-get obj 'insertionpoint)
)
(setq ptlist (append ptlist (list xyz)))
      )
      (setq ptlisty (rjp-sortptlistXYZ ptlist "Y")
    ptlistx (rjp-sortptlistXYZ ptlist "X")
    ydist   (rjp-MaxXYZdistptlist ptlist "Y")
    xdist   (rjp-MaxXYZdistptlist ptlist "X")
      )
      (if (> ydist xdist)
(progn
  (setq ptlist (rjp-sortptlistDIST ptlisty))
  (foreach pt ptlist
    (command "circle" pt "0.025" "")
  )
)
(progn
  (setq ptlist (rjp-sortptlistDIST ptlistx))
  (foreach pt ptlist
    (command "circle" pt "0.025" "")
  )
)
      )
    )
  )
)

(defun rjp-sortptlistXYZ (ptlist xyz / y1 y2)
  (cond ((= (strcase xyz) (strcase "x"))
(setq xyz car)
)
((= (strcase xyz) (strcase "y"))
(setq xyz cadr)
)
((= (strcase xyz) (strcase "z"))
(setq xyz caddr)
)
  )
  (reverse (vl-sort ptlist
    (function (lambda (y1 y2)
(< (xyz y1) (xyz y2))
      )
    )
   )
  )
)


(defun rjp-MaxXYZdistptlist (ptlist xyz / sort y1 y2)
  (cond ((= (strcase xyz) (strcase "x"))
(setq xyz car)
)
((= (strcase xyz) (strcase "y"))
(setq xyz cadr)
)
((= (strcase xyz) (strcase "z"))
(setq xyz caddr)
)
  )
  (setq sort (reverse (vl-sort ptlist
       (function (lambda (y1 y2)
   (< (xyz y1) (xyz y2))
)
       )
      )
     )
  )
  (distance (nth (- (length sort) 1) sort)
    (nth 0 sort)
  )
)

(defun rjp-sortptlistDIST (ptlist / d1 d2)
  (vl-sort ptlist
   (function (lambda (d1 d2)
       (< (distance d1 d2))
     )
   )
  )
)

[SomeCallMeDave]

For what it is worth,  here is one that uses the 'distance from the starting point' that T.Willey suggested. 

It will draw strange plines if the distances don't increase.  But I like it because it finally provides me a use for the vl-sort-i function.

Code: [Select]

(defun c:TestSortPoints( / ss1 StartPt count PtList)
    (prompt "\nPick Points ")
    (setq ss1 (ssget)
          StartPt (getpoint "\nPick Start Point ")
          count 0
          PtList nil
    );setq
    (repeat (sslength ss1)
        (setq  currPt (cdr (assoc 10 (entget (ssname ss1 count))))
                 PtList (append PtList (list currPt))
                 count (+ count 1)       
        );setq
    );repeat
    (sortPoints PtList StartPt)
);defun c:TestSortPoints

(defun SortPoints(pPtList pStartPt / DistanceList iSortDistList count PList)
     (setq DistanceList (mapcar '(lambda (x) (distance pStartPt x)) pPtList)
           iSortDistList (vl-sort-i DistanceList '<)
           count 0
     );setq
     (setq PList (list '(0 . "LWPOLYLINE")
                       '(100 . "AcDbEntity")
                       '(67 . 0)
                       '(410 . "Model")
                       '(100 . "AcDbPolyline")
                       (cons 90 (length pPtList))
                       '(70 . 0)
                  );list     
     );setq                 
     (repeat (length pPtList) 
          (setq PList (append Plist  (list (cons 10 (nth (nth count iSortDistList) pPtList)))
                                             (list (cons 40 0.0))
                                             (list (cons 41 0.0))
                                             (list (cons 42 0.0))
                           );append
                   count (+ 1 count)       
          );setq                           
      );repeat
     (entmake PList)
);defun sortPoints




[T.Willey]

Here is what I was talking about.

Code: [Select]

(defun c:PolyFromBlocks (/ ss Ent PtList NewPtList NewPt Dist tmpDist)

(if (setq ss (ssget '((0 . "INSERT"))))
 (progn
  (while (setq Ent (ssname ss 0))
   (setq PtList
    (cons
     (vlax-get
      (vlax-ename->vla-object Ent)
      'InsertionPoint
     )
     PtList
    )
   )
   (ssdel Ent ss)
  )
  (setq PtList
   (vl-sort
    PtList
    '(lambda (a b)
     (if (equal (car a) (car b) 0.001)
      (< (cadr a) (cadr b))
      (< (car a) (car b))
     )
    )
   )
  )
  (setq NewPtList (list (car PtList)))
  (setq PtList (cdr PtList))
  (repeat (length PtList)
   (foreach Pt PtList
    (setq tmpDist (distance Pt (car NewPtList)))
    (if
     (or
      (not Dist)
      (< tmpDist Dist)
     )
     (progn
      (setq Dist tmpDist)
      (setq NewPt Pt)
     )
    )
   )
   (setq Dist nil)
   (setq PtList (vl-remove-if '(lambda (x) (equal NewPt x 0.0001)) PtList))
   (setq NewPtList (cons NewPt NewPtList))
  )
  (command "_.pline")
  (foreach Pt NewPtList
   (command Pt)
  )
  (command "")
 )
)
(princ)
)


For what it is worth,  here is one that uses the 'distance from the starting point' that T.Willey suggested.

I meant that you sort while you are checking the distance from one point to the other, not testing them all from the start point.

ps.  I was to lazy to create a pline, so I just used the command method.  So to test turn off running osnaps. 

Edit: Glad you got something that works for you Ron.

[ronjonp]

OK...so points are getting sorted but now I want to sort a list of points with an associated ename dotted pair in a list. It sorts the list by X coord but I'm unable to get the sort by Y.

Here is what I have:

Code: [Select]

(if (SETQ ss (ssget '((0 . "INSERT"))))
  (progn
    (setq index -1)
    (while (< (setq index (1+ index)) (sslength ss))
      (setq obj (vlax-ename->vla-object (ssname ss index))
    xyz (vlax-get obj 'insertionpoint)
      )
      (setq ptlist (append ptlist (list (cons xyz (ssname ss index)))))
    )
  )
)
(setq ptlist (vl-sort ptlist
      (function
(lambda (y1 y2)
  (< (caar y1) (caar y2))
)
      )
     )
)
Thanks for the help.

Ron

*Nevermind CADAR

[Atook]

The way I did it way back when was to figure out which way was longer for the group of points, X or Y. I'd then start at the start point and head in that direction. It also allowed me to skip picking a starting point, and just taking one end of the group as the  start and heading in the longest direction. It worked as long as the curve didn't start going back on it's self. If you run into curves that do that then you need to evaluate distances for every point, which can be a PITA.

That was VBA, but it might give you some ideas on how to pull it off in LISP. I'll see if I can find the VBA code.