Author Topic: Unique Block Names  (Read 7432 times)

0 Members and 1 Guest are viewing this topic.

deegeecees

  • Guest
Unique Block Names
« on: October 30, 2006, 05:33:49 PM »
How would one get a list of all unique block names within a selection set? I'm creating a sort of customized "bcount" for a client. I think I bit off more than I could chew here for time allowing, help would be greatly appreciated.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Unique Block Names
« Reply #1 on: October 30, 2006, 11:23:24 PM »
Please elaborate on what you define as a "unique block name".
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Patrick_35

  • Guest
Re: Unique Block Names
« Reply #2 on: October 31, 2006, 02:44:03 AM »
Hi

Code: [Select]
(defun ls(/ js bllst ent lstbl tmp)
  (if (setq js (ssget "x" (list (cons 0 "INSERT"))))
    (progn
      (setq lstbl
        (mapcar '(lambda (x)
                   (setq x (vlax-ename->vla-object x))
                   (if (vlax-property-available-p x 'EffectiveName)
                     (vla-get-EffectiveName x)
                     (vla-get-Name x)
                   )
                 )
                 (mapcar 'cadr (ssnamex js))
        )
      )
      (foreach ent lstbl
        (if (not (member ent tmp))
          (setq bllst (append bllst (list (cons ent (length (vl-remove-if-not '(lambda (x) (eq ent x)) lstbl)))))
                tmp (cons ent tmp))
        )
      )
      (mapcar 'car (vl-remove-if-not '(lambda (x) (eq (cdr x) 1)) bllst))
    )
  )
)

@+
« Last Edit: October 31, 2006, 03:26:54 AM by Patrick_35 »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Unique Block Names
« Reply #3 on: October 31, 2006, 06:20:31 AM »
This one returns a list of each Insert in the drawing. <edit>

Code: [Select]
(defun c:blknames (/ ss lst itm result)
  (and (setq ss (ssget "x" (list (cons 0 "INSERT"))))
       (setq lst (mapcar '(lambda (x) (cdr (assoc 2 (entget x))))
                         (mapcar 'cadr (ssnamex ss)))
       )
       (while (setq itm (car lst))
         (setq lst    (vl-remove itm lst)
               result (cons itm result)
         )
       )
  )
  (vl-sort result '<)
)
Code: [Select]
Command: blknames
("B1" "B2" "B3" "B4" "B5" "B6")
« Last Edit: October 31, 2006, 04:17:14 PM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: Unique Block Names
« Reply #4 on: October 31, 2006, 07:03:42 AM »
Code: [Select]
(defun c:test (/ l)
  (if (and (setq l (ssget '((0 . "INSERT"))))
           (setq l (ACAD_STRLSORT
                     (mapcar
                       (function (lambda (x) (cdr (assoc 2 (entget x)))))
                       (vl-remove-if
                         (function listp)
                         (mapcar (function cadr) (ssnamex l))
                       ) ;_  vl-remove-if
                     ) ;_  mapcar
                   ) ;_  ACAD_STRLSORT
           ) ;_  setq
      ) ;_  and
    (vl-remove-if
      (function null)
      (mapcar
        (function (lambda (a b) (if (/= a b) a)))
        l
        (cons (last l) l)
      ) ;_  mapcar
    ) ;_  vl-remove-if
  ) ;_  if
) ;_  defun

Fatty

  • Guest
Re: Unique Block Names
« Reply #5 on: October 31, 2006, 12:15:41 PM »
How would one get a list of all unique block names within a selection set? I'm creating a sort of customized "bcount" for a client. I think I bit off more than I could chew here for time allowing, help would be greatly appreciated.
I guess you need to count blocks
If I am right give this a try:

   
Code: [Select]
   (defun C:cb (/ acsp adoc aexc awb axss blk_data blk_names

cll cnt colm csht data header_list
nwb row sht ss subtot tmp tot)
     
    (vl-load-com)
    (setq adoc (vla-get-activedocument
(vlax-get-acad-object)
       )
  acsp (vla-get-modelspace adoc)
    )
    (vla-zoomextents (vlax-get-acad-object))

    ;;    to count all block instances:
        (setq ss (ssget "_X" '((0 . "INSERT"))))
    ;; or, for desired blocks only:
    ;;;    (setq bname (getstring "\n *** Enter block name(case-sensitive):\n"))
    ;;;    (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 bname))))
    (setq axss (vla-get-activeselectionset adoc))
    (setq tot (vla-get-count axss))
    (setq blk_names nil);for debug only

    (vlax-for blk axss
      (if (not (member (vla-get-name blk) blk_names))
(setq blk_names (cons (vla-get-name blk) blk_names))))

   (foreach bname blk_names
     (setq cnt 0)
     (vlax-for blk axss
       (if (eq bname (vla-get-name blk))
(setq cnt (1+ cnt))))
     (setq tmp (cons bname cnt))
     (setq blk_data (cons tmp blk_data)))

   ;;; *** Excel part *** ;;

    (setq aexc (vlax-get-or-create-object "Excel.Application")
  awb  (vlax-get-property aexc "Workbooks")
  nwb  (vlax-invoke-method awb "Add")
  sht  (vlax-get-property nwb "Sheets")
  csht (vlax-get-property sht "Item" 1)
  cll  (vlax-get-property csht "Cells")
    )
    (vlax-put-property csht 'Name "Block Count")
    (vla-put-visible aexc :vlax-true)
    (setq row 1
  colm 1
    )
    (setq header_list '("BLOCK NAME" "COUNT"))
    (repeat (length header_list)
      (vlax-put-property
cll
"Item"
row
colm
(vl-princ-to-string (car header_list))
      )
      (setq colm (1+ colm)
    header_list
     (cdr header_list)
      )
    )
    (setq row 2
  colm 1
    )
    (repeat (length blk_data)
      (setq data   (car blk_data)
    subtot (cdr data))


  (vlax-put-property
    cll
    "Item"
    row
    colm
    (vl-princ-to-string (car data))
  )
  (setq colm (1+ colm))
         (vlax-put-property
    cll
    "Item"
    row
    colm
    (vl-princ-to-string subtot)
  )

(setq row  (1+ row)
      colm 1
)
      (setq blk_data (cdr blk_data))
      )


    (vlax-put-property
      cll
      "Item"
      row
      colm
      (vl-princ-to-string "TOTAL:")
    )
    (setq colm (1+ colm))
    (vlax-put-property
      cll
      "Item"
      row
      colm
      (vl-princ-to-string tot)
    )
    (setq acl (vlax-get-property csht 'Range "A1"))
    (vlax-put-property (vlax-get-property acl 'Font) 'Bold :vlax-true)
    (vlax-put-property (vlax-get-property acl 'Font) 'ColorIndex (variant 5 3))
    (setq acl (vlax-get-property csht 'Range "B1"))
    (vlax-put-property (vlax-get-property acl 'Font) 'Bold :vlax-true)
    (vlax-put-property (vlax-get-property acl 'Font) 'ColorIndex (variant 5 3))
    (setq usrng (vlax-get-property csht 'UsedRange))
    (vlax-put-property (vlax-get-property usrng 'Borders) 'LineStyle (variant 1 3))
    (vlax-invoke-method (vlax-get-property usrng 'Columns) 'AutoFit)
    (vlax-invoke-method
    nwb
    'SaveAs
    (strcat (getvar "dwgprefix") "BlkCount.xls")
    -4143
    nil
    nil
    :vlax-false
    :vlax-false
    1
    2
    )
    (vlax-invoke-method
    nwb
    'Close)
     (vlax-invoke-method
    aexc
    'Quit)
     
    (vlax-release-object acl)
    (vlax-release-object cll)
    (vlax-release-object usrng)
    (vlax-release-object csht)
    (vlax-release-object sht)
    (vlax-release-object nwb)
    (vlax-release-object awb)
    (vlax-release-object aexc)
    (setq aexc nil)
    (vla-clear axss)
    (vla-delete axss)
    (vlax-release-object axss)
    (gc)
    (gc)
    (princ)
    )
   

Fatty

~'J'~

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Unique Block Names
« Reply #6 on: October 31, 2006, 12:40:24 PM »
Good catch Fatty.
Here is my modified code.
This one returns a list of dotted pairs consisting of the block name & the count for that block for the entire drawing.

Code: [Select]
(defun c:blkcount (/ ss lst itm result)
  (and (setq ss (ssget "x" (list (cons 0 "INSERT"))))
       (setq lst (mapcar '(lambda (x) (cdr (assoc 2 (entget x))))
                         (mapcar 'cadr (ssnamex ss)))
       )
       (setq lst (vl-sort lst '>))
       (while (setq itm (car lst))
         (setq len (length lst))
         (setq lst    (vl-remove itm lst)
               cnt    (- len (length lst))
               result (cons (cons itm cnt) result)
         )
       )
  )
  result
)
Code: [Select]
Command: blkcount
(("B1" . 3) ("B2" . 4) ("B3" . 4) ("B4" . 4) ("B5" . 1))
« Last Edit: October 31, 2006, 04:16:49 PM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Fatty

  • Guest
Re: Unique Block Names
« Reply #7 on: October 31, 2006, 12:45:27 PM »
Good catch Fatty.
Here is my modified code.
Code: [Select]
(defun c:blknames (/ ss lst itm result)
  (and (setq ss (ssget "x" (list (cons 0 "INSERT"))))
       (setq lst (mapcar '(lambda (x) (cdr (assoc 2 (entget x))))
                         (mapcar 'cadr (ssnamex ss)))
       )
       (setq lst (vl-sort lst '>))
       (while (setq itm (car lst))
         (setq len (length lst))
         (setq lst    (vl-remove itm lst)
               cnt    (- len (length lst))
               result (cons (cons itm cnt) result)
         )
       )
  )
  result
)

Absolutely brilliance one, Alan

I have an enjoing with this

I have stealed it in my pocket right now :)

Thanks

~'J'~

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Unique Block Names
« Reply #8 on: October 31, 2006, 01:20:05 PM »
Very kind of you to say. :-)
Thank you sir.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Patrick_35

  • Guest
Re: Unique Block Names
« Reply #9 on: October 31, 2006, 03:24:00 PM »
Quote
Here is my modified code.
Yes, and it's not a list of unique blocks in the drawing

@+

Fatty

  • Guest
Re: Unique Block Names
« Reply #10 on: October 31, 2006, 03:58:24 PM »
Quote
Here is my modified code.
Yes, and it's not a list of unique blocks in the drawing

@+
Tested on 272 instances of 18 differetnt blocks
Works nice for me :)

>'J'<

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Unique Block Names
« Reply #11 on: October 31, 2006, 04:10:22 PM »
Quote
Here is my modified code.
Yes, and it's not a list of unique blocks in the drawing

@+
Well Patrick I was not sure because he mentioned bcount.
But this will produce a list of blocks with a count of one. unique,the single one of its kind; "a singular example"
Code: [Select]
(defun c:blkunique (/ ss lst itm result)
  (and (setq ss (ssget "x" (list (cons 0 "INSERT"))))
       (setq lst (mapcar '(lambda (x) (cdr (assoc 2 (entget x))))
                         (mapcar 'cadr (ssnamex ss)))
       )
       (setq lst (vl-sort lst '>))
       (while (setq itm (car lst))
         (setq len (length lst))
         (setq lst    (vl-remove itm lst)
               cnt    (- len (length lst))
         )
         (if (= cnt 1)  (setq result (cons itm result))))
  )
  result
)
Code: [Select]
Command: blkunique
("B5" "B6")
« Last Edit: October 31, 2006, 04:17:54 PM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Patrick_35

  • Guest
Re: Unique Block Names
« Reply #12 on: October 31, 2006, 04:34:37 PM »
> Fatty
The lisp of CAB working very well, but i think it's not the question of deegeecees, if not it, with the function bcount of the express tools

> Cab
Your code is great, but you don't include dynamic blocks

@+

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Unique Block Names
« Reply #13 on: October 31, 2006, 04:43:32 PM »
This is a perfect example of the situation mentioned somewhere here yesterday.

..

4 perfectly capable code writers running around in circles trying to GUESS the meaning of a code request.
It would make a good cartoon if it wasn't so painfull.

[/just my observation]
« Last Edit: October 31, 2006, 04:44:33 PM by Kerry Brown »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Fatty

  • Guest
Re: Unique Block Names
« Reply #14 on: October 31, 2006, 05:21:04 PM »
> Fatty
The lisp of CAB working very well, but i think it's not the question of deegeecees, if not it, with the function bcount of the express tools

> Cab
Your code is great, but you don't include dynamic blocks

@+
Patrick, I agree with you if so
I haven't to test it on dinamic blocks

~'J'~