Topic: There must be a better way to code this...

[Lee Mac]

In a recent thread at CADTutor here, a question was posed regarding how to find where a block is nested.

I posted some code to show the general block hierarchy, but I was then was curious about how I might code a function to search for the location of a specific nested block (no matter how deep) - i.e., given a block name, return a list showing where it is nested.

So I put this together:

Code: [Select]

(defun FindNestedBlock ( name / _name _SearchBlockDefinition blocks result )
  ;; © Lee Mac 2011

  (defun _name ( obj )
    (vlax-get-property obj
      (if (vlax-property-available-p obj 'effectivename) 'effectivename 'name)
    )
  )

  (defun _SearchBlockDefinition ( block / result nest )
    (vlax-for obj block
      (if (eq "AcDbBlockReference" (vla-get-objectname obj))
        (if (eq name (_name obj))
          (setq result (list name))
          (if (setq nest (_SearchBlockDefinition (vla-item blocks (_name obj))))
            (setq result (cons (_name obj) nest))
          )
        )
      )
    )
    result
  )

  (setq blocks (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))))

  (vlax-for obj blocks
    (if (eq name (_name obj))
      (setq result (cons (list name) result))
      (if (setq nest (_SearchBlockDefinition obj))
        (setq result (cons nest result))
      )
    )
  )

  (car (vl-sort result '(lambda ( a b ) (> (length a) (length b)))))
)
But I'm really not happy with it, and so wondered if any of you guys could code anything more elegant.

Thanks,

Lee

[VovKa]

my piece

Code: [Select]

(defun test (BlkName / Ent)
    (if (setq Ent (tblobjname "BLOCK" BlkName))
        (mapcar (function (lambda (e)
                              (cons BlkName
                                    (test (cdr (assoc 2 (entget e))))
                              )
                          )
                )
                (vl-remove
                    nil
                    (mapcar (function (lambda (e)
                                          (if (= (car e) 331)
                                              (cdr (assoc 330 (entget (cdr e))))
                                          )
                                      )
                            )
                            (entget (cdr (assoc 330 (entget Ent))))
                    )
                )
        )
    )
)
with a scary output

[gile]

Hi,

Here's a way:

Code: [Select]

(defun FindNestedBlock ( name / _name blocks result )
  ;; © Lee Mac 2011

  (defun _name ( obj )
    (vlax-get-property obj
      (if (vlax-property-available-p obj 'effectivename) 'effectivename 'name)
    )
  )

  (defun contains (block flag)
    (vlax-for obj block
      (or flag
 (and
   (eq "AcDbBlockReference" (vla-get-objectname obj))
   (or (setq flag (eq name (_name obj)))
(setq flag (contains (vla-item blocks (_name obj)) flag))
   )
 )
      )
    )
  )
  
  (setq blocks (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))))

  (vlax-for obj blocks
    (if (eq name (_name obj))
      (setq result (cons name result))
      (if (contains obj nil)
(setq result (cons (_name obj) result))
      )
    )
  )
  result
)

[Lee Mac]

Thanks guys!

I'll spend some time looking over these and get back to you 

[Lee Mac]

Nice idea Gile - that's a much simpler route than I followed... 

As for yours VovKa - I'm going to have to investigate the DXF Structures of the block table a little more... 

[VovKa]

here is the sample drawing
compare the output for block "1" with refedit's tree

[pBe]

Here's my futile attempt using recursion: 

it doesnt show nested list though it only shows where the target block is present inside a block, originally i wrote one to search blocks   on the model and layout tab and not process the BlockTable collection. but anyhoo...

Code: [Select]

(defun SeekMe ( blkn / blk_col cnt b_pr found_lst)
(defun  seekmeagain  (blk blke)
  (if (not (member blk b_pr))
    (progn
      (setq
        b_pr    (cons blk b_pr)
        blk_ent (tblobjname "block" blk))
      (while (setq blk_ent (entnext blk_ent))
        (if (eq (cdr (assoc 0 (entget blk_ent))) "INSERT")
          (if (eq (strcase (cdr (assoc 2 (entget blk_ent))))
                  (strcase blke))
            (setq found_lst (cons blk found_lst))
            (seekmeagain (cdr (assoc 2 (entget blk_ent))) blke))))))
  (princ)) 
  (setq blk_col (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))) cnt 1 b_pr nil)
(repeat (- (vla-get-count blk_col) 2)
  (setq nms (vla-item blk_col (setq cnt (1+ cnt))))
          (seekmeagain (vla-get-name nms) blkn)
          )
(princ (strcat "\nBlock \"" blkn "\" Found:"))
  (foreach nm found_lst
                  (princ (strcat "\n\t" nm))
                  )
  (princ)
  )

still need a lot or work.. oh well