NEED A LISP FOR COUNTING BLOCKS IN EVERY ROW

[archana96]

HI I NEED A LIPS FOR COUNTING THE BLOCKS IN EVERY ROW.

1.)IF THE THE BLOCKS IN A ROW HAVE 7 OR MORE THAN ABOVE CHANGE THAT ROW COLOR TO PINK. 

2) IF THE BLOCKS IN A ROW LESS THAN 7 CHANGE THE COLOR TO GREEN

 (IN A ROW THE BLOCK TO BLOCK SPACING IS BETWEEN 0.1M TO 1.5M. IF ABOVE THE 1.5M ITS BREAKED ROW AND CONTINUE TO COUNT FROM 1 )

[Kent1Cooper]

There seem to be differences in what your Message and your drawing ask for.  Nothing is green in the drawing as called for in your Message, but rather red.  And I think, from the text in the drawing, that some rows should have their first Block changed in color, but none do.

[Sea-Haven]

So take all the blocks and sort on Y & X, yes in that order, then check how many have the same Y value and if a row number matches change color. Did something similar yesterday. Added to my to do list.

I did ask elsewhere to look at this type of task and perhaps some one here will have something, that takes a sorted list and makes a sub list of common items in this case based on the Y value. The list would be like ((y x ENTITYNAME) (y x ENTITYNAME) (y x ENTITYNAME)...)  ( (y x ENTITYNAME) (y x ENTITYNAME)...)) so sub list of common items. Still working on the other task.

[Kent1Cooper]

---

@Sea-Haven wrote:

So take all the blocks and sort on Y & X....

---

For that part, at least, you can use BlockSSSort.lsp, >here<.  [It stands for Block Selection Set Sort.]  Read more about it in that Topic, and the comments in the file.  From those:

;; Usage: (BSSS "T" "L") sorts with top row first in left-to-right order, followed by rows below, also left to right.

That's the usage you would want, I think.  What it gives you is just a list of entity names in sorted order, so more would need to be done to determine where gaps and the starting of new rows occur, but you could use it as a starting point.

[Sea-Haven]

Thanks @Kent1Cooper, I dont have a problem sorting the block by X & Y I have sort up to 5 levels, could be more, my question is more about an efficient process to make sublists of a big list, based on a item in the master list like Y value. This is needed to get the row count and each entity name. The other task I am working on needs sublist as its about making plines from a big list of points.

eg

((y1 ...)(y1 ...)(y1 ...)(y1 ...)(Y2....)(Y2....)(Y2....)...)

becomes

(

((y1 ...)(y1 ...)(y1 ...)(y1 ...)(y1 ...))

((Y2....)(Y2....)(Y2....)(Y2....)(Y2....))

)

I was thinking about a mapcar function for the task.

[Sea-Haven]

Try this, I will let you set the color for number of items per row.

(defun c:wow ( / ins inss insss val1 val2 ss x lst lst2 lst3)
; Color items in a row by number of items in a row.
; BY AlanH

(defun chgcol (inss col / obj)
  (foreach insss inss
   (setq obj (vlax-ename->vla-object (caddr insss)))
   (vlax-put obj 'color Col)
  )
)

(prompt "\nSelect Blocks ")
(setq ss (ssget (list (cons 0 "INSERT"))))

(if (= ss nil)
(progn (alert "No bolocks chosen will exit ")(exit))
(progn
(setq lst '())
(repeat (setq k (sslength ss))
  (setq ent (ssname ss (setq k (1- k))))
  (setq entg (entget ent))
  (setq pt (cdr (assoc 10 entg)))
  (setq x (car pt) y (cadr pt))
  (setq lst (cons (list y x ent) lst))
)
)
)

(setq lst (vl-sort lst
	 '(lambda (a b)
	    (cond
	      ((< (car a) (car b)))
	      ((= (car a) (car b) ) (< (cadr a) (cadr b)))
	    )
	  )
      )
)

(setq val1 (nth 0 lst))
(setq lst2 '() lst3 '())
(setq lst2 (cons (list (car val1) (cadr val1) (caddr val1)) lst2))
(setq x 0)
(repeat (- (length lst) 1)
  (setq val2 (nth (setq x (1+ x)) lst))
  (if (= (rtos (car val1) 2 4)(rtos (car val2) 2 4))
  (progn
   (setq lst2 (cons (list (car val2) (cadr val2) (caddr val2)) lst2))
   (setq  val1 val2)
  )
  (progn
   (setq lst3 (cons (reverse lst2) lst3))
   (setq lst2 '())
   (setq  lst2 (cons (list (car val2) (cadr val2) (caddr val2)) lst2))
   (setq  val1 val2)
  )
  )
)
(setq lst3 (cons lst2 lst3))
(setq lst3 (reverse lst3))

(foreach ins lst3
  (cond 
   ((= (length ins) 1)(progn (setq col 1)(chgcol ins 1)))
   ((= (length ins) 2)(progn (setq col 1)(chgcol ins 2)))
   ((= (length ins) 3)(progn (setq col 1)(chgcol ins 3)))
   ((= (length ins) 4)(progn (setq col 1)(chgcol ins 4)))
   ((= (length ins) 5)(progn (setq col 1)(chgcol ins 5)))
   ((= (length ins) 6)(progn (setq col 1)(chgcol ins 6)))
   ((= (length ins) 7)(progn (setq col 1)(chgcol ins 7)))
   ((= (length ins) 8)(progn (setq col 1)(chgcol ins 8)))
   ((= (length ins) 9)(progn (setq col 1)(chgcol ins 9)))
   ((= (length ins) 10)(progn (setq col 1)(chgcol ins 10)))
  )
)

(princ)
)

(c:wow)

[archana96]

its little helped for me but small changes needed.

1. no need of many colours only need 4 types of colours (if possible)

2.in a row block to block distance more than 1.5m(big gap between block to block) start count from 1 after the gap between block to distance if more than 1.5m

3.in a  row the blocks more or equals to 7 just change the row colour and the first block in a row change the changecolour

4.simlarlay less than the 7 number of blocks in a row change the color and give diffrent colour of first one of block

( the point 3,4 if its possible can do it. other wise  just need  possible in a row the blocks more or equals to 7 just change the row colour, and less than the 7 number of blocks in a row change the color)

[archana96]

Sir are you there?? 

[Sea-Haven]

I am bit busy will get back to it when I can. May be a couple of days.

[archana96]

iam done.. some changes what i need but need your little help..

 i changed to.

1, in a Row the blocks more than 6 blocks Changing first block to green and the rest to color 254"

2, in a Rows with 6 or fewer blocks Changing first block to yellow and  and the rest to color 8"

3. the block to block distance is  35.

this things i changed and its worked 70% 

but some rows not followed the this commands 

in some rows the block after small block came but its not follow the commands 

so please resolve my problem..

this is the code i changed 

(defun c:wow ( / ins inss insss val1 val2 ss x lst lst2 lst3)
; Color items in a row by number of items in a row.
; BY AlanH

(defun chgcol (inss col / obj)
(foreach insss inss
(setq obj (vlax-ename->vla-object (caddr insss)))
(vlax-put obj 'color col)
)
)

(prompt "\nSelect Blocks ")
(setq ss (ssget (list (cons 0 "INSERT"))))

(if (= ss nil)
(progn (alert "No blocks chosen, will exit ")(exit))
(progn
(setq lst '())
(repeat (setq k (sslength ss))
(setq ent (ssname ss (setq k (1- k))))
(setq entg (entget ent))
(setq pt (cdr (assoc 10 entg)))
(setq x (car pt) y (cadr pt))
(setq lst (cons (list y x ent) lst))
)
)
)

(setq lst (vl-sort lst
'(lambda (a b)
(cond
((< (car a) (car b)))
((= (car a) (car b)) (< (cadr a) (cadr b)))
)
)
))

(setq val1 (nth 0 lst))
(setq lst2 '() lst3 '())
(setq lst2 (cons (list (car val1) (cadr val1) (caddr val1)) lst2))
(setq x 0)
(repeat (- (length lst) 1)
(setq val2 (nth (setq x (1+ x)) lst))
(if (and (= (rtos (car val1) 2 4) (rtos (car val2) 2 4))
(< (distance (list (cadr val1) (car val1)) (list (cadr val2) (car val2))) 35.0))
(progn
(setq lst2 (cons (list (car val2) (cadr val2) (caddr val2)) lst2))
(setq val1 val2)
)
(progn
(setq lst3 (cons (reverse lst2) lst3))
(setq lst2 '())
(setq lst2 (cons (list (car val2) (cadr val2) (caddr val2)) lst2))
(setq val1 val2)
)
)
)
(setq lst3 (cons lst2 lst3))
(setq lst3 (reverse lst3))

(foreach ins lst3
(prompt (strcat "\nProcessing row with " (itoa (length ins)) " blocks"))
(if (> (length ins) 6) ; Rows with more than 6 blocks
(progn
(prompt "\nChanging first block to green (color 3) and the rest to color 254")
(chgcol (list (car ins)) 3) ; Change first block to green (color 3)
(chgcol (cdr ins) 254) ; Change the rest to color 254
)
(progn ; Rows with 6 or fewer blocks
(prompt "\nChanging first block to yellow (color 2) and the rest to color 8")
(chgcol (list (car ins)) 2) ; Change first block to yellow (color 2)
(foreach blk (cdr ins)
(prompt (strcat "\nChanging block to color 8: " (vl-princ-to-string blk)))
(chgcol (list blk) 8) ; Change each remaining block to color 8
)
)
)
)

(princ)
)

(defun distance (pt1 pt2)
(sqrt (+ (expt (- (car pt2) (car pt1)) 2) (expt (- (cadr pt2) (cadr pt1)) 2)))
)

(c:wow)

[archana96]

are you there sir,

[Sea-Haven]

Yes put it aside for the moment, will put back onto my "To do list".

Looks like your getting to many yellow boxes will see if can fix.