Sort blocks by Y position

[pierre_costeS8GW8]

Hello everyone,

I have an arrangement of block for which i want to set a specific attribute tag value. I already have the Lisp for that. What i do not handle very well is sorting. I would like to set values from 01 to N depending on Y block position. 

the constraint : I can't move insertion point or specific point related to blocks.

Could you help me sorting my block in the Y direction please ? 

Please, I am aware of any kinds of suggestions. 

Thank you 

[Sea-Haven]

You make a list of say the Y insertion point values and the entity names (123.45 <Entity name: 3df7b420>)

(setq lst (vl-sort lst '(lambda (j k) (< (car j)(car k)))))

Then you can get each block in correct order.

[pierre_costeS8GW8]

First, thank you.
What if insertion points are in 0.0 ?

[Moshe-A]

@pierre_costeS8GW8  hi,

here is a function (sort_by_y) that accept ssget and return the a list of ((ename pt) (ename pt)....) sort by Y coords

the check what ss contain is on you 😀 it must be only block references

enjoy

Moshe

(defun sort_by_y (ss)
 (vl-sort 
  (mapcar
    (function
      (lambda (ename)
       (list ename (cdr (assoc '10 (entget ename))))
      )
    )
   (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
  )
  (function (lambda (e0 e1) (< (cadadr e0) (cadadr e1))))
 )
)

[pierre_costeS8GW8]

Thank you, i will give it a try. Could you  tell me if i well integrated your routine into my code ?

(defun c:TagID (/ counter blkss)

(vl-load-com)

(defun CLEANROUTINE ()
(setq block_objs nil)
)

(defun sort_by_y (ss)
(vl-sort
(mapcar
(function
(lambda (ename)
(list ename (cdr (assoc '10 (entget ename))))
)
)
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
(function (lambda (e0 e1) (< (cadadr e0) (cadadr e1))))
)
)

(setq counter 0)
(setq blkss (ssget '((0 . "INSERT")(66 . 1))))

(if blkss
(progn
(setq n (sslength blkss))
(setq block_objs '())
(repeat n
(setq blk (vlax-ename->vla-object (ssname blkss (setq n (1- n)))))
(setq blk_name (vla-get-effectiveName blk))

(setq block_objs (cons (cons blk blk_name) block_objs))
)

(setq sorted_blocks (sort_by_y blkss)) ; Sort blocks by Y-position

(setq prev_blk_name nil)
(foreach obj_blk sorted_blocks
(setq blk (car obj_blk))
(setq blk_name (cdr obj_blk))
(if (not (equal blk_name prev_blk_name))
(setq counter (1+ counter))
)

(foreach attr (vlax-invoke blk 'getattributes)
(if (= "ITEM" (strcase (vla-get-tagstring attr)))
(vla-put-textstring attr (if (< counter 10) (strcat "0" (itoa counter)) (itoa counter)))
)
)

(setq prev_blk_name blk_name)
)
)
)

(command "_updatefield" "")
(command "_regenall" "")

(princ)
)

[Moshe-A]

the best you can do is run your program and see if it works?!

[pierre_costeS8GW8]

Unfortunately, it does not work. i have a message error " ; error: bad argument type: VLA-OBJECT <Entity name: 27b81818bf0> malformed list on input "

[Moshe-A]

does it comes from (sort_by_y)?

[pierre_costeS8GW8]

it comes from its integration into my actual code, i think i haven't set/adapted variables correctly ... but i don't see where

[Moshe-A]

@pierre_costeS8GW8 ,

this is my fix untested 😀

(vl-load-com)

(defun c:TagID (/ sort_by_y  ; local function
		  counter blkss obj_blk blk_name blk_list)

 (defun sort_by_y (ss)
  (vl-sort
   (mapcar
    (function
      (lambda (ename)
       (list ename (cdr (assoc '10 (entget ename))))
      ); lambda
    ); function
    (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   ); mapcar
   (function (lambda (e0 e1) (< (cadadr e0) (cadadr e1))))
  ); vl-sort
 ); sort_by_y

 (setq counter 0) 
 (if (setq blkss (ssget '((0 . "INSERT") (66 . 1))))
  (progn
  
 ;| not need
   (repeat (setq n (sslength blkss))
    (setq blk (vlax-ename->vla-object (ssname blkss (setq n (1- n)))))
    (setq blk_name (vla-get-effectiveName blk))

    (setq block_objs (cons (cons blk blk_name) block_objs))
   ); repeat |;

   (foreach obj_blk (sort_by_y blkss)  ; Sort blocks by Y-position
    (setq blk_name (strcase (vla-get-effectiveName (setq blk (vlax-ename->vla-object (car obj_blk))))))

    (if (null (member blk_name blk_list)) 
     (setq blk_list (cons blk_name blk_list))
    )

    (foreach attr (vlax-invoke blk 'getAttributes)
     (if (= "ITEM" (strcase (vla-get-tagstring attr)))
      (progn 
       (vla-put-textstring attr (if (< counter 10) (strcat "0" (itoa counter)) (itoa counter)))
       (setq counter (1+ counter))
      ); progn 
     ); if
    ); foreach
   ); foreach
  ); progn 
 ); if

 ; print selected blocks name
 (terpri)
 (princ blk_list)
  
 (command "_updatefield" "")
 (command "_regenall" "")

 (princ)
); c:TagID

[pierre_costeS8GW8]

Your code is pretty much working ... in the sense that it set values to attribute tag "ITEM" but not the way i thought it would do.  

As attached, i have an arrangement of blocks e.g. The two yellow blocks in the bottom are the same, so i thought they would have the same ITEM value.

Thank you for your time. If you do not go further i understand you helped me a lot but if you could try it would be very nice.

[Moshe-A]

@pierre_costeS8GW8 ,

don't worry i will solve this  tonight, you can visit here within a few hours

meanwhile post a sample dwg

Moshe

[pierre_costeS8GW8]

Thank you very much for your time and your help.

See attached a dwg file.

[Moshe-A]

@pierre_costeS8GW8 ,

i review your file, if there are same block names laied on same Y will have the same tag - got it right?

[Moshe-A · Accepted solution]

@pierre_costeS8GW8 ,

check the new TAGID command.

Note:

the program is referring to block insertion point but from your example the point is far away from the block.

if two (or more) blocks with the same name and equal Y values (with only 0.1 digression) will consider 'brothers' and assign the same counter number.

this was not easy database to built i hope i hit the target 😀

work?

Moshe

(vl-load-com) ; load activex support

(defun c:TagID (/ tg:member tg:exist tg:format_counter ; local functions
		  counter blkss ename AcDbBlkRef blk_name p0 dt0 blk_list itm0 itm1)

 (defun tg:member (itm1)
  (vl-some
    (function
      (lambda (itm0)
       (eq (car itm0) (car itm1))
      )
    )
   blk_list 
  )
 ); tg:member

  
 (defun tg:exist (itm1 / dp1)
  (setq dp1 (caadr itm1))
  (vl-some
   (function
     (lambda (itm0)
      (if (and
           (eq (car itm0) (car itm1))
           (vl-some  
             (function
	       (lambda (dp0)
                (equal (cadr (cadr dp0)) (cadr (cadr dp1)) 1e-1)
	       ); lambda
             ); function
	     (cadr itm0)
	   ); vl-some
          ); and
        itm0 ; return
      ); if
     ); lambda
   ); function
   blk_list
  ); vl-some
 );  tg:exist

  
 (defun tg:format_counter ()
  (cond
   ((< counter 10)
    (strcat "Item:0" (itoa counter))
   )
   ( t
    (strcat "Item:" (itoa counter))
   )
  )
 ); tg:format_counter


 (setvar "cmdecho" 0)
 (command "._undo" "_begin")
  
 (if (setq blkss (ssget '((0 . "INSERT") (66 . 1))))
  (progn
   (setq counter 0)

   ; build database
   (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex blkss)))
    (setq AcDbBlkRef (vlax-ename->vla-object ename))
    (setq blk_name (strcase (vla-get-effectiveName AcDbBlkRef)))
    (setq p0 (vlax-safearray->list (vlax-variant-value (vla-get-insertionPoint AcDbBlkRef))))
    (setq dt0 (list blk_Name (list (list ename p0))))
     
    (cond
     ((null (tg:member dt0))
      (setq blk_list (cons dt0 blk_list))
     ); case
     ((setq itm0 (tg:exist dt0))
      (setq blk_list (vl-remove itm0 blk_list))
      (setq itm1 (list (car itm0) (cons (list ename p0) (cadr itm0))))
      (setq blk_list (cons itm1 blk_list))
     ); case
     ( t
      (setq blk_list (cons dt0 blk_list))
     ); case
    ); cond
     
    (vlax-release-object AcDbBlkRef) 
   ); foreach


   ; set attributes
   (foreach itm0 (vl-sort blk_list (function (lambda (e0 e1) (< (cadadr (caadr e0)) (cadadr (caadr e1)))))) ; sorting by Y
    (setq counter (1+ counter))
    (foreach itm1 (cadr itm0)
     (vl-catch-all-apply 'setpropertyvalue (list (car itm1) "item" (tg:format_counter)))
    ); foreach
   ); foreach
   
  ; (command "_updatefield" "_si" blkss)
  ); progn 
 ); if
  
 ; (command "_regenall")
  
 (command "._undo" "_end")
 (setvar "cmdecho" 0)
  
 (princ)
); c:TagID

[pierre_costeS8GW8]

Your routine is working exactly as i thought it would. Thank you very much !! You helped me a lot and may be usefull for others.

[Moshe-A]

@pierre_costeS8GW8 

Thank you for that, glade it's working for you but over night i realized that this will not work on all cases

say another 2 "A" blocks is laied above the 2 bellow in that case the 2 will not consider 'brothers' so

if you want to take it from here go ahead or wait untill i'll finish this 😀

Moshe

[pierre_costeS8GW8]

If you could do that it would be even better, i will wait ... thank you

[Moshe-A · Accepted solution]

@pierre_costeS8GW8 

That was more easy than i tought 🤣

enjoy

Moshe

[pierre_costeS8GW8]

Thank you very much for your help !!