;;===========================================================================
;;
;; 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)
//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
;;===========================================================================
;;
;; 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
;; Mods by CAB 02/5/06
;;===========================================================================
;;
;; Main function -- no arguments
;;
(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 0)
(SHOW_DIALOG)
); End while
(if (= FRAMUS_DONE 1) (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 2) (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)
Maybe I don't get it, but I faill to see what's interesting about this bloated code.
< snip >
Yes, quite an eye opener. :oops:
Especially when my code looked like that no too long ago.
What the ... I thought this was the swamp ... this kind of attitude belongs back at the Autodesk new server.
Fact is, the last version of the code in question here was written 6 years ago according to its header (I would safely guess it predates Autodesk Express Tool) -- we don't know if there is a more up to version, or if he only spent 5 minutes on it.
(defun c:Replaceblocks
(/ ent1 ent2 obj1 obj2 pt1 pt2 x ss index keyw rot r2d)
(command ".undo" "begin")
(while
(= ent1 nil)
(setq ent1 (car (entsel "\n Select block to copy: ")))
(if (= ent1 nil)
(alert "\n You missed, try again...")
)
)
(while
(= ent2 nil)
(setq ent2 (car (entsel "\n Select block you want to swap: ")))
(if (= ent2 nil)
(alert "\n You missed, try again...")
)
)
(setq obj1 (vlax-ename->vla-object ent1)
pt1 (trans (vlax-get obj1 'insertionpoint)0 1)
)
(setq obj2 (vlax-ename->vla-object ent2)
x (vlax-get-property obj2 'Name)
)
(start-timer)
(if
(and
(= (vla-get-ObjectName Obj1) "AcDbBlockReference")
(not (vlax-property-available-p Obj1 'Path))
)
(progn
(if (not *default*)
(setq *default* "Select")
)
(initget 0 "Select All")
(setq keyw
(cond
((getkword
(strcat "\nEnter selection option (Select / All): <<"
*default*
">>: "
)
)
)
(*default*)
)
)
(setq *default* keyw)
(cond
((= Keyw "Select") (setq SS (ssget (list (cons '2 x)))))
((= Keyw "All") (setq SS (ssget "X" (list (cons '2 x)))))
)
(setq
index -1
)
(while (< (setq index (1+ index)) (sslength ss))
(setq obj (ssname ss index)
obj2 (vlax-ename->vla-object obj)
pt2 (trans (vlax-get obj2 'insertionpoint)0 1)
rot (vlax-get obj2 'Rotation)
)
(vla-put-rotation obj1 rot)
(vl-cmdf "_copy" ent1 "" pt1 pt2 "")
)
)
)
(princ)
(command "_erase" ss "")
(command ".undo" "end")
(princ)
(princ (strcat (itoa index) " blocks swapped."))
)
a block that has a rotation of 45 is replaced with a block that has a rotation of 58?
The code does not predate Express Tools which were free with AutoCAD 2000. Here's a link to a Cadalyst article by Lynn Allen: http://tinyurl.com/p2zgj The code is dated a year after that article.
Regarding "this kind of attitude...", what are you saying? That I should only post comments which are polite and politically correct? Otherwise expect to be admonished?
Regards
I am reading and reading and reading again... what Joe posted... and I do not see any problem with his comment... I simple do not get it or do not understand...
I see he is just making a point as a professional... nothing else...
Or what is happening then?
Thanks;
Luis Esquivel
I am not the original author of that code... btw, I helped back then on 2001 [I think] to the author and told him, about why a code that was part of a contest, was really bad structured... If I recall correctly.
:-)
I am reading and reading and reading again... what Joe posted... and I do not see any problem with his comment... I simple do not get it or do not understand...
I see he is just making a point as a professional... nothing else...
Or what is happening then?
Thanks;
Luis Esquivel
You think this is acceptable?
Maybe I don't get it, but I fail to see what's interesting about Luis' bloated code.
<snip>
Luis' Magic ... ? That should tell you that Luis is probably a CAD manager more interested in protecting his job than writing good code. If Luis is around, I won't retract that statement.
A courteous "professional" would say something like --
Doesn't the express tools do the same thing?
Or ...
Here's an alternative way to achieve same that is a little more elegant / efficient.
Forgo the attitude, making assumptions / accusations / character assassinations that do nothing but incite arguments and / or animosity.
In short, I didn't find the dialogue in keeping with the "share ideas, resources and information in a friendly, helpful context (http://www.theswamp.org/forum/index.php?topic=2130.msg27256#msg27256)" swamp mantra, the one thing that has made this place different than other forums.
In my opinion of course.
I totally agree MP. I found the comments to be rude. I am definitely not the best lisp writer. I never hesitate to post anything I've done here on the Swamp because I know that the swamp is a place to contribute help in a tactful manner.
Ron
I know Joe and I know he is a professional... and cannot see any bad part on his comment... maybe is my English translation level... but I don't think so.
I have seen worst comments coming from someone that all here know very well....
I really hate to get entangled in things like this, especially when there are people I like and respect on both sides of the argument, < .. >
;;;;;;;;;
;;Falcon Design Services, inc. 1992
;;;;;;;;;
(defun c:REPL (/ ENT1 BL1 NWNM OLD ODNM)
(command "undo" "begin")
(prompt "Select blocks to replace: ")
(setq ENT1 (ssget))
(setq NEWBL (getstring "\nEnter new block name: "))
(command "insert" NEWBL nil)
(setq N (sslength ENT1))
(setq I 0)
(repeat N
(setq BL1 (entget (ssname ENT1 I)))
(setq NWNM (cons 2 NEWBL))
(setq OLD (assoc 2 BL1))
(setq ODNM (cdr OLD))
(entmod (subst NWNM OLD BL1))
(setq I (1+ I))
)
(command "undo" "end")
(prin1)
)
(defun c:REPLs (/ ENT1 BL1 bl2 OLD ODNM)
(command "undo" "begin")
(prompt "\nSelect Replacement Block: ")
(setq bl2 (cdr (assoc 2 (entget (car (entsel))))))
(prompt "Select blocks to replace: ")
(setq ENT1 (ssget))
(setq N (sslength ENT1))
(setq I 0)
(repeat N
(setq BL1 (entget (ssname ENT1 I)))
(setq NWNM (cons 2 bl2))
(setq OLD (assoc 2 BL1))
(setq ODNM (cdr OLD))
(entmod (subst NWNM OLD BL1))
(setq I (1+ I))
)
(command "undo" "end")
(princ)
)
(PRINC "\n -- Change Block Version 2.3 -- start command with --> CB ")
(princ "\n -- Copyright (C) 1997-2006 by K.E. Blackie ")
(princ "\n")
(DEFUN C:CB()
(setq ss (ssget))
(prompt"\nNew Block Name: ")
(setq new_value (getstring t))
(setq index 0)
(repeat (sslength ss)
(setq e (entget(ssname ss index)))
(setq as (assoc 2 e))
(setq e (subst (cons 2 new_value) as e))
(entmod e)
(setq index (+ 1 index))
)
(princ)
)
...but the mere fact that nobody saw fit to delete the post means that it certainly did not fall outside the bounds of the spirit of the swamp, since it would have surely been deleted had it done so...
< ... >
And here is a simple code bit that allows for replacement of any selected blocks with the block name of the users choice ... no fancy browse for files, no configurable options ... simply if you select the block you can change it with another block already defined in the drawing.Code: [Select](PRINC "\n -- Change Block Version 2.3 -- start command with --> CB ")
(princ "\n -- Copyright (C) 1997-2006 by K.E. Blackie ")
(princ "\n")
(DEFUN C:CB()
(setq ss (ssget))
(prompt"\nNew Block Name: ")
(setq new_value (getstring t))
(setq index 0)
(repeat (sslength ss)
(setq e (entget(ssname ss index)))
(setq as (assoc 2 e))
(setq e (subst (cons 2 new_value) as e))
(entmod e)
(setq index (+ 1 index))
)
)
;;; Change Block Version 2.3.1
;;; Copyright (C) 1997-2006 by K.E. Blackie
;;;
;;; You may copy, modify, use or distribute this code provided that
;;; the copyright notice remains in place and that no monetary
;;; consideration be given for the use or transfer of such code.
;;;
;;;
;;;-------------------------------------------------
;;; The function CB will replace a selected block reference(s)
;;; with another block reference that is already defined in
;;; the drawing. All attributes will be retained until/unless
;;; attsync is used.
;;;
(defun C:CB( / intCounter lstOldReference ssBlocks strNewBlockName )
;; prompt the user to select items, filtering for blocks only
(setq ssBlocks (ssget '((0 . "INSERT"))))
;; ask the user for a replacement block name
(setq strNewBlockName (getstring t "New Block Name: "))
;; initialize the counter
(setq intCounter 0)
;; step through the selection set of blocks
(repeat (sslength ssBlocks)
;; get the entity list for further manipulation
(setq lstOldReference (entget(ssname ssBlocks intCounter)))
;; substitute the new block name for the old block name and update the drawing
(entmod (subst (cons 2 strNewBlockName)(assoc 2 lstOldReference) lstOldReference))
;; increment the counter
(setq intCounter (1+ intCounter))
); _end of repeat
;; clean up nicely .. i.e. don't leave anything on the command line
(princ)
); _end of defun
;;; Notify the user of the current version and command call
(princ "\n -- Change Block Version 2.3.1 -- start command with --> CB ")
;;; Display copyright notice
(princ "\n -- Copyright (C) 1997-2006 by K.E. Blackie ")
;;; load with a nice clean command line ... it is better that way
(princ "\n")
I ask because I think that most people learn by example, or osmosis if you like...
How about a Prompt to guide the user into the Selection of the Blocks ?
And a reminder that Attsync is/may be needed ?
And Why do you comment every line ?
;;; Change Block Version 2.3.1
;;; Copyright (C) 1997-2006 by K.E. Blackie
;;;
;;; You may copy, modify, use or distribute this code provided that
;;; the copyright notice remains in place and that no monetary
;;; consideration be given for the use or transfer of such code.
;;;;
;;;;-------------------------------------------------
;;; The function CB will replace a selected block reference(s)
;;; with another block reference that is already defined in
;;; the drawing. All attributes will be retained until/unless
;;; attsync is used.
;;;
;;
;; Modified for style by kwb@theswamp 20060303
;;
(defun C:CB (/ intCounter lstOldReference ssBlocks strNewBlockName)
;;
;; prompt the user to select items, filtering for blocks only
;;
(prompt "\nSelect BLOCKS to be replaced.")
(setq ssBlocks (ssget '((0 . "INSERT")))
strNewBlockName (getstring t "\nReplacement Block Name: ")
intCounter 0
)
;; step through the selection set of blocks
;; get the entity list and substitute the new block name for the old block name
;; and update the entity with entmod
;;
(repeat (sslength ssBlocks)
(setq lstOldReference (entget (ssname ssBlocks intCounter)))
(entmod (subst (cons 2 strNewBlockName)
(assoc 2 lstOldReference)
lstOldReference
)
)
(setq intCounter (1+ intCounter))
)
;; Remind about Syncronisation .. don't leave anything on the command line
;;
(princ "\nAttsync may be required for Attributed Blocks")
(princ)
)
;;; Notify the user of the current version and command call
;;; Display copyright notice
(princ "\n -- Change Block Version 2.3.1 -- start command with --> CB ")
(princ "\n -- Copyright (C) 1997-2006 by K.E. Blackie ")
(princ "\n")