Code Red > AutoLISP (Vanilla / Visual)
Block replacement lisp
Cad64:
I found this great prog that will replace one instance of a block with another block. The only prob is the Cancel button doesn't work. Hit cancel or esc and the prog continues on as if you had hit Ok. At first it would just lock up when I hit cancel. I was able to fix that prob, but now cancel works the same as Ok. Can anyone help?
Also, I would like the default to be Individually rather than Globally.
TIA for any help you can give. I am running acad2006 by the way.
Here's the code for the lisp:
--- Code: ---;;===========================================================================
;;
;; Automated Design Services Limited
;; AutoLisp Programming
;; Ewald P. Ruceis
;; SUB_BLK.lsp
;; Version 1.80
;; 07/31/00
;;
;; Modified: 09/17/00 by Jeff Tippit, SPAUG President, www.spaug.org
;;===========================================================================
;;
;; Main function -- no arguments
;;
;SUB_BLK.LSP Substitute blocks (c)2001, Pete Ruceis
(defun SUB_BLK (/ #BLK1 ; Block to be replaced
#BLK2 ; Block to do the replacing
BLK_ENT1 ; First block entity
BLK_ENT2 ; Second block entity
cht_ot
cht_oh
CME ; The orginal "cmdecho" value
COUNT ; The number of block changed
DCL_ID ; The id for the dialog definition
DO_ALL ; Toggle for individual or global processing
DO_MORE ; The flag to control looping of the selection routine
FRAMUS_DONE ; Dialog return control variable
IDX ; Index to access selection set
INS_1 ; Old block insertion point
LYR_1 ; Old block layer
LYR_2 ; New block layer
LYR_FLG ; Flag to control layer changes
NAM_1 ; Old block name
NAM_2 ; New block name
NEW_ERR ; The internal "*error*" value
NSSET ; Clean selection set
ERASE_BLOCK ; Block to be erased
OLD_ERR ; The orginal "*error*" value
OLD_LAY ; The orginal "clayer" value
OLD_MOD ; The orginal "osmode" value
OLD_STL ; The orginal "textstyler" value
REP_INS ; Replacement block insertion point
REP_LAY ; Replacement block layer
REP_NAM ; Replacement block name
REP_ROT ; Replacement block rotation
REP_XSF ; Replacement block X-scale
REP_YSF ; Replacement block Y-scale
REP_ZSF ; Replacement block Z-scale
ROT_1 ; Old block rotation
ROT_2 ; New block rotation
ROT_FLG ; Flag to control rotation changes
SCL_FLG ; Flag to control scaling changes
SSBLKS ; Selection set of all blocks in drawing
SSL ; Length of selection set
TEMP ; Temporary list used to build clean selection set
XSF_1 ; Old block X-scale
XSF_2 ; New block X-scale
YSF_1 ; Old block Y-scale
YSF_2 ; New block Y-scale
ZSF_1 ; Old block Z-scale
ZSF_2 ; New block Z-scale
); End local variables for SUB_BLK
;;
;; Internal error handler defined locally
;;
(defun NEW_ERR (s) ; If an error (such as CTRL-C) occurs
; while this command is active...
(if (/= s "Function cancelled")
(if (= s "quit / exit abort")
(princ)
(princ (strcat "\nError: " s))
); End if
); End if
(eval(read U:E))
(if OLD_ERR ; If an old error routine exists
(setq *error* OLD_ERR) ; then, reset it
); End if
(if TEMP
(redraw TEMP 1)
); End if
(if CME
(setvar "cmdecho" CME)
); Reset command echoing
(if cht_ot
(setvar "texteval" cht_ot)
); End if
(if cht_oh
(setvar "highlight" cht_oh)
); End if
(princ)
); End defun NEW ERR
(if *error* ; Set our new error handler
(setq OLD_ERR *error* *error* NEW_ERR)
(setq *error* NEW_ERR)
); End if
;; Set undo groups and ends with (eval(read U:G)) or (eval(read U:E))
(setq U:G "(command \"undo\" \"group\")"
U:E "(command \"undo\" \"en\")"
); End setq
(setq cht_oh (getvar "highlight"))
(setq CME (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "ucs" "W")
(setq OLD_LAY (getvar "clayer"))
(setq OLD_STL (getvar "textstyle"))
(setq OLD_MOD (getvar "osmode"))
(eval(read U:G))
;;
;; *********************************************************************
;; START OF MAIN LOOP
;; *********************************************************************
;;
(setq DO_MORE "Y")
(while (= DO_MORE "Y")
(BIG_LOOP)
); End while
;;
;; *********************************************************************
;; END OF MAIN LOOP
;; *********************************************************************
;;
(if OLD_ERR ; Reset old error function
(setq *error* OLD_ERR)
); End if
(eval(read U:E))
(if cht_ot
(setvar "texteval" cht_ot)
); End if
(if cht_oh
(setvar "highlight" cht_oh)
); End if
(setvar "clayer" OLD_LAY)
(setvar "textstyle" OLD_STL)
(setvar "osmode" OLD_MOD)
(command "ucs" "P")
(if CME ; Reset command echoing
(setvar "cmdecho" CME)
); End if
(princ)
); End defun SUB_BLK.lsp
;;
;; *********************************************************************
;; START OF BIG LOOP
;; *********************************************************************
;;
(defun BIG_LOOP ()
(USER_INPUT)
(setq FRAMUS_DONE 0)
(while (/= FRAMUS_DONE 1)
(SHOW_DIALOG)
); End while
(I_OR_G)
(initget "Y N")
(setq DO_MORE (getkword "\nChange more blocks? Y/N <Y>: "))
(if
(or
(= DO_MORE "y")
(= DO_MORE "")
(= DO_MORE nil)
); End or
(setq DO_MORE "Y")
); End if
); End BIG LOOP
;;
;; *********************************************************************
;; END OF BIG LOOP
;; *********************************************************************
;; START OF USER INPUT
;; *********************************************************************
;;
(defun USER_INPUT ()
(setq DO_ALL nil)
(setq #BLK1 nil)
(setq #BLK2 nil)
(while (not #BLK1)
(progn
(setq #BLK1 (entsel "\nPick a block to Replace: "))
(if #BLK1
(progn
(setq ERASE_BLOCK #BLK1)
(setq BLK_ENT1 (entget (car #BLK1)))
(if (= (cdr (assoc 0 BLK_ENT1)) "INSERT")
(progn
(setq NAM_1 (cdr (assoc 2 BLK_ENT1))) ; Old block name
(setq LYR_1 (cdr (assoc 8 BLK_ENT1))) ; Old block layer
(setq INS_1 (cdr (assoc 10 BLK_ENT1))) ; Old block insertion point
(setq ROT_1 (cdr (assoc 50 BLK_ENT1))) ; Old block rotation
(setq XSF_1 (cdr (assoc 41 BLK_ENT1))) ; Old block X-scale
(setq YSF_1 (cdr (assoc 42 BLK_ENT1))) ; Old block Y-scale
(setq ZSF_1 (cdr (assoc 43 BLK_ENT1))) ; Old block Z-scale
(princ (strcat "\nBlock \"" NAM_1 "\" selected."))
) ; progn
; Else
(progn
(setq #BLK1 nil)
(prompt "\nSelected object is not a Block. Try again. ")
); End progn
); End if
); End progn
(princ "\nMissed the Block to Replace. Try again...")
); End if
); End progn
); End while
(while (not #BLK2)
(progn
(setq #BLK2 (entsel "\nPick a block to Replace with: "))
(if #BLK2
(progn
(setq BLK_ENT2 (entget (car #BLK2)))
(if (= (cdr (assoc 0 BLK_ENT2)) "INSERT")
(progn
(setq NAM_2 (cdr (assoc 2 BLK_ENT2))) ; new block name
(setq LYR_2 (cdr (assoc 8 BLK_ENT2))) ; new block layer
(setq ROT_2 (cdr (assoc 50 BLK_ENT2))) ; new block rotation
(setq XSF_2 (cdr (assoc 41 BLK_ENT2))) ; new block X-scale
(setq YSF_2 (cdr (assoc 42 BLK_ENT2))) ; new block Y-scale
(setq ZSF_2 (cdr (assoc 43 BLK_ENT2))) ; new block Z-scale
(princ (strcat "\nBlock \"" NAM_2 "\" selected."))
); End progn
; Else
(progn
(setq #BLK2 nil)
(prompt "\nSelected object is not a Block. Try again. ")
); End progn
); End if
); End progn
(princ "\nMissed the Block to Replace with. Try again...")
); End if
); End progn
); End while
); End USER INPUT
;;
;; *********************************************************************
;; END OF USER INPUT
;; *********************************************************************
;; START OF DIALOG BOX
;; *********************************************************************
;;
(defun SHOW_DIALOG ()
(setq DCL_ID (load_dialog "sub_blk.dcl"))
(if (not (new_dialog "sub_blk" DCL_ID))
(exit)
); End if
(set_tile "txt_old_nam" NAM_1)
(set_tile "txt_old_lyr" LYR_1)
(set_tile "txt_old_rot" (rtos (/ (* ROT_1 180.0) PI) 2 8))
(set_tile "txt_old_xscl" (rtos XSF_1 2 8))
(set_tile "txt_old_yscl" (rtos YSF_1 2 8))
(set_tile "txt_old_zscl" (rtos ZSF_1 2 8))
(set_tile "txt_new_nam" NAM_2)
(set_tile "txt_new_lyr" LYR_2)
(set_tile "txt_new_rot" (rtos (/ (* ROT_2 180.0) PI) 2 8))
(set_tile "txt_new_xscl" (rtos XSF_2 2 8))
(set_tile "txt_new_yscl" (rtos YSF_2 2 8))
(set_tile "txt_new_zscl" (rtos ZSF_2 2 8))
;;
;;================== DIALOG ACTIONS =======================
;;
(action_tile "btn_cng_ind" "(setq DO_ALL 1)")
(action_tile "btn_cng_glb" "(setq DO_ALL nil)")
(action_tile "tgl_lyr" "(setq LYR_FLG $value)")
(action_tile "tgl_rot" "(setq ROT_FLG $value)")
(action_tile "tgl_scl" "(setq SCL_FLG $value)")
(action_tile "accept" "(CHECKOUT) (setq FRAMUS_DONE 1) (done_dialog)")
(action_tile "cancel" "(setq FRAMUS_DONE 1) (done_dialog)")
(start_dialog)
); End SHOW DIALOG
;;
;; *********************************************************************
;; END OF DIALOG BOX
;; *********************************************************************
;; START OF CHECKOUT
;; *********************************************************************
;;
(defun CHECKOUT ()
(unload_dialog DCL_ID)
); End CHECKOUT
;;
;; *********************************************************************
;; END OF CHECKOUT
;; *********************************************************************
;; START OF I OR G OF ROUTINE
;; *********************************************************************
;;
(defun I_OR_G ()
(setq COUNT 0)
(setq REP_NAM NAM_2) ; Set default to block 2 name
(setq REP_INS INS_1) ; Set default to block 1 insertion point
(setq REP_LAY LYR_2) ; Set default to block 2 layer
(setq REP_ROT ROT_2) ; Set default to block 2 rotation
(setq REP_XSF XSF_2) ; Set default to block 2 X-scale
(setq REP_YSF YSF_2) ; Set default to block 2 Y-scale
(setq REP_ZSF ZSF_2) ; Set default to block 2 Z-scale
(if (= DO_ALL nil)
(MAK_GLOBAL)
; Else
(progn
(CHK_FLG)
(MAK_CNG)
); End progn
); End if
(princ (strcat "\n"
(rtos COUNT 2 0)
" Instance(s) of \""
NAM_1
"\" was/were replaced with \""
NAM_2
"\""
); End strcat
); End princ
); End I OR G
;;
;; *********************************************************************
;; END OF I OR G OF ROUTINE
;; *********************************************************************
;; START OF MAKE GLOBAL ROUTINE
;; *********************************************************************
;;
(defun MAK_GLOBAL ()
(setq SSBLKS (ssget "X" '((0 . "INSERT"))))
(setq SSL (sslength SSBLKS)
NSSET (ssadd)
); End setq
(if (> SSL 10)
(princ "\nVerifying the selected entities -- please wait. ")
); End
(while (> SSL 0)
(setq TEMP (ssname SSBLKS (setq SSL (1- SSL))))
(if (= (cdr (assoc 2 (entget TEMP))) NAM_1)
(ssadd TEMP NSSET)
); End if
); End while
(setq SSL (sslength NSSET))
(setq SSBLKS NSSET)
(setq IDX 0)
(repeat (sslength SSBLKS)
(setq BLK_ENT1 (entget (ssname SSBLKS IDX)) IDX (1+ IDX))
(setq REP_INS (cdr (assoc 10 BLK_ENT1))) ; Old block insertion point
(setq ERASE_BLOCK (cdr (assoc -1 BLK_ENT1)))
(CHK_FLG)
(MAK_CNG)
); End repeat
); End MAK GLOBAL
;;
;; *********************************************************************
;; END OF MAKE GLOBAL ROUTINE
;; *********************************************************************
;; START OF CHECK FLAG ROUTINE
;; *********************************************************************
;;
(defun CHK_FLG ()
(if (= LYR_FLG "0")
(setq REP_LAY (cdr (assoc 8 BLK_ENT1))) ; Set to block 1 layer
); End if
(if (= ROT_FLG "0")
(setq REP_ROT (/ (* (cdr (assoc 50 BLK_ENT1)) 180.0) PI)) ; Set to block 1 rotation
); End if
(if (= SCL_FLG "0")
(progn
(setq REP_XSF (cdr (assoc 41 BLK_ENT1))) ; Set to block 1 X-scale
(setq REP_YSF (cdr (assoc 42 BLK_ENT1))) ; Set to block 1 Y-scale
(setq REP_ZSF (cdr (assoc 43 BLK_ENT1))) ; Set to block 1 Z-scale
); End progn
); End if
); End CHK_FLG
;;
;; *********************************************************************
;; END OF CHECK FLAG ROUTINE
;; *********************************************************************
;; START OF MAKE CHANGE ROUTINE
;; *********************************************************************
;;
(defun MAK_CNG ()
(command "._ERASE" ERASE_BLOCK "")
(setvar "clayer" REP_LAY)
(command "._INSERT" REP_NAM REP_INS "xyz" REP_XSF REP_YSF REP_ZSF REP_ROT)
(setq COUNT (+ COUNT 1))
); End MAK_CNG
;;
;; *********************************************************************
;; END OF MAKE CHANGE ROUTINE
;; *********************************************************************
;;
;; The C: function definition.
;;
(defun c:SUB () (SUB_BLK))
(princ "\nc:Sub_Blk loaded. Start command with SUB.")
(princ)
--- End code ---
Code tags Added
Cad64:
Here's the dcl:
--- Code: ---//SUB_BLK.DCL Substitute blocks (c)2001, Pete Ruceis
sub_blk : dialog {
label = "Pete's Magic Block Replacer";
: boxed_radio_row {
label = "Make Changes";
spacer_1;
: radio_button {
label = "Individually:";
key = "btn_cng_ind";
}// End radio button
: radio_button {
label = "Globally:";
key = "btn_cng_gbl";
value = "1";
}// End radio button
}// End boxed radio row
: row {
: boxed_row {
label = "Old Block";
: column {
: text {
label = "Name: ";
}// End text
: text {
label = "Layer: ";
}// End text
: text {
label = "Rotation:";
}// End text
: text {
label = "X Scale: ";
}// End text
: text {
label = "Y Scale: ";
}// End text
: text {
label = "Z Scale: ";
}// End text
}// End column
: column {
: text {
key = "txt_old_nam";
label = " ";
}// End text
: text {
key = "txt_old_lyr";
label = " ";
}// End text
: text {
key = "txt_old_rot";
label = " ";
}// End text
: text {
key = "txt_old_xscl";
label = " ";
}// End text
: text {
key = "txt_old_yscl";
label = " ";
}// End text
: text {
key = "txt_old_zscl";
label = " ";
}// End text
}// End column
}// End boxed row
: boxed_row {
label = "New Block";
: column {
width = "9";
: text {
label = "Name: ";
}// End text
: text {
label = "Layer: ";
}// End text
: text {
label = "Rotation:";
}// End text
: text {
label = "X Scale: ";
}// End text
: text {
label = "Y Scale: ";
}// End text
: text {
label = "Z Scale: ";
}// End text
}// End column
: column {
width = "30";
: text {
key = "txt_new_nam";
label = " ";
}// End text
: text {
key = "txt_new_lyr";
label = " ";
}// End text
: text {
key = "txt_new_rot";
label = " ";
}// End text
: text {
key = "txt_new_xscl";
label = " ";
}// End text
: text {
key = "txt_new_yscl";
label = " ";
}// End text
: text {
key = "txt_new_zscl";
label = " ";
}// End text
}// End column
}// End boxed column
}// End row
: boxed_column {
label = "Change Attributes:";
: toggle {
label = "New Block's Layer:";
key = "tgl_lyr";
value = "1";
}// End toggle
: toggle {
label = "New Block's Rotation:";
key = "tgl_rot";
value = "1";
}// End toggle
: toggle {
label = "New Block's Scale:";
key = "tgl_scl";
value = "1";
}// End toggle
}// End boxed column
spacer_1;
ok_cancel;
}// End dialog
--- End code ---
Code Tags Added
Kerry:
First thing .. Check your parenthesis balancing .. the SHOW_DIALOG visually scans wonky ...
Second .. Why are both cancel and accept setting FRAMUS_DONE to 1 ?
Third ..
investigate this for both cancel and accept ...
(setq DCLreturn (start_dialog))
instead of (start_dialog)
check the value of DCLreturn < leave it global to check >
Just for interests sake, who wrote that ...
Cad64:
Thanks for the reply Kerry.
The author was Pete Ruceis.
Kerry:
Looks like CAB may have fixed the Parenthesis balancing for you.
Would be nice if you restored the original (c) notice , even if you do make mods to the routine.
I'm a little short of time at the moment, so someone else may have this solved before I return.
Navigation
[0] Message Index
[#] Next page
Go to full version