sort to nearest

Discussion in 'AutoCAD' started by spencer1971, May 10, 2004.

  1. spencer1971

    spencer1971 Guest

    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 C:p1 ()
    (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)
    )
    )
    )
    )
     
    spencer1971, May 10, 2004
    #1
  2. spencer1971

    ECCAD Guest

    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))))))
    ...
     
    ECCAD, May 10, 2004
    #2
  3. spencer1971

    zeha Guest

    sorting with distance p and circlepoint see below

    (defun C:p1 (/ 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 "")
    )
    )
    )
     
    zeha, May 10, 2004
    #3
  4. spencer1971

    spencer1971 Guest

    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)
     
    spencer1971, May 10, 2004
    #4
  5. spencer1971

    spencer1971 Guest

    Thats much better but still not picking nearest every time. it seems to be defaulting to its x value
     
    spencer1971, May 10, 2004
    #5
  6. spencer1971

    spencer1971 Guest

    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
     
    spencer1971, May 10, 2004
    #6
  7. spencer1971

    spencer1971 Guest

    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.
     
    spencer1971, May 10, 2004
    #7
  8. spencer1971

    bob.at Guest

    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
     
    bob.at, May 10, 2004
    #8
  9. * 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 c:p1 ( / 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))
     
    Eduardo Muñoz, May 10, 2004
    #9
  10. spencer1971

    spencer1971 Guest

    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 C:pCL (/ 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)
    )
     
    spencer1971, May 12, 2004
    #10
  11. (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 C:p1 (/ 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.")
    ________________________________________________
     
    Marc'Antonio Alessi, May 12, 2004
    #11
  12. spencer1971

    zeha Guest

    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 C:pCL (/ 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, May 12, 2004
    #12
  13. spencer1971

    spencer1971 Guest

    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
     
    spencer1971, May 12, 2004
    #13
Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.