;*** BLKSCALE.LSP
;*** Written by Don J. Buschert
; Southern Alberta Institute of Technology
; 1301 - 16th Ave. N.W.
; Calgary, Alberta Canada
; T2M 0L4
; don.buschert@sait.ab.ca
;
; Version 3.2 03/08/95
; Fixed bugs in List Box.
; Version 3.1 02/09/95
; Added ability to select blocks by selection set
;
; Version 3.0 10/18/94
;***
;
; This dialog program quickly changes the scale of selected blocks,
; using the insertion point of the block as the reference point. The
; scale may be an absolute or relative value to the block's existing.
;
;
; Dialog Options
;
; Select All... Selects all the blocks in the list box.
; Clear All... Clears the selection of blocks.
; Select Objects Allows selection of blocks
; Relative Scales blocks relative to their existing scale.
; Absolute Scales blocks to an absolute scale
; Scale factor The scale factor of which the blocks will be scaled.
;
;
;
;*** Function BKSC_BLKLIST
;This function tests the block name retrieved via TBLNEXT to see if it is
;not externally dependant; then adds it to the block name list.
(defun BKSC_BLKLIST ()
(if bksc_block_item
(progn
(setq bksc_block_name (cdr (assoc '2 bksc_block_item)))
(setq bksc_block_code (cdr (assoc '70 bksc_block_item)))
(if (and
(if (eq (logand bksc_block_code 1) 1) nil T);if anonymous...
(if (eq (logand bksc_block_code 16) 16) nil T);or externally dependant...
)
(progn ;then...
(if (not bksc_block_list)
;create the block list,
(setq bksc_block_list (list bksc_block_name))
;else add name to it
(setq bksc_block_list (cons bksc_block_name bksc_block_list))
)
)
)
)
)
;sort list alphabetically
(if bksc_block_list
(setq bksc_block_list (acad_strlsort bksc_block_list))
)
)
;*** Function BKSC_CHECK
;This function checks to see if the minimum data requirements have been
;inputted by the user...
(defun BKSC_CHECK ( / )

(if (and (or (not bksc_name_list);see if blocks have been picked...
(eq bksc_cbck "");empty callback
)
(not bksc_sst2);see if blocks were selected via selection
)
(alert
(strcat "You must select blocks!")
)
(progn
(done_dialog);end the dialog
(setq bksc_doit T)
)
)
)

;*** Function BKSC_GET_BLOCKS
;This function takes the callback from the list box and returns
;a list of the selected block names...
(defun BKSC_GET_BLOCKS (value)
;convert it to a list
(setq bksc_blk_nlis (string_to_list value))
;if there were blocks picked...
(if bksc_blk_nlis
(progn
;create the name list
(setq bksc_name_list
(list
(nth (nth 0 bksc_blk_nlis) bksc_block_list)
)
)
;if there is more than one block picked...
(if (> (length bksc_blk_nlis) 1)
(progn
(setq bksc_coun 1);counter set to 1 to get second element
(repeat (- (length bksc_blk_nlis) 1)
;retrieve name from original list
(setq bksc_elem
(nth (nth bksc_coun bksc_blk_nlis) bksc_block_list)
)
;append to block name list
(setq bksc_name_list (cons bksc_elem bksc_name_list))
;step up counter
(setq bksc_coun (1+ bksc_coun))
)
)
)
)
)
;pass message to "selection_msg" tile
(if bksc_blk_nlis
(if (> (length bksc_blk_nlis) 0)
(set_tile "selection_msg"
(strcat
(itoa (length bksc_blk_nlis))
" block"
(if (> (length bksc_blk_nlis) 1)
"s"
""
)
" selected..."
)
)
)
(set_tile "selection_msg" "")
)

;sort the layer name list alphabetically...
(if bksc_name_list
(setq bksc_name_list (acad_strlsort bksc_name_list))
)

)
;*** Function BLKSCALE
;This is the main program, load dialog version...
;
(defun C:BLKSCALE ( /
bksc_block_list ;Block List for List Box
bksc_block_code ;Block 70 code.
bksc_block_item ;Block item.
bksc_block_list ;List of all valid blocks for dialog list box.
bksc_block_name ;Extracted block name.
bksc_blk_nlis ;Block name list from dialog callback.
bksc_cbck ;callback for check
bksc_coun ;Counter.
bksc_doit ;Flag which executes scaling portion of routine.
bksc_elem ;Element.
bksc_elis ;Entity data list.
bksc_enam ;Entity name.
bksc_enty ;Entity.
bksc_indx ;Index.
bksc_name_list ;String list of all the selected blocks from the
;dialog list box.
bksc_poiI ;Insertion point of block.
;bksc_scale ;New block scale.
bksc_sst1 ;Selection set of selected blocks.
bksc_sst2 ;Selection set containing block objects only.
bksc_strg ;String value from selection method.
;bksc_type ;String which determines if scaling is Absolute
;or Relative (GLOBAL).
bksc_xscn ;Current extracted block scale.
sv_blipmode ;"BLIPMODE".
what_next ;Controller for dialog display...
)
(graphscr)

;Define error routine for this command
(defun blkscale_error (s)
(if (/= s "Function cancelled.");if ^c occurs...
(princ (strcat "\nError: " s))
)
(if olderr (setq *error* olderr))
(if sv_blipmode (setvar "BLIPMODE" sv_blipmode))
(princ)
)
(setq olderr *error*)
(setq *error* blkscale_error)

(setvar "CMDECHO" 0)
(command ".UNDO" "M")
;turn off blipmode
(setq sv_blipmode (getvar "BLIPMODE"))
(setvar "BLIPMODE" 0)

;create a list of all the blocks in the drawing
(setq bksc_block_item (tblnext "BLOCK" T))
(bksc_blklist)
(while (setq bksc_block_item (tblnext "BLOCK"))
(bksc_blklist)
)

;set the scale type global variable...
(if (not bksc_type)
(setq bksc_type "Absolute")
)
;initialize the dialog
(if (findfile "blkscale.dcl")

(if (not bksc_block_list); if there are no blocks in drawing...
(alert "There are no blocks inserted...")
;else load dialog...
(progn
(setq what_next 3)
(while (< 2 what_next)

(setq dcl_id (load_dialog "blkscale"))
;open the dialog box
(new_dialog "blkscale" dcl_id)

;set the tile defaults...
;set the message tile...
(if bksc_sst2
(set_tile "message"
(strcat
(itoa (sslength bksc_sst2))
" block(s) found..."
)
)
)

;set the "block_list" list box
(start_list "block_list")
(mapcar 'add_list bksc_block_list)
(end_list)

;set the radio button
(if (eq bksc_type "Absolute")
(set_tile "absolute" "1")
(set_tile "relative" "1")
)

;set the scale factor
(if (not bksc_scale)
(setq bksc_scale (getvar "DIMscale"))
)
(set_tile "scale" (rtos bksc_scale))

;if there was a selection of layers via Select Objects (atoi bksc_strg) 1)
"s"
""
)
" selected...")
)

)
)

;define action for tiles
(action_tile "block_list"
(strcat "(setq bksc_cbck $value)" ;for check routine...
"(bksc_get_blocks $value)"
)
)
;if the Select All... button is pressed, run this program...
(action_tile
"select_all"
(strcat
"(select_all bksc_block_list \"block_list\")"
"(bksc_get_blocks list_string)"
)
)
;if the Clear All... button is pressed...
(action_tile "clear_all"
(strcat "(set_tile \"block_list\" \"\")"
"(set_tile \"selection_msg\" \"\")"
)
)

;if the select objects button is pushed...
(action_tile "select_entities" "(done_dialog 3)")

;if the absolute radio is picked...
(action_tile "absolute" "(setq bksc_type \"Absolute\")")
;if the relative radio is picked...
(action_tile "relative" "(setq bksc_type \"Relative\")")
;if a value is placed in the scale box...
(action_tile "scale" "(setq bksc_scale (atof $value))")
;if the help button is picked...
;disabled (action_tile "help" "(saithelp \"blkscal\")")
;if the "do it" button is picked...
(action_tile "accept" "(bksc_check)")
;if the "exit" button is picked...
(action_tile "cancel" "(done_dialog)" )

(setq what_next (start_dialog))

(cond
;if Select < button was picked
((= what_next 3)
(setq bksc_sst1 (ssget))
(if bksc_sst1
(progn
;search the selection set for valid blocks
(setq bksc_coun 0);set counter
(setq bksc_sst2 (ssadd));create empty selection set
(repeat (sslength bksc_sst1);for each object
(setq bksc_enty (ssname bksc_sst1 bksc_coun))
;if it is a block...
(if (eq (cdr (assoc 0 (entget bksc_enty))) "INSERT")
;add the object to the selection set
(setq bksc_sst2 (ssadd bksc_enty bksc_sst2))
)
(setq bksc_coun (1+ bksc_coun))
)
(if bksc_sst2
(progn
;set the string for the message
(setq bksc_strg (itoa (sslength bksc_sst2)))
;clear the block name list
(setq bksc_name_list nil)
)
)
)
(alert "No blocks were selected...")
)
)
)

(unload_dialog dcl_id)
);end of while

);end of progn
);end of if
(princ "\nUnable to find BLKSCALE.dcl...")
)

;Process the Block Name list
(if bksc_doit
(if bksc_name_list
(progn
(foreach n bksc_name_list ;for each block name
(princ (strcat "\nScanning drawing for block " (strcase n) "... "))
(setq bksc_sst1 (ssget "X" (list (cons 2 n))));get a selection set
(if bksc_sst1 ;if successful
(progn
(princ (strcat (itoa (sslength bksc_sst1)) " found, updating..."))
(setq bksc_indx 0)
(repeat (sslength bksc_sst1);repeat for each entity
(setq bksc_enam (ssname bksc_sst1 bksc_indx));get ename
(setq bksc_elis (entget bksc_enam));get entity data list
;determine the scale factor for the block
(if (eq bksc_type "Absolute")
(setq bksc_xscn (/ bksc_scale (abs (cdr (assoc 41 bksc_elis)))))
(setq bksc_xscn bksc_scale)
)
(setq bksc_poiI (cdr (assoc 10 bksc_elis)))
(command ".SCALE" bksc_enam "" bksc_poiI bksc_xscn)
(setq bksc_indx (1+ bksc_indx))
)
)
(alert
(strcat "Block " (strcase n)
" has not been\n"
"inserted in the drawing!\n"
"Use the INSERT command to insert it first..."
)
)
)
);end of foreach
);end of progn
(if bksc_sst2
(progn
(setq bksc_indx 0)
(repeat (sslength bksc_sst2);repeat for each entity
(setq bksc_enam (ssname bksc_sst2 bksc_indx));get ename
(setq bksc_elis (entget bksc_enam));get entity data list
;determine the scale factor for the block
(if (eq bksc_type "Absolute")
(setq bksc_xscn (/ bksc_scale (abs (cdr (assoc 41 bksc_elis)))))
(setq bksc_xscn bksc_scale)
)
(setq bksc_poiI (cdr (assoc 10 bksc_elis)))
(command ".SCALE" bksc_enam "" bksc_poiI bksc_xscn)
(setq bksc_indx (1+ bksc_indx))
)
)
(alert "No blocks were selected...")
)
);end of if

);end of if

(setvar "BLIPMODE" sv_blipmode)
(setq *error* olderr)
(princ)
)

;*** End of Program
;*** Support functions
;*** Function (STRING_TO_LIST)
; This function converts a string "1" or "1 2 3" into a list
; (1) or (1 2 3). This is useful for dialog list callbacks
; which return strings.
;
(defun STRING_TO_LIST (strg / counter string_item string_list)
(setq counter 1)
(while (<= counter (strlen strg));as long as counter is less= to string
(setq string_element "")
(while (and ;as long as
(= (strlen string_element) 1)
(if string_list ;append to list,
(setq string_list (cons (atoi string_element) string_list))
(setq string_list (list (atoi string_element)));else create list
)
)
(setq counter (1+ counter))
);end of while

;reverse the list, this returns it with the function...
(if string_list
(reverse string_list)
)
)

Advertisements