Topic: Put every nth block in a selection set from a long row of blocks

[jaydee]

Hi.
This post gave me idea to intitial this post
http://www.theswamp.org/index.php?topic=39480.0

Tunnel lighting (thousands of lights in one direction)
What i would like is to select all the blocks in the row but only ie. Put every fourth light or every fifth light (user define) into a selection set

Please help me to rebuilt the list, i just simplfy a list of all selected blocks basepoints
list 1

Code: [Select]

'(
(1 0 0)(2 0 0)(3 0 0)(4 0 0)(5 0 0)(6 0 0)(7 0 0)(8 0 0)(9 0 0)(10 0 0)(11 0 0)(12 0 0)
(13 0 0)(14 0 0)(15 0 0)(16 0 0)(17 0 0)(18 0 0)(19 0 0)(20 0 0)(21 0 0)(22 0 0)(23 0 0)(24 0 0)
)
User specify the nth item. ie every 4th in the list and the result
list 2 =

Code: [Select]

'(
(4 0 0)(8 0 0)((12 0 0)(16 0 0)(20 0 0)(24 0 0)
)
and here is what i come up with, the thing i think is missing i a list of every nth item.

Code: [Select]

;;;This function is from Tony T
(defun find-nearest-x (pt plist fuzz / x y dist ylist res)
 (setq x (car pt) y (car pt))
 (setq dist (abs (apply '- (minmax (mapcar 'car plist)))))
   (foreach point plist
     (if (and (equal (car point) x fuzz)
            (> dist (abs (- (car point) x)))
         )
     (setq dist (abs (- (car point) x))
              res point
     )
   )
)
res
)

(defun minmax (numlist)
(mapf '(min max) numlist)
)

(defun mapf (funcs lst)
(mapcar '(lambda (f) (apply f lst)) funcs)
)


Code: [Select]

(defun c:Test  (/ myset fuzz fuzzang getline enlist linelength lineang sset ssentity index name ent p1 p2 sslinang dist)

(setq myset (ssadd))
(setq fuzz  (* 0.01 (getvar "dimscale")))

(setq sset (ssget))

(setq Index 0)
  (while (< Index (sslength sset))
    (setq Lst (cons (cdr (assoc 10 (entget (ssname sset Index)))) Lst)
             Index (1+ Index)
    )
  )
(setq Lst (reverse Lst))
;;;(setq z Lst)


(setq XListOrder (vl-sort Lst '(lambda (p1 p2) (< (car p1) (car p2)))))

  (setq index 0)
   (while (< index (sslength sset))
    (setq name (ssname sset index))
    (setq ent (entget name))
    (setq p1 (cdr (assoc 10 ent)))

     (if (find-nearest-x p1 lst fuzz)
      (setq myset (ssadd name myset))
     )
     (setq index (1+ index))
    )
    (sssetfirst nil myset)

(princ)
)


[David Bethel]

If the list is presorted, maybe:

Code: [Select]

(defun nth-lst (lst / n i output)

  (initget 7)
  (setq n (getint "\nAtom To Strip:   "))

  (setq i 1)
  (foreach a lst
    (if (zerop (rem i n))
        (setq output (cons (nth (1- i) lst) output)))
    (setq i (1+ i)))

  (reverse output))

-David

[Lee Mac]

Or:

Code: [Select]

(defun Every-Nth-Item ( n l / i )
    (setq i 0)
    (vl-remove-if-not '(lambda ( x ) (zerop (rem (setq i (1+ i)) n))) l)
)
IMO, 'n' should be zero-based though.

[jaydee]

Thankyou David and Lee

Both work great.
Not sure when im going to do another tunnel job so i could utilise this routine.

Cheers

[pBe]

Or:

Code: [Select]

(defun Every-Nth-Item ( n l / i )
    (setq i 0)
    (vl-remove-if-not '(lambda ( x ) (zerop (rem (setq i (1+ i)) n))) l)
)
IMO, 'n' should be zero-based though.

I wrote the code almost identical to Lee's

Code: [Select]

(defun Every (n lst / cnt)
(setq cnt 0)
(vl-remove-if-not '(lambda (l)
                         (if (= (rem (setq cnt (1+ cnt)) n) 0) l))
                             lst)
  )
Guess that means i'm better now since the i started coding again a year and so ago.

Thank you all from the bottom of my heart.
 

[jaydee]

Hi.
The code i used from Tony T seem a bit over complicated for this purpose.
Could some please show me a simpler solution of
comparing if a point is in the list. Also is a fuzz factor require when comparing points??

Code: [Select]

(if (12 0 0) ;;; is in the list below
'((4 0 0)(8 0 0)((12 0 0)(16 0 0)(20 0 0)(24 0 0))
)
==> T

Is this the right solution, it seems to be working

Code: [Select]

(defun IsPoint-inList (pt pointlist)
 (vl-some
  '(lambda (p)
    (equal pt p 0.001)
   )
   pointlist
 )
)

Thankyou

[Ketxu]

Maybe you should put 0.001 (fuzz) as an argument ?

[pBe]

Hi.
The code i used from Tony T seem a bit over complicated for this purpose.
Could some please show me a simpler solution of
comparing if a point is in the list. Also is a fuzz factor require when comparing points??

Code: [Select]

(if (12 0 0) ;;; is in the list below
'((4 0 0)(8 0 0)((12 0 0)(16 0 0)(20 0 0)(24 0 0))
)
==> T


One way.

Code: [Select]

(defun Mmbr  (itm lst / a F)
  (while
    (setq a (car lst))
     (if (or (equal itm lst)
     (member itm a))
       (setq lst nil
     F T)
       (setq lst (cdr lst))
       )
     )
  (if (null F)
    lst
    T))
(Mmbr '(12 0 0) '((4 0 0)(8 0 0)((12 0 0)(16 0 0)(20 0 0)(24 0 0))))
T

Sometimes I  cheat when faced with nested list 

Code: [Select]

(defun Cheat  (itm lst)
  (if (vl-string-search
(vl-princ-to-string itm)
(vl-princ-to-string lst))
    T
    nil))

[jaydee]

Thankyou Pbe for the code and Ketxu for advice

[Ketxu]

Sometimes I  cheat when faced with nested list 

Code: [Select]

(defun Cheat  (itm lst)
  (if (vl-string-search
(vl-princ-to-string itm)
(vl-princ-to-string lst))
    T
    nil))

Nice cheat pBe ^^

Code: [Select]

(defun Cheat  (itm lst)
  (and (vl-string-search
(vl-princ-to-string itm)
(vl-princ-to-string lst))))


[pBe]

Thank you Ketxu, there are times you can get away with it,  but not ALL the time 

[jaydee]

Thankyou for your input.
Here is a complete routine that select the nth block in a long linear of blocks

Code: [Select]

(defun c:TEST  (/ myset fuzz response Lst LstNth ListOrder sset index name ent p1 p2 ListOrder n)

(setq mySet nil)
(setq Lst nil)
(setq fuzz (* 0.001 (getvar "dimscale")))
(setq myset (ssadd))

(if (null default)
 (setq default "L")
)

(setq response nil)
 (while (not (ok_response_test response))
  (setq response
(strcase
(getstring
  (strcat
   "\nSorting from  [L]eft,  [R]ight,  [T]op,  [B]tm   <" default ">: "
  )
)
)
  )
  (if (ok_response_test response)
   (if (equal response "")
    (setq response default)
    (setq default response)
   )
   (prompt "\n**Your Entry was Invalid, Please Re-enter...")
  )
 )

(if (/= (type #n) 'STR)(setq #n "3"))

(initget 6)
(if (setq n (getint (strcat "\nEnter the Selection Interval, ie  3  for Every Third Item:   <"#n ">: ")))
  (setq #n (itoa n))
  (setq n (atoi #n))
)

(prompt "\nSelect All Block Along the Layout")
(setq sset (ssget '((0 . "INSERT"))))

(setq Index 0)
  (while (< Index (sslength sset))
    (setq Lst (cons (cdr (assoc 10 (entget (ssname sset Index)))) Lst)
             Index (1+ Index)
    )
  )

(cond
  ((= response "L") (setq ListOrder (vl-sort Lst '(lambda (p1 p2) (< (car p1) (car p2)))))
(setq LstNth (Every-Nth-Item n ListOrder))
  );;;x sort
  ((= response "R") (setq ListOrder (vl-sort Lst '(lambda (p1 p2) (< (car p1) (car p2)))))
(setq LstNth (Every-Nth-Item n (reverse ListOrder)))
  );;;-x sort
  ((= response "T") (setq ListOrder (vl-sort Lst '(lambda (p1 p2) (< (cadr p1) (cadr p2)))))
(setq LstNth (Every-Nth-Item n (reverse ListOrder)))
  );;;y sort
  ((= response "B") (setq ListOrder (vl-sort Lst '(lambda (p1 p2) (< (cadr p1) (cadr p2)))))
(setq LstNth (Every-Nth-Item n ListOrder))
  );;;-y sort
)

  (setq index 0)
   (while (< index (sslength sset))
    (setq name (ssname sset index))
    (setq ent (entget name))
    (setq p1 (cdr (assoc 10 ent)))

      (if (IsPtInList p1 LstNth fuzz)
       (setq myset (ssadd name myset))
      )

     (setq index (1+ index))
    )
    (sssetfirst nil myset)

(princ))

;;;============================================

(defun ok_response_test (response)
 (if (or (= response "L")
          (= response "R")
          (= response "T")
          (= response "B")
          (= response "")
     )
  t
  nil
 )
)

;;;============================================

(defun IsPtInList (pt pointlist fuzz)
(vl-some
  '(lambda (p)
    (equal pt p fuzz)
   )
   pointlist
)
)

;;;============================================

(defun Every-Nth-Item ( n ListOrder / i )
    (setq i 0)
    (vl-remove-if-not '(lambda ( x ) (zerop (rem (setq i (1+ i)) n))) ListOrder)
)


[Lee Mac]

Look into the getkword and initget functions 

[jaydee]

Look into the getkword and initget functions 

I see. Thankyou Lee

[Lee Mac]

Look into the getkword and initget functions 

I see. Thankyou Lee

You're welcome, this may also help in that respect