0 Members and 1 Guest are viewing this topic.
(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)) ) ))
(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.
(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) )
(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.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)
(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)
Here is my modified code.
QuoteHere is my modified code.Yes, and it's not a list of unique blocks in the drawing@+
(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")
> FattyThe 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 > CabYour code is great, but you don't include dynamic blocks@+