sort to nearest

I have written / patched together this lsp with help from the forum..
What commands should I be looking at to change the sort order from sorted by x value (current) to say starting at a point bottom left and drawing pline to next nearest point and repeating


(defun C1 ()
(setq ss (ssget '((0 . "CIRCLE"))))
(if ss
(progn
(setq n (1- (sslength ss)) c nil)
(while (>= n 0)
(setq elist (entget (ssname ss n))
c (cons (cdr (assoc 10 elist)) c)
n (1- n)
)
)
(setq csor (vl-sort c (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))))
(command "._pline")
(foreach n csor
(command n)
)
)
)
)

 

Try adding:
(setq csor (vl-sort c (function (lambda (e1 e2) (< (car e1) (car e2))))))
... just before
(setq csor (vl-sort c (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))))
...

 

sorting with distance p and circlepoint see below

(defun C1 (/ ss p n c elist csor)
(setq ss (ssget '((0 . "CIRCLE"))))
(if ss
(progn
(setq p (getpoint "\nStarting point at bottom left: ") n (1- (sslength ss)) c nil)
(while (>= n 0)
(setq elist (entget (ssname ss n))
c (cons (cdr (assoc 10 elist)) c)
n (1- n)
)
)
(setq csor (vl-sort c (function (lambda (e1 e2) (< (distance p e1) (distance p e2))))))
(command "._pline")
(foreach n csor
(command n)
)
(command "")
)
)
)

 

I must have mislead you, This still sorts in x-y values, I want to sort by listing next nearest point for all points (for a pile layout drawing to group together ref numbers)

 

Thats much better but still not picking nearest every time. it seems to be defaulting to its x value

 

My apologies

I understand now, this returns all points in relation to a picked point what I want to do is shift p to the last returned point and the evaluate next from there.

I think I can do that, Ill shout if I need more help if thats ok

Many thanks

 

Its no good,

I think i need to insert a line

(setq p (e1)) (might be wrong as im quite new to this)

but i cant work out where to place it.

 

Spencer

if you want find the nearest circle after drawing one step of the polyline you must do the sort command with the distances (as Zeha did above), but you must do it every time you step throu th foreach loop, using the last point of pline as the first point for calculating distances. And you also must remove the used point from the list (i did not test it!):

; set c as you have it
; set p to the start point and then:
(command "._pline")
(while c
(setq csor (vl-sort c (function (lambda (e1 e2) (< (distance p e1) (distance p e2))))))
(setq p (car csor))
(command p)
(setq c (cdr csor))
)
(command "")

But i'm not sure if you get the result you expect. Depending on the actual positions of your circle the "next" circle (what you expect to be the next) must not be the "nearest" (in mathmatical sense)

bob.at

 

* spencer1971 <>

| I have written / patched together this lsp with help from
| the forum.. What commands should I be looking at to
| change the sort order from sorted by x value (current) to
| say starting at a point bottom left and drawing pline to
| next nearest point and repeating

You are searching for the shortest path using a greedy
algorithm. Keep in mind that it will not give the shortest
possible path of a set of points. Take a look at the
following code. It is really wastefull as it sorts the list
of points a lot of times, but it may serve your purposes if
the number of circles is small.


(defun c1 ( / ss n c base)
(setvar "cmdecho" 0)
(if (setq ss (ssget '((0 . "CIRCLE"))))
(progn
(setq n 0)
(repeat (sslength ss)
(setq c (cons (cdr (assoc 10 (entget (ssname ss n))))
c)
n (1+ n)))
;; Find bottom left
(setq base (list (apply 'min (mapcar 'car c))
(apply 'min (mapcar 'cadr c))))
(command "._pline")
(repeat (1+ (length c))
(command base)
(setq c (vl-sort c '(lambda (x y) (< (distance x base)
(distance y base))))
base (car c)
c (cdr c)))
(command "")))
(princ))

 

This is my original

----------------------------

(vmon)

(defun dtr (a) (* pi (/ a 180.0)) )

(defun NUM ()
(setq sn (1+ sn))
)

(defun tabpts ()
(setq e (entget x))
(setq n (length e))
(setq a 0)

(while (<= a (1- n))

(if (= (car (nth a e)) 10) (progn

(setq np (polar np (dtr 270) dtl))

(if (= wyn "Y") (progn
(setq rn (1+ rn))
(command "text" np "" "" (rtos rn 2 0))
))

(if (= wx "X") (progn
(command "text" (polar np 0.0 dtcr) "" "" (rtos (cadr (nth a e))) )
))

(if (= wx "Y") (progn
(command "text" (polar np 0.0 dtcr) "" "" (rtos (caddr (nth a e))) )
))

(if (= wx "XY") (progn
(command "text" (polar np 0.0 dtcr) "" "" (rtos (cadr (nth a e)))
"text" (polar np 0.0 (+ dtcr dtc1)) "" "" (rtos (caddr (nth a e))) )
))

(if (= wx "XYZ") (progn
(setq zp 0.0)
(command "text" (polar np 0.0 dtcr) "" "" (rtos (cadr (nth a e)))
"text" (polar np 0.0 (+ dtcr dtc1)) "" "" (rtos (caddr (nth a e)))
"text" (polar np 0.0 (+ dtcr dtc1 dtc2)) "" "" (rtos zp) )
))
))
(setq a (1+ a))
)
)

;................................................................................
;................................................................................

(defun inputget (q txt x y z / a)
(if (= x nil) (setq x y))
(if (= (type x) 'STR)
(princ (strcat txt x)) (princ (strcat txt (rtos x))))
(setq a x)
(cond ((= q "kw") (setq x (getkword "> : ")))
((= q "r" ) (setq x (getreal "> : ")))
((= q "d" ) (setq x (getdist "> : ")))
((= q "i" ) (setq x (getint "> : ")))
((= q "s" ) (setq x (getstring T " : ")))
((= q "a" ) (setq x (getangle "> : ")))
((= q "p" ) (setq x (getpoint ":<previous> : ")))
)
(if (or (= x nil) (= x "")) (setq x a))
(eval x))

;......................................................


(defun CCL (/ ss csor dtc dtc1 dtc2 n etlist sp wyn rn x np)
(setq pfx (getstring "\n Prefix: ")
sfx (getstring "\n Suffix: ")
sn (getint "\nStart Number: ")
)
(setq ss (ssget '((0 . "CIRCLE"))))
(if ss
(progn
(setq n (1- (sslength ss)) c nil)
(while (>= n 0)
(setq elist (entget (ssname ss n))
c (cons (cdr (assoc 10 elist)) c)
n (1- n)
)
)
(setq csor (vl-sort c (function (lambda (e1 e2) (< (car e1) (car e2))))))
(setq csor (vl-sort c (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))))
(command "._pline")
(foreach n csor
(command n)
)
(command "")
(setq z 2)
(setq sp (getpoint "\nStart Point (top left hand corner of table):"))

(initget "X Y Z XY XYZ")
(setq wx (inputget "kw" "\nValues to be tabulated: X, Y, Z, XY or XYZ ? <" wx "XY" nil))

(setq dtcr 0)
(initget "Y N")
(setq wyn (inputget "kw" "\nAdd Reference Column (i.e pile No's) Y/N :<" wyn "Y" nil))
(if (= wyn "Y") (progn
(setq dtc (inputget "d" "\nDistance between Ref Column & X: <" dtc 0.0 nil))
(setq rn 0 dtcr dtc)
))

(setq dtl (inputget "d" "\nDistance between Rows: <" dtl 0.0 nil))
(if (or (= wx "XY") (= wx "XYZ")) (progn
(setq dtc1 (inputget "d" "\nDistance between columns X & Y: <" dtc1 0.0 nil)) ))
(if (= wx "XYZ") (progn
(setq dtc2 (inputget "d" "\nDistance between Columns Y & Z: <" dtc2 0.0 nil)) ))

(setq x (entlast))
(if x (progn
(setq np (polar sp (dtr 90) dtl) )
(tabpts)
)))
)
(if ss
(progn
(setq n (1- (sslength ss)) c nil)
(while (>= n 0)
(setq elist (entget (ssname ss n))
n (1- n)
)
)
(foreach n csor
(command "text" n "" 0 (strcat pfx (rtos sn 2 0) sfx))
(num)
(command n)
)
)
)
(princ)
)

 

(defun ALE_LowLeftCLosestPnts (PtsLst / LwrLft)
(setq LwrLft (getvar "EXTMIN"))
(vl-sort
PtsLst
'(lambda (Pnt001 Pnt002)
(< (distance Pnt001 LwrLft) (distance Pnt002 LwrLft))
)
)
)

; Tony Tanzillo
; If you search this newsgroup, you'll find a much
; more powerful sorting function along with a good
; discussion on why (vl-sort) can be very dangerous.
; For that reason, I suggest you replace the built-in
; vl-sort with this:

(defun vl-sort (lst func)
(mapcar
'(lambda (x) (nth x lst))
(vl-sort-i lst func)
)
)
; This will ensure that (vl-sort) does not remove
; elements that it sees as equal.
;
; My note: maybe in this case there are no circles
; with the same center point

(defun C1 (/ ss n c elist)
(if (setq ss (ssget '((0 . "CIRCLE"))))
(progn
(setq n (1- (sslength ss)))
(while (>= n 0)
(setq
elist (entget (ssname ss n))
c (cons (cdr (assoc 10 elist)) c)
n (1- n)
)
)
(command "._pline")
(foreach pt (ALE_LowLeftCLosestPnts c) (command pt))
(command "")
)
(alert "No circles selected")
)
(princ)
)

--
________________________________________________

Marc'Antonio Alessi
http://xoomer.virgilio.it/alessi
(strcat "NOT a " (substr (ver) 8 4) " guru.")
________________________________________________

 

look at the code

There also many thingd that can be done in a diiferent way
and if not the accuracy then the output is not what you expected

There also many questions for the user witch can be done by the programmer so that error messages can occurrence

(defun tabpts (rn np wx dtcr dtcr1 dctr2 / np)
(if (wcmatch wx "*X*")
(progn
(command ".text" "none" (polar np 0.0 dtcr) "" "" (rtos (cadr rn)))
(setq np (polar np 0.0 dtcr1))
)
)
(if (wcmatch wx "*Y*")
(progn
(command ".text" "none" (polar np 0.0 dtcr) "" "" (rtos (caddr rn)))
(setq np (polar np 0.0 dtcr1))
)
)
(if (= wx "XYZ")(command "text" "none" (polar np 0.0 dtc2) "" "" (rtos (cadddr rn))))
)

;......................................................... .......................
;.................................................... ............................

(defun inputget (q txt x y z / a)
(if (= x nil)
(setq x y)
)
(if (= (type x) 'STR)
(princ (strcat txt x))
(princ (strcat txt (rtos x)))
)
(setq a x)
(cond ((= q "kw") (setq x (getkword "> : ")))
((= q "r") (setq x (getreal "> : ")))
((= q "d") (setq x (getdist "> : ")))
((= q "i") (setq x (getint "> : ")))
((= q "s") (setq x (getstring T " : ")))
((= q "a") (setq x (getangle "> : ")))
((= q "p") (setq x (getpoint ":<previous> : ")))
)
(if (or (= x nil) (= x ""))
(setq x a)
)
(eval x)
)

;......................................................

(defun CCL (/ ss c ss n p csor plst dtc dtc1 dtc2 n etlist wyn rn x np)
(setq pfx (getstring "\n Prefix: ")
sfx (getstring "\n Suffix: ")
sn (getint "\nStart Number: <1> ")
)
(if (setq ss (ssget '((0 . "CIRCLE"))))
(progn
(command ".undo" "begin"); make a group for undo
(setq n 0 sn (if (= (type sn) 'INT) sn 1))
(while (< n (sslength ss))
(setq elist (entget (ssname ss n)) c (cons (cdr (assoc 10 elist)) c) n (1+ n))
)
(setq p (car (vl-sort c (function (lambda (e1 e2) (and (< (car e1) (car e2))(< (car e1) (car e2))))))))
(while c
(setq csor (vl-sort c (function (lambda (e1 e2) (< (distance p e1) (distance p e2)))))
p (car csor) c (cdr csor) plst (cons (cons sn p) plst) sn (1+ sn)
)
)
(setq plst (reverse plst) np (getpoint "\nStart Point (top left hand corner of table):"))
(initget "X Y Z XY XYZ")
(setq wx (inputget "kw" "\nValues to be tabulated: X, Y, Z, XY or XYZ ? <" wx "XY" nil) dtcr 0)
(initget "Y N")
(setq wyn (inputget "kw" "\nAdd Reference Column (i.e pile No's) Y/N :<" wyn "Y" nil))
(if (= wyn "Y")
(setq dtc (inputget "d" "\nDistance between Ref Column & X: <" dtc 0.0 nil) rn 0 dtcr dtc)
)
(setq dtl (inputget "d" "\nDistance between Rows: <" dtl 0.0 nil))
(if (member wx '("XY""XYZ"))
(setq dtc1 (inputget "d" "\nDistance between columns X & Y: <" dtc1 0.0 nil))
)
(if (= wx "XYZ")
(setq dtc2 (inputget "d" "\nDistance between Columns Y & Z: <" dtc2 0.0 nil))
)
(command "._pline")(foreach n plst (command (cdr n))) (command "")
(foreach n plst
(setq np (polar np (* 1.5 pi) dtl))
(command ".text" (cdr n) "" 0 (strcat pfx (rtos (car n) 2 0) sfx))
(if (= wyn "Y")(command ".text" np "" "" (rtos (car n) 2 0)))
(tabpts n np wx dtcr dtc1 dct2)
)
)
(command ".undo" "end")
)
(princ)
)

good luck

 

ZEHA

thank you very much for your help.

Now I have the basics I will go through my lsp and tidy up as necessary

regards

Spencer