Need autolisp to count and color blocks

Need autolisp to count and color blocks

raa969BS
Explorer Explorer
881 Views
13 Replies
Message 1 of 14

Need autolisp to count and color blocks

raa969BS
Explorer
Explorer

Hi,

I need to count and change color of similar blocks. For example count and change color of every 200 blocks to multiple colors, Is there any autolisp programs for that?

0 Likes
882 Views
13 Replies
Replies (13)
Message 2 of 14

3wood
Advisor
Advisor

Is there any special rule in terms of the block location? eg. from left to right, from top to bottom, or along a route?

0 Likes
Message 3 of 14

raa969BS
Explorer
Explorer

yes, I need to start segregate blocks from the top left corner initially from left to right and follow the same pattern from top to bottom

0 Likes
Message 4 of 14

Sea-Haven
Mentor
Mentor

Post a sample dwg can sort on XY to get block pattern. Also there is say basic 254 colors not 2000 so what happens or use RGB colors ?

 

Your block needs color set to byblock.

0 Likes
Message 5 of 14

raa969BS
Explorer
Explorer

Here I have attached the sample dwg file. I need to count and segregate these by color, just need some 5 colors  for visual interpretation.

0 Likes
Message 6 of 14

Kent1Cooper
Consultant
Consultant

First of all, you will need to redefine the Block so that the pieces in it are of ByBlock color, rather than some white and some ByLayer.  The Blocks already have a color assigned [green], but they don't appear green because of the colors of the pieces in the Block definition.  So a routine that "colors" them by assigning colors to the Blocks will not do what you want.

 

Unrelated to your question, the whole thing is extraordinarily and totally unrealistically far from the drawing origin.  With coordinates in the range of X=-5.5677E+13 Y=2.5816E+13 [that's 10 to the 13th power!], if your drawing unit is a millimeter, you're roughly in the vicinity of 2.5 times as far from the sun as the Earth is on average.  How do drawings come to be made with coordinate values like that?  A >recent topic< is about correcting that.  And you should correct it -- it makes it difficult to work in, and measurements can report incorrectly, and very likely a routine that sorts by position based on coordinate values will give unexpected results.

Kent Cooper, AIA
0 Likes
Message 7 of 14

Sea-Haven
Mentor
Mentor

Like Kent did a bedit on block and set all to Byblock. Then moved all to 0,0 as suggested. The block is 44 long so X&Y do not make sense.

 

Still not sure where colors start and stop ? Need an example.

 

SeaHaven_0-1654649832698.png

 

 

 

 

0 Likes
Message 8 of 14

pbejse
Mentor
Mentor

@Kent1Cooper wrote:

 ... you're roughly in the vicinity of 2.5 times as far from the sun as the Earth is on average...


😄

 


@raa969BS wrote:

Hi,

I need to count and change color of similar blocks. For example count and change color of every 200 blocks to multiple colors, Is there any autolisp programs for that?


Keep in mind that there are only around 254 index color available.  Is that 200 different colors per block? or first 200 will be the same color? the next 200 is another color? and are you wanting to use this different blocks?

 

 

0 Likes
Message 9 of 14

Sea-Haven
Mentor
Mentor

raa969bs its your turn now.

0 Likes
Message 10 of 14

raa969BS
Explorer
Explorer

I have attached a segregated sample dwg  file which the type of output I needed. When segregating these blocks which are thousands in numbers it takes quite a time, looking lips to reduce the time consumption for this process

0 Likes
Message 11 of 14

Kent1Cooper
Consultant
Consultant

@raa969BS wrote:

yes, I need to start segregate blocks from the top left corner initially from left to right and follow the same pattern from top to bottom


From that description, I would have expected your sample drawing to look like this [there are 196 of them in each row, so the top row plus 4 in the next row, the rest of that row plus 8 in the next, etc.]:

Kent1Cooper_0-1654775094668.png

What is the basis for the arrangement of the colors in the sample drawing, especially for the shapes of the clusters of each color?  How could a routine determine a breakdown like what you have?

Kent Cooper, AIA
0 Likes
Message 12 of 14

Sea-Haven
Mentor
Mentor

Like kent I just selected and clicked on the color option and changed it. No code. Select how ?

 

SeaHaven_0-1654821575996.png

 

0 Likes
Message 13 of 14

aaron_gonzalez
Contributor
Contributor

Captura de pantalla 2024-10-16 210822.pngcheck this, all blocks shall by take one color, don't  recognize "by layer" color

 

 

(defun c:count_col ( / lst ss nombre xyz color)
  (if (setq ss (ssget '((0 . "INSERT")))) ;; Solo selecciona bloques
    (progn
      ;; Inicializar la lista de conteo
      (setq lst nil)

      ;; Recorre la selección de bloques
      (vlax-for obj (vla-get-ActiveSelectionSet (vla-get-activedocument (vlax-get-acad-object)))
        ;; Obtiene el color del objeto y lo agrega a la lista
        (setq color (cdr (assoc 62 (entget (vlax-vla-object->ename obj)))))
        (setq lst (colorcount:assoc++ color lst))
       
        ;; Si el bloque tiene atributos, contar también los atributos
        (if (and
              (= "AcDbBlockReference" (vla-get-objectname obj))
              (= :vlax-true (vla-get-hasattributes obj)))
          (foreach att (vlax-invoke obj 'getattributes)
            (setq color (cdr (assoc 62 (entget (vlax-vla-object->ename att)))))
            (setq lst (colorcount:assoc++ color lst))
          )
        )
      )

      ;; Crear una nueva capa para la lista de conteo
      (command "_.layer" "new" "FV-TEXTOS VOLUMETRIAS" "color" "4" "FV-TEXTOS VOLUMETRIAS" "PLOT" "NO" "FV-TEXTOS VOLUMETRIAS" "SET" "FV-TEXTOS VOLUMETRIAS" "")
      (setq nombre (getstring T "\nIngrese un nombre: "))
      (setq xyz (getpoint "Presiona el botón del ratón: ")) ;; obtiene la posición del puntero
      (command "_.text" "ML" xyz 1 0 (strcat "Lista de conteo de objetos: " nombre))

      (setq vertical-offset 1.5) ;; Separación vertical entre textos
      (setq original-xyz xyz)

      ;; Imprimir resultados
      (setq xyz (trans (list (car original-xyz) (- (cadr xyz) vertical-offset) 1.0) 1 0))
      (setq lst (vl-sort lst '(lambda (a b) (< (car a) (car b)))))

      (foreach itm lst
        (setq color (car itm))
        (setq cantidad (cdr itm))
        (setq xyz (trans (list (car original-xyz) (- (cadr xyz) vertical-offset) 1.0) 1 0))
        (command "_.text" "ML" xyz 1 0 (strcat (itoa cantidad) " u :     " (itoa color)))
      )
      (princ)
    )
    (princ "\nNo se seleccionaron bloques.")
  )
)

(defun colorcount:assoc++ ( key lst / itm )
  (if (setq itm (assoc key lst))
    (subst (cons key (1+ (cdr itm))) itm lst)
    (cons (cons key 1) lst)
  )
)

(vl-load-com) (princ)
 
0 Likes
Message 14 of 14

aaron_gonzalez
Contributor
Contributor
(defun c:color-name (color)
  (cond
    ((= color 1) "Rojo")
    ((= color 2) "Amarillo")
    ((= color 3) "Verde")
    ((= color 4) "Cyan")
    ((= color 5) "Azul")
    ((= color 6) "Magenta")
    ((= color 7) "Blanco")
    ((= color 8) "Gris obscuro")
    ((= color 8) "Gris claro")
    ((= color 30) "Naranja")
    ;; Agrega más colores si es necesario
    ((= color 256) "Por Capa") ; Color por capa
    (t (strcat "Color " (itoa color))) ; Para otros colores
  )
)

(defun c:count_obj_colorname (/ ent i ss lst lsta str color nombre xyz)
  (if (setq ss (ssget '((0 . "LINE,*POLYLINE,CIRCLE"))))
    (progn
      (setq lst (list)) ; Inicializar la lista
      (setq lsta (list)) ; Inicializar la lista de tipos

      (repeat (setq i (sslength ss))
        (setq ent (entget (ssname ss (setq i (1- i))))
              color (cdr (assoc 62 ent)) ; Obtener el color del objeto
              typ (cdr (assoc 0 ent))
        )

        ;; Contar por color
        (if (assoc color lst)
          (setq lst (subst (cons color (1+ (cdr (assoc color lst)))) (assoc color lst) lst))
          (setq lst (cons (cons color 1) lst))
        )

        ;; Contar por tipo (modificación original)
        (if (assoc typ lsta)
          (setq lsta (subst (cons typ (1+ (cdr (assoc typ lsta)))) (assoc typ lsta) lsta))
          (setq lsta (cons (cons typ 1) lsta))
        )
      )

      ;; Generar cadena de resultados para tipos
      (setq str (vl-string-right-trim
                  ", "
                  (apply
                    'strcat
                    (mapcar (function (lambda (x) (strcat (itoa (cdr x)) " " (car x) ", "))) lsta)
                  )
                )
      )

      ;; Crear una nueva capa para la lista de conteo
      (command "_.layer" "new" "FV-TEXTOS VOLUMETRIAS" "color" "4" "FV-TEXTOS VOLUMETRIAS" "PLOT" "NO" "FV-TEXTOS VOLUMETRIAS" "SET" "FV-TEXTOS VOLUMETRIAS" "")
      (setq nombre (getstring T "\nIngrese un nombre: "))
      (setq xyz (getpoint "Presiona el botón del ratón: ")) ; obtiene posición del puntero

      (command "_.text" "ML" xyz 1 0 (strcat "Lista de conteo de objetos: " nombre))

      (setq vertical-offset 1.0) ; Separación vertical entre textos
      (setq original-xyz xyz)
      (setq xyz (trans (list (car original-xyz) (- (cadr xyz) vertical-offset) 1.0) 1 0))

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

      ;; Imprimir resultados por color
      (foreach color-count lst
        (setq color (car color-count))
        (setq cantidad (cdr color-count))
        (setq xyz (trans (list (car original-xyz) (- (cadr xyz) vertical-offset) 1.0) 1 0))
        (command "_.text" "ML" xyz 1 0 (strcat (itoa cantidad) " u :     " (c:color-name color))) ; Mostrar nombre del color
        (setq xyz (trans (list (car original-xyz) (- (cadr xyz) vertical-offset) 1.0) 1 0))
      )

      (setq xyz (trans (list (car original-xyz) (- (cadr xyz) vertical-offset) 1.0) 1 0))
      (command "_.text" "ML" xyz 1 0 (strcat "## :" str ":  Totales   "))
    )
    (princ "\nNo se seleccionaron objetos... ")
  )
  (princ)
)
 
aaron_gonzalez_0-1729136191842.png

 

0 Likes