AutoLISP: Walk Blocks

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)

;;;===========================================================================
Advertisements

About AutoCAD Tips

This blog serves as a knowledge base for myself (and anyone else) so that I can reference tips & tricks that I have learned and also refer others to it as well. I hope that this blog helps you learn at least one tip to make your drafting/design experience better.
This entry was posted in AutoLISP, Blocks, TIPS. Bookmark the permalink.

One Response to AutoLISP: Walk Blocks

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

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s