Topic: Dynamic Blocks Names vs. Non Dynamic Block names

[alanjt]

cat...

Code: [Select]

(defun getBlocksByName (bname / ss)
  (vl-load-com)
  (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
    ((lambda (i n / e)
       (while (setq e (ssname ss (setq i (1+ i))))
         (or (eq n (strcase (vla-get-effectivename (vlax-ename->vla-object e)))) (ssdel e ss))
       )
       (sssetfirst nil ss)
     )
      -1
      (strcase bname)
    )
  )
)

[Harrie]

Thanks Ronjonp,

But I prefer it, like this:

Code: [Select]

(defun getblocksbyname2 (bname / obj ss ss2)
  (vl-load-com)
  (setq ss2 (ssadd))
  (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
    (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (setq obj (vlax-ename->vla-object blk))
      (and (eq (strcase bname) (strcase (vla-get-effectivename obj))) (setq ss2 (ssadd blk ss2)))
    )
  )
  ;(sssetfirst nil ss2)
  ss2
)Because with (sssetfirst nil ss2), I can't use it in _.PSELECT from PROPERTIES.

Regards, Harrie.

[Harrie]

Thanks Alanjt,

But your program gives the same problem as the program from Lee Mac.

Regards, Harrie.

[gile]

cat...

Code: [Select]

(defun getBlocksByName (bname / ss)
  (vl-load-com)
  (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
    ((lambda (i n / e)
       (while (setq e (ssname ss (setq i (1+ i))))
         (or (eq n (strcase (vla-get-effectivename (vlax-ename->vla-object e)))) (ssdel e ss))
       )
       (sssetfirst nil ss)
     )
      -1
      (strcase bname)
    )
  )
)

Alan, while you're removing items from the selection set you're stepping, you cannot increment with 1+ systematically...
EDIT: Same problem with Lee's code.

Increment by 1+ only if the item isn't deleted

Code: [Select]

(defun getBlocksByName (bname / ss)
  (vl-load-com)
  (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
    ((lambda (i n / e)
       (while (setq e (ssname ss i))
         (if (eq n (strcase (vla-get-effectivename (vlax-ename->vla-object e))))
   (setq i (1+ i))
   (ssdel e ss)
)
       )
       (sssetfirst nil ss)
     )
      0
      (strcase bname)
    )
  )
)
Or décrement (1-)

Code: [Select]

(defun getBlocksByName (bname / ss)
  (vl-load-com)
  (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
    ((lambda (i n / e)
       (while (setq e (ssname ss (setq i (1- i))))
         (or (eq n (strcase (vla-get-effectivename (vlax-ename->vla-object e)))) (ssdel e ss))
       )
       (sssetfirst nil ss)
     )
      (sslength ss)
      (strcase bname)
    )
  )
)

[CAB]

Just a little FYI.
This is over kill
(setq ss2 (ssadd blk ss2))
You only need this:
(ssadd blk ss2) ; adds blk to selection set

[Harrie]

Thanks Gile,

Your programs gives a good result in DynBlkTest.dwg.
But, I prefer at the end:

Code: [Select]

  )
ss
)Because then I can use it in  _.PSELECT from PROPERTIES.

Regards, Harrie.

[gile]

Thanks Gile,

Your programs gives a good result in DynBlkTest.dwg.
But, I prefer at the end:

Code: [Select]

  )
ss
)Because then I can use it in  _.PSELECT from PROPERTIES.

Regards, Harrie.

So, here's the way I'd have written it:

Code: [Select]

(defun ssBlocksByName (bname / ss n blk)
  (vl-load-com)
  (if
    (setq bname (strcase bname)
  ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*"))))
    )
     (repeat (setq n (sslength ss))
       (and
(setq blk (ssname ss (setq n (1- n))))
(/= bname (strcase (vla-get-effectivename (vlax-ename->vla-object blk))))
(ssdel blk ss)
       )
     )
  )
  ss
)

[Harrie]

Thanks Gile,

So, here's the way I'd have written it: Yes.

Regards, Harrie.

[alanjt]

Crap, I didn't even think about that. Thanks Gile.

cat...

Code: [Select]

(defun getBlocksByName (bname / ss)
  (vl-load-com)
  (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
    ((lambda (i n / e)
       (while (setq e (ssname ss (setq i (1+ i))))
         (or (eq n (strcase (vla-get-effectivename (vlax-ename->vla-object e)))) (ssdel e ss))
       )
       (sssetfirst nil ss)
     )
      -1
      (strcase bname)
    )
  )
)

Alan, while you're removing items from the selection set you're stepping, you cannot increment with 1+ systematically...
EDIT: Same problem with Lee's code.

Increment by 1+ only if the item isn't deleted

Code: [Select]

(defun getBlocksByName (bname / ss)
  (vl-load-com)
  (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
    ((lambda (i n / e)
       (while (setq e (ssname ss i))
         (if (eq n (strcase (vla-get-effectivename (vlax-ename->vla-object e))))
   (setq i (1+ i))
   (ssdel e ss)
)
       )
       (sssetfirst nil ss)
     )
      0
      (strcase bname)
    )
  )
)
Or décrement (1-)

Code: [Select]

(defun getBlocksByName (bname / ss)
  (vl-load-com)
  (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
    ((lambda (i n / e)
       (while (setq e (ssname ss (setq i (1- i))))
         (or (eq n (strcase (vla-get-effectivename (vlax-ename->vla-object e)))) (ssdel e ss))
       )
       (sssetfirst nil ss)
     )
      (sslength ss)
      (strcase bname)
    )
  )
)

[Lee Mac]

Crap, I didn't even think about that. Thanks Gile.

Ditto, completely overlooked that  :ugly:

Thanks guys 

[ronjonp]

Thanks Ronjonp,

But I prefer it, like this:

Code: [Select]

(defun getblocksbyname2 (bname / obj ss ss2)
  (vl-load-com)
  (setq ss2 (ssadd))
  (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
    (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (setq obj (vlax-ename->vla-object blk))
      (and (eq (strcase bname) (strcase (vla-get-effectivename obj))) (setq ss2 (ssadd blk ss2)))
    )
  )
  ;(sssetfirst nil ss2)
  ss2
)Because with (sssetfirst nil ss2), I can't use it in _.PSELECT from PROPERTIES.

Regards, Harrie.

sssetfirst wil select them for you ... what is pselect?

[alanjt]

Thanks Ronjonp,

But I prefer it, like this:

Code: [Select]

(defun getblocksbyname2 (bname / obj ss ss2)
  (vl-load-com)
  (setq ss2 (ssadd))
  (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
    (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (setq obj (vlax-ename->vla-object blk))
      (and (eq (strcase bname) (strcase (vla-get-effectivename obj))) (setq ss2 (ssadd blk ss2)))
    )
  )
  ;(sssetfirst nil ss2)
  ss2
)Because with (sssetfirst nil ss2), I can't use it in _.PSELECT from PROPERTIES.

Regards, Harrie.

sssetfirst wil select them for you ... what is pselect?

The only difference I've ever noticed is that, unlike Select, PSelect will leave the selected item(s) selected.

[HofCAD]

Like this:

Code: [Select]

(defun GetBlocksByName (bname / obj ss ss2)
  (vl-load-com)
  (setq ss2 (ssadd))
  (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")))))
    (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (setq obj (vlax-ename->vla-object blk))
      (and (eq (strcase bname) (strcase (vla-get-effectivename obj))) (ssadd blk ss2))
    )
  )
  ss2
)
(defun c:SELDYNBLK(/ BlkName)
(vl-load-com)
(setq BlkName (getstring "\nEnter block name or <Select>:"))
(if (= BlkName "")
(setq BlkName (vla-get-effectivename (vlax-ename->vla-object(car (entsel)))))
)
(setq S (GetBlocksByName BlkName))
;(princ (strcat "\nThere are " (itoa (sslength S)) " blocks in the selection.\n"))
(command "_.PSELECT" S "")
)
(defun C:SDB() (c:SELDYNBLK))
Regards, HofCAD CSI.

[Lee Mac]

Of course, there is another method 

Code: [Select]

(defun test ( block )
  (ssget "_X"
    (list
      (cons 0 "INSERT")
      (cons 2 (LM:BlockList->Str (cons block (LM:AnonymousInstancesof block)) ","))
    )
  )
)

(defun LM:AnonymousInstancesof ( block / def rec nme ref lst )
  (while (setq def (tblnext "BLOCK" (null def)))
    (if (= 1 (logand 1 (cdr (assoc 70 def))))
      (progn
        (setq rec
          (entget
            (cdr
              (assoc 330
                (entget
                  (tblobjname "BLOCK" (setq nme (cdr (assoc 2 def))))
                )
              )
            )
          )
        )
        (while (setq ref (assoc 331 rec))
          (if
            (and
              (eq block (vla-get-effectivename (vlax-ename->vla-object (cdr ref))))
              (not (member nme lst))
            )
            (setq lst (cons nme lst))
          )
          (setq rec (cdr (member (assoc 331 rec) rec)))
        )
      )
    )
  )
  (reverse lst)
)

(defun LM:BlockList->Str ( lst del / f )

  (defun f ( s ) (if (wcmatch s "`**") (strcat "`" s) s))
 
  (if (cdr lst)
    (strcat (f (car lst)) del (LM:BlockList->Str (cdr lst) del))
    (f (car lst))
  )
)


[ronjonp]

Similar to Lee's but will output a list '(("blockname" (ename1 ename2 ename3)))

Code: [Select]

(defun rjp-getinsertedblocks (/ b brec inserts name o out)
  (while (setq b (tblnext "block" (not b)))
    (if (not (assoc 1 b))
      ;;xref path
      (progn (setq name   (cdr (assoc 2 b))
  brec   (entget (cdr (assoc 330 (entget (tblobjname "block" name)))))
  inserts (cdr (member '(102 . "{BLKREFS") brec))
  inserts (mapcar (function cdr) (cdr (member '(102 . "}") (reverse inserts))))
    )
    (if (and (setq inserts (vl-remove-if-not (function (lambda (x) (entget x))) inserts))
     (setq o (vlax-ename->vla-object (car inserts)))
     (vlax-property-available-p o 'effectivename)
     (setq name (vla-get-effectivename o))
)
      (if (assoc name out)
(setq out (mapcar (function (lambda (x)
      (if (eq (car x) name)
(list name (append (cadr x) inserts))
x
      )
    )
  )
  out
  )
)
(setq out (cons (list name inserts) out))
      )
    )
      )
    )
  )
  (vl-sort out (function (lambda (n1 n2) (< (car n1) (car n2)))))
)

(mapcar '(lambda (x) (print (strcat (car x) " - " (itoa (length (cadr x))))))
(rjp-getinsertedblocks)
)