TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: deegeecees 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.
-
Please elaborate on what you define as a "unique block name".
-
Hi
(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))
)
)
)
@+
-
This one returns a list of each Insert in the drawing. <edit>
(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 '<)
)
Command: blknames
("B1" "B2" "B3" "B4" "B5" "B6")
-
(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
-
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:
(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'~
-
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.
(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
)
Command: blkcount
(("B1" . 3) ("B2" . 4) ("B3" . 4) ("B4" . 4) ("B5" . 1))
-
Good catch Fatty.
Here is my modified code.
(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'~
-
Very kind of you to say. :-)
Thank you sir.
-
Here is my modified code.
Yes, and it's not a list of unique blocks in the drawing
@+
-
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'<
-
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"
(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
)
Command: blkunique
("B5" "B6")
-
> 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
@+
-
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]
-
> 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'~
-
Sorry, had another job interview. You guys are quite kind, thankyou.
-
Peter, I think you code is great & looking for another way to deal with the dynamic block names, I could only offer a variation of your method.
I suspect this version would be slower with a large number of blocks.
;; a variant to include dynamic blocks
;; retrurns only block names that have one block only in the dwg
(defun c:blkunique2 (/ ss lst itm result)
(and
(setq ss (ssget "x" (list (cons 0 "INSERT"))))
(setq lst (mapcar '(lambda (x)
(if (vlax-property-available-p x 'EffectiveName)
(vla-get-EffectiveName x)
(vla-get-Name x)
))
(mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex ss))))
)
(while (setq itm (car lst))
(setq len (length lst)
lst (vl-remove itm lst)
cnt (- len (length lst))
)
(if (= cnt 1)
(setq result (cons itm result)))
)
)
(vl-sort result '<)
)