This is one of the coolest LISP programs because it takes the same idea and the LAYWALK command which lets you isolate objects that reside on a given layer. In regards to blocks – This lets you locate blocks in your drawing. You can isolate them or zoom in to them and select them so that you know where to start you editing. There are a lot of options with this one, so try it out and as always…
~enjoy
- WB <enter> to start
- Make a selection set that contains the blocks (Can use ALL <enter> to select all blocks in the drawing)
- Try it out on your own from there…
;;;=============================================================
;;; Walk Blocks by Some Buddy for the CAD community. found at the autodesk forums
;;; 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))
)
)
)
(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=28;"
": 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\";"
"key=\"pan_zoom\";"
"}"
": button{"
"label=\"Object\";"
"key=\"zoom_object\";"
"}"
": button{"
"label=\"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)
)
)
(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 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))
)
)
)
(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:wb ()(walk_blocks)(princ))
;;;=========================================================================
(prompt "\n *** Walk Blocks loaded. Type 'WB' to run the utility ***")(princ)
;;;===========================================================================

Pingback: AutoLISP: Find Blocks & Mark Them | AutoCAD Tips