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