Message 1 of 11
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi,
Does anyone know of a LISP that functions just like the new COUNT command introduced in ACAD 2022? I'm using AutoCAD 2021 - so I don't have access to the COUNT feature in newer versions of ACAD.
I came across something similar in another forum and I'm trying to work with it - but it requires a lot of nudging to get it to do what I want it to do:
- Display a dialog with a block name list & quantity count of all first-level named blocks in Model Space (ignore nested blocks)
- Allow the user to select a block name from the dialog and see all instances of that block highlighted (with Insert node visible, preferably)
- Allow the user to zoom / pan around the drawing to look at the insertions of said block
- And and also it would be ideal if all the non-selected entities (everything but the highlighted/selected block name) went to 50% dim/fade - tho I'm not even sure this is possible. The code below turns the non-selected blocks visibility off - but I need them to stay visible, just dim them down.
I'm conversant in LISP & VLISP - but I'm rusty after not using it for the past 4 years or so... but I'm happy to work with anything or guidance anyone can share. Thanks!
Here's what I've been working with so far (but I'm willing to go in a completely different direction if needed):
;;;============================================================================================================================================================================
;;; Walk Blocks by Some Buddy for the CAD community.
;;; This program is freeware. Use it, change it, improve it, hack it as you wish :)
;;; Functions HIDEOTHERS and SHOWALL provided by balisteor
;;;============================================================================================================================================================================
(defun walk_blocks (
/
activedoc
layers
getblocks
matched_blocks
hideothers
showall
highlightit
bbox->points
write_dcl_code_to
implied_selection
user_selection
tempfile
dclfile
what_next
dcl_id1
xref_flag
blockslist
selvalue
walk_type
selblock
next_block
dcl_ok
yes_no
refresh_list
spinning_wheel
alter_layers
restore_layers
implied_selection
blocksdata
blockslist
blockslayerslist
do_the_walk_type
tabbed_selblock
action_tile_blocks_list
action_tile_walk_type
action_tile_pan_zoom
action_tile_zoom_object
action_tile_zoom_previous
action_tile_select
action_tile_next
action_tile_cancel
what_next
)
(vl-load-com)
(setq activedoc (vla-get-activedocument (vlax-get-acad-object)))
(setq layers (vla-get-layers activedoc))
(defun *error* (s)
(if *errdump* (vl-bt))
(if dcl_ok
(progn
(unload_dialog dcl_id1)
(vl-file-delete tempfile)
)
)
(showall user_selection nil)
(sssetfirst nil nil)
(restore_layers blockslayerslist)
(princ)
)
(defun sset->vlsset (argsset / ssets vlssets assoc_list max_vlsset vlsset safe_array index)
(setq ssets (vla-get-selectionsets activedoc))
(vlax-for sset ssets
(if (wcmatch (vla-get-name sset) "*`#VLSSET")
(setq vlssets (cons (vla-get-name sset) vlssets))
)
)
(foreach element vlssets
(setq assoc_list
(cons (cons (atoi element) element) assoc_list)
)
)
(if (zerop (length assoc_list))
(setq max_vlsset "0#VLSSET")
(setq max_vlsset
(cdr
(car
(vl-sort
assoc_list
'(lambda (x1 x2)(> (car x1)(car x2)))
)
)
)
)
)
(setq vlsset
(vla-add
ssets
(strcat (itoa (1+ (atoi max_vlsset))) "#VLSSET")
)
)
(setq safe_array
(vlax-make-safearray vlax-vbobject (cons 0 0))
)
(setq index 0)
(repeat (sslength argsset)
(vlax-safearray-put-element
safe_array
0
(vlax-ename->vla-object (ssname argsset index))
)
(vla-additems vlsset safe_array)
(setq index (1+ index))
)
vlsset
)
(defun countgroup (inlist / outlist existing_item)
(vl-sort
(foreach item inlist
(if (not (member (assoc item outlist) outlist))
(setq outlist (cons (cons item 1) outlist))
(progn
(setq existing_item
(car (member (assoc item outlist) outlist))
)
(setq outlist
(subst
(cons item (1+ (cdr existing_item)))
existing_item
outlist
)
)
)
)
)
'(lambda(x y)(< (car x)(car y)))
)
)
(defun addtabs (inlist / tabslist)
(foreach item inlist
(setq tabslist
(cons
(strcat
(itoa (cdr item))
"\t"
(car item)
)
tabslist
)
)
)
(reverse tabslist)
)
; (defun addtabs (inlist / tabslist)
; (foreach item inlist
; (setq tabslist
; (cons
; (strcat
; (chr 40)
; (cond
; ( (< (cdr item) 10)
; "__"
; )
; ( (and
; (>= (cdr item) 10)
; (< (cdr item) 100)
; )
; "_"
; )
; (T "")
; )
; (itoa (cdr item))
; (chr 41)
; "\t"
; (car item)
; )
; tabslist
; )
; )
; )
; (reverse tabslist)
; )
(defun striptab (string)
(substr string (+ (vl-string-position (ascii "\t") string) 2))
)
(defun getblocks (
selection
xref_flag
layeron_flag
freeze_flag
locked_flag
/
is_object_valid
blocknameslist
blocklayer
)
(defun is_object_valid (object xref_flag layeron_flag freeze_flag locked_flag)
(if xref_flag
(=
(vla-get-objectname object)
"AcDbBlockReference"
)
(and
(=
(vla-get-objectname object)
"AcDbBlockReference"
)
(=
(vla-get-isxref
(vla-item
(vla-get-blocks document)
(vla-get-effectivename object)
)
)
:vlax-false
)
)
)
)
(vlax-for object (sset->vlsset selection)
(if (is_object_valid object xref_flag layeron_flag freeze_flag locked_flag)
(progn
(setq blocknameslist
(cons
(vla-get-effectivename object)
blocknameslist
)
)
(setq blocklayer (vla-get-layer object))
(setq currlaystatus
(list
blocklayer
(cons "LayerOn" (vla-get-layeron (vla-item layers blocklayer)))
(cons "Freeze" (vla-get-freeze (vla-item layers blocklayer)))
(cons "Lock" (vla-get-lock (vla-item layers blocklayer)))
)
)
(if (not (member currlaystatus blockslayerslist))
(setq blockslayerslist (cons currlaystatus blockslayerslist))
)
)
)
)
(if blocknameslist
(list (acad_strlsort blocknameslist) blockslayerslist)
)
)
;;;*******************************************************************************
;;; Code provided by balisteor starts here
;;;*******************************************************************************
(defun hideothers (selection blockname / index ent object layer layermode effname)
(if selection
(progn
(set_tile "working" "Working: ")
(repeat (setq index (sslength selection))
(setq ent (ssname selection (1- index)))
(setq object (vlax-ename->vla-object ent))
(if
(setq effname
(vlax-property-available-p object 'effectivename)
)
(if
(=
(strcase blockname)
(strcase (vlax-get-property object 'effectivename))
)
(if (vlax-property-available-p object 'Visible)
(vlax-put-property object 'Visible -1)
)
(if (vlax-property-available-p object 'Visible)
(vlax-put-property object 'Visible 0)
)
)
(if (vlax-property-available-p object 'Visible)
(vlax-put-property object 'Visible 0)
)
)
(setq index (1- index))
(set_tile "spinning_wheel" (spinning_wheel (get_tile "spinning_wheel")))
)
)
)
(set_tile "working" "")
(set_tile "spinning_wheel" "")
(princ)
)
;;;***************************************************************
;;; Code provided by balisteor ends here
;;;***************************************************************
;;;***************************************************************
;;; Code provided by balisteor starts here
;;;***************************************************************
(defun showall (selection flag / index ent object layer layermode)
(if selection
(progn
(set_tile "working" "Working: ")
(repeat (setq index (sslength selection))
(setq ent (ssname selection (1- index)))
(setq object (vlax-ename->vla-object ent))
(if (vlax-property-available-p object 'visible)
(if (vlax-property-available-p object 'visible)
(vlax-put-property object 'visible -1)
)
)
(setq index (1- index))
(if flag
(set_tile "spinning_wheel" (spinning_wheel (get_tile "spinning_wheel")))
)
)
)
)
(if flag
(progn
(set_tile "working" "")
(set_tile "spinning_wheel" "")
)
)
(princ)
)
;;;*************************************************************
;;; Code provided by balisteor ends here
;;;*************************************************************
(defun highlightit (selection blockname flag / index ent object)
(if selection
(progn
(set_tile "working" "Working: ")
(repeat (setq index (sslength selection))
(setq ent (ssname selection (1- index)))
(setq object (vlax-ename->vla-object ent))
(if (vlax-property-available-p object 'effectivename)
(if
(=
(strcase blockname)
(strcase (vlax-get-property object 'effectivename))
)
(progn
(if flag
(vla-highlight object :vlax-true)
(vla-highlight object :vlax-false)
)
(setq matched_blocks(cons object matched_blocks))
;(sssetfirst nil selection) ;;turn the blue grips on
)
)
)
(setq index (1- index))
(set_tile "spinning_wheel" (spinning_wheel (get_tile "spinning_wheel")))
)
)
)
(set_tile "working" "")
(set_tile "spinning_wheel" "")
(princ)
)
(defun bbox->points (object)
(if object
(progn
(vlax-invoke-method
object
'getboundingbox
'minpoint
'maxpoint
)
(list minpoint maxpoint)
)
)
)
(defun write_dcl_code_to (file)
(write-line
(strcat
"listbox:dialog{"
"label=\"Walk Blocks\";"
"width=50;"
": spacer{"
"height=0.01;"
"}"
": column{"
"label=\"Select Block\";"
": text{"
"label=\"Refs Block name\";"
"}"
": list_box{"
"key=\"blocks_list\";"
"allow_accept=true;"
"tabs=\"6\";"
"height=20;"
"}"
": button{"
"label=\" Next > \";"
"key=\"next\";"
"is_enabled=false;"
"is_default=true;"
"}"
"}"
": row {"
": boxed_radio_column{"
"label=\"Walking Type\";"
"key=\"walk_type\";"
": spacer{"
"height=0.01;"
"}"
": radio_button{"
"label=\"Isolate\";"
"key=\"isolate\";"
"}"
": spacer{"
"height=1;"
"}"
": radio_button{"
"label=\"Highlight\";"
"key=\"highlight\";"
"}"
": spacer{"
"height=0.01;"
"}"
"}"
": boxed_column{"
"label=\"Zoom/Pan\";"
"fixed_width=true;"
"width=16;"
": button{"
"label=\"General Pan/Zoom\";"
"key=\"pan_zoom\";"
"}"
": button{"
"label=\"Zoom To Block\";"
"key=\"zoom_object\";"
"}"
": button{"
"label=\"Zoom Previous\";"
"key=\"zoom_previous\";"
"}"
"}"
"}"
": row {"
"alignment = centered;"
": spacer{"
"width=0.01;"
"}"
": button{"
"label=\" Select > \";"
"key=\"select\";"
"}"
": spacer{"
"width=1;"
"}"
": button{"
"label=\" Close \";"
"key=\"cancel\";"
"is_cancel=true;"
"}"
": spacer{"
"width=0.01;"
"}"
"}"
": row{"
": concatenation{"
": text_part{"
"key=\"working\";"
"width=9;"
"}"
": text_part{"
"key=\"spinning_wheel\";"
"}"
"}"
"}"
"}"
"yes_no:dialog{"
"label=\"Walk Blocks Question\";"
": text{"
"key=\"message1\";"
"alignment=centered;"
"width=37;"
"}"
": text{"
"key=\"message2\";"
"alignment=centered;"
"width=37;"
"}"
": row{"
"alignment=centered;"
"fixed_width=true;"
": button{"
"label=\"Yes\";"
"key=\"accept\";"
"fixed_width=true;"
"width=12;"
"}"
": button{"
"label=\"No\";"
"key=\"cancel\";"
"fixed_width=true;"
"width=12;"
"is_default=true;"
"is_cancel=true;"
"}"
"}"
"}"
)
file
)
)
(defun yes_no (message1 message2 / dcl_id2)
(setq dcl_id2 (load_dialog tempfile))
(if (not (new_dialog "yes_no" dcl_id2 "" yes_no_DCL_position))
(progn
(alert "Dialog definition not found.")
(vl-file-delete tempfile)
(exit)
)
)
(set_tile "message1" message1)
(set_tile "message2" message2)
(action_tile "accept" "(setq yes_no_DCL_position (done_dialog 1))")
(action_tile "cancel" "(setq yes_no_DCL_position (done_dialog 0))")
(setq answer (start_dialog))
(unload_dialog dcl_id2)
answer
)
(defun refresh_list (key lst)
(start_list key)
(mapcar 'add_list lst)
(end_list)
)
(defun spinning_wheel (wheel)
(cond
( (= wheel "|") "/")
( (= wheel "/") "-")
( (= wheel "-") "\\")
(T "|")
)
)
(defun alter_layers (blockslayerslist)
(setq current_layer (vla-get-activelayer activedoc))
(vla-add layers "temp")
(vla-put-activelayer activedoc (vla-item layers "temp"))
(foreach item blockslayerslist
(vla-put-layeron (vla-item layers (car item)) :vlax-true)
(vla-put-freeze (vla-item layers (car item)) :vlax-false)
(vla-put-lock (vla-item layers (car item)) :vlax-false)
)
;(command "_.layer" "_oN" "DEFPOINTS" "" "")
;ADD CODE TO TURN ON DEFPOINTS HERE
)
(defun restore_layers (blockslayerslist / layer_temp)
(foreach item blockslayerslist
(vla-put-layeron (vla-item layers (car item))(cdr (assoc "LayerOn" (cdr item))))
(vla-put-freeze (vla-item layers (car item))(cdr (assoc "Freeze" (cdr item))))
(vla-put-lock (vla-item layers (car item))(cdr (assoc "Lock" (cdr item))))
)
(vla-put-activelayer activedoc current_layer)
(if
(not
(vl-catch-all-error-p
(setq layer_temp
(vl-catch-all-apply 'vla-item (list layers "temp"))
)
)
)
(vla-delete layer_temp)
)
)
(sssetfirst nil nil)
(setq implied_selection (ssgetfirst))
(if
(and
(not (setq user_selection (cadr implied_selection)))
(not (setq user_selection (car implied_selection)))
)
;(setq user_selection (ssget))
(setq user_selection (ssget '((0 . "INSERT, MTEXT") (-4 . "<NOT") (8 . "DEFPOINTS") (-4 . "NOT>"))))
;(setq user_selection (ssget '((0 . "MTEXT,INSERT") (-4 . "<NOT") (8 . "DEFPOINTS") (-4 . "NOT>"))))
;(setq user_selection (ssget (8 . "DEFPOINTS")))
;(setq user_selection (ssget (-4 . "<NOT") (8 . "DEFPOINTS") (-4 . "NOT>")))
)
(setq what_next 1)
(while (> what_next 0)
(if user_selection
(progn
(setq blocksdata (getblocks user_selection T nil nil nil))
(setq blockslist (addtabs (countgroup (car blocksdata))))
(setq blockslayerslist (cadr blocksdata))
(if blocksdata
(progn
(setq dcl_ok T)
(setq tempfile (vl-filename-mktemp "tempfile.dcl"))
(setq dclfile (open tempfile "w"))
(write_dcl_code_to dclfile)
(close dclfile)
(setq dcl_id1 (load_dialog tempfile))
(if (not (new_dialog "listbox" dcl_id1 "" walk_blocks_DCL_position))
(progn
(alert "Dialog definition not found.")
(vl-file-delete tempfile)
(exit)
)
)
(alter_layers blockslayerslist)
(refresh_list "blocks_list" blockslist)
(if selblock
(progn
(set_tile
"blocks_list"
(if (not (wcmatch selblock "*`\t*"))
(itoa (vl-position tabbed_selblock blockslist))
(itoa (vl-position selblock blockslist))
)
)
(mode_tile "next" 0)
)
)
(if (not walk_type)(setq walk_type "highlight"))
(set_tile "walk_type" walk_type)
(set_tile "working" "")
(set_tile "spinning_wheel" "")
;;(if xref_flag
;; (set_tile "include_xrefs" "1")
;; (set_tile "include_xrefs" "0")
;;)
(defun do_the_walk_type (walk_mode)
(if selblock
(if (= walk_mode "isolate")
(progn
(highlightit user_selection selblock nil)
(hideothers user_selection selblock)
)
(progn
(showall user_selection T)
(highlightit user_selection selblock T)
)
)
(progn
(set_tile "working" "")
(set_tile "spinning_wheel" "")
(alert "Nothing selected.")
)
)
)
(defun action_tile_blocks_list (value)
(setq selvalue value)
(setq tabbed_selblock (nth (atoi selvalue) blockslist))
(setq selblock (striptab (nth (atoi selvalue) blockslist)))
(mode_tile "next" 0)
(set_tile "working" "Working: ")
(do_the_walk_type walk_type)
)
(defun action_tile_walk_type (value)
(setq walk_type value)
(set_tile "working" "Working: ")
(do_the_walk_type walk_type)
)
;;(defun action_tile_include_xrefs (value)
;; (alert "value")
;;)
(defun action_tile_pan_zoom ()
(setq walk_blocks_DCL_position (done_dialog 1))
)
(defun action_tile_zoom_object ( / ll ur)
(if matched_blocks
(progn
(vla-getboundingbox (car matched_blocks) 'll 'ur)
(vla-zoomwindow (vlax-get-acad-object) ll ur)
)
(progn
(set_tile "working" "")
(set_tile "spinning_wheel" "")
(alert "Nothing selected.")
)
)
)
(defun action_tile_zoom_previous ()
(if matched_blocks
(vla-zoomprevious (vlax-get-acad-object))
(alert "Nothing selected.")
)
)
(defun action_tile_select ()
(if
(not
(zerop
(yes_no
"Do you really want to discard the current"
"selection set and make a new selection ?"
)
)
)
(setq walk_blocks_DCL_position (done_dialog 2))
)
)
(defun action_tile_next ( / item)
(set_tile "working" "Working: ")
(setq item (atoi (get_tile "blocks_list")))
(if (= item (1- (length blockslist)))
(progn
(set_tile "blocks_list" "0")
(setq tabbed_selblock (nth 0 blockslist))
(setq selblock (striptab (nth 0 blockslist)))
(do_the_walk_type walk_type)
)
(progn
(set_tile "blocks_list" (itoa (1+ item)))
(setq tabbed_selblock (nth (1+ item) blockslist))
(setq selblock (striptab (nth (1+ item) blockslist)))
(do_the_walk_type walk_type)
)
)
)
(defun action_tile_cancel ()
(setq walk_blocks_DCL_position (done_dialog 0))
)
(action_tile "blocks_list" "(action_tile_blocks_list $value)")
(action_tile "walk_type" "(action_tile_walk_type $value)")
;;(action_tile "include_xrefs" "(action_tile_include_xrefs $value)")
(action_tile "pan_zoom" "(action_tile_pan_zoom)")
(action_tile "zoom_object" "(action_tile_zoom_object)")
(action_tile "zoom_previous" "(action_tile_zoom_previous)")
(action_tile "select" "(action_tile_select)")
(action_tile "next" "(action_tile_next)")
(action_tile "cancel" "(action_tile_cancel)")
(setq what_next (start_dialog))
(cond
( (= what_next 1)
(getstring
"\nUse mouse wheel to Zoom and Pan, press [Enter] when done: "
)
(restore_layers blockslayerslist)
)
( (= what_next 2)
(showall user_selection nil)
(sssetfirst nil nil)
(setq selblock nil)
(setq blockslist nil)
(restore_layers blockslayerslist)
(setq blockslayerslist nil)
(setq user_selection (ssget))
;(setq user_selection (ssget ((-4 . "<NOT") (8 . "DEFPOINTS") (-4 . "NOT>"))))
;(setq user_selection (ssget (8 . "DEFPOINTS")))
)
)
)
(progn
(alert "No block found in the selection.")
(setq what_next 0)
)
)
)
(progn
(alert "Nothing selected.")
(setq what_next 0)
)
)
(unload_dialog dcl_id1)
)
(vl-file-delete tempfile)
(showall user_selection nil)
(sssetfirst nil nil)
(restore_layers blockslayerslist)
(princ)
)
;;;============================================================================================================================================================================
(defun c:wkbks ()(walk_blocks)(princ))
;;;============================================================================================================================================================================
(prompt "\n *** Walk Blocks loaded. Type 'WKBKS' to run the utility ***")(princ)
;;;============================================================================================================================================================================
Solved! Go to Solution.
