Topic: 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: [Select]

;;===========================================================================
;;
;; 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)
Code tags Added

[Cad64]

Here's the dcl:

Code: [Select]

//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
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.


 

[Cad64]

I still have the (c) notice in the file. I just stripped off all of the non-code lines because I was having trouble posting. I wanted to get the message small enough. I guess I should have put everything back once I split the post in half. Next time I will make sure to include everything. I will always give credit where credit is due.

[CAB]

This is where I found it.
  http://tinyurl.com/nfzpf

[Cad64]

Thanks Cab.

Still can't get cancel to work correctly though.

[CAB]

I took a quick look and made a few changes but did not test.
Sorry no time tonght.

Code: [Select]

;;===========================================================================
;;
;; 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)

[Cad64]

Many thanks for your time Cab, Cancel works correctly now.

[Kerry]

Cool CAB.

It was also published in CADALYST Jun 2001 .. by the looks of it. ... interesting.

[Joe Burke]

Maybe I don't get it, but I faill to ses what's interesting about this bloated code.

Express Tools has a perfectly good program for globally replacing one block with another, blockreplace.

If you want to substitute this block reference with that block reference on an individual basis, all you have to do is change the target block ref name to the source ref name. Yes, you can get fancy with questions about whether target block should inheret source block scale and/or rotation. Which takes a few more lines of code.

I don't know how others feel. My sense is code from sources other than folks I know here, or from the Autodesk forum. is generally trash. It may do what it claims to do, but that doesn't mean it's worth haviing or using.

Pete's Magic...? That should tell you the author is probably a CAD manager more interested in protecting his job than writing good code. If Pete is around, I won't retract that statement.

[CAB]

Foot in mouth comment retracted.

[Kerry]

Maybe I don't get it, but I faill to see what's interesting about this bloated code.

 < snip >

Joe, There's nothing to get ; I was being sarcastic ...  expressing by understatement my incredulity that CADALYST would publish it.

As you say, it' a lot of code to wrap

(vla-put-name (vlax-ename->vla-object entName) newBlockName)


added : perhaps that should have read .. ' interesting, but not for the reasons you'd imagine '

[MP]

What the ... I thought this was the swamp ... this kind of attitude belongs back at the Autodesk new server.

I think it's easy to look down one's nose and get snotty about other people's code because it don't measure up to one's sense of cleverness, brevity etc.

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.

If one thinks they can pen a more efficient version they should just step up and demonstrate better technique rather than besmirch the author, who incidentally, didn't even post said code.

Incidentally, Autodesk has a habit of lifting code and ideas from others without giving credit. Moreover, more often than not, when you look at their code it often appears as if it were written by some amateur they found in a bar.

[M-dub]

Some good points, there MP.
Points I hadn't really thought of until I read your post.

[CAB]

Yes, quite an eye opener. 
Especially when my code looked like that no too long ago.

[Chuck Gabriel]

Yes, quite an eye opener. 
Especially when my code looked like that no too long ago.

I know I've done worse.

[Joe Burke]

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.

Michael,

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

[ronjonp]

On a tangent...kinda:

Why does this code not match the rotation of the block being replaced? For example...a block that has a rotation of 45 is replaced with a block that has a rotation of 58?

;;  Function to copy blocks from one point to another

Code: [Select]

(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."))
)
Thanks,

Ron

[Serge J. Gianolla]

a block that has a rotation of 45 is replaced with a block that has a rotation of 58?

Have not tested your code, but still taking a punt.
Angles given in deg. instead of radians or vice versa are often the culprits.

[ronjonp]

I was making it harder than it needed to be. There was no need to try and convert the rotation.  :ugly:

I updated the code above.

[MP]

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.

You could very well be correct (I can't view tiny urls from here -- the IT dep't thinks unspeakable evil will occur apparently). Fact is I historically don't use or recommend Bonus / Express tools to other programmers so admit I'm not up to speed on what they contain. Nonetheless, like the other author, I would tend to write my own version and yes, because I'm protecting my job. Not in the way that you suggest, but from a reliability perspective. I need to be able to ensure a solution is available to any CADD station. Fact is over the last decade Autodesk has been completely inconsistant with the Bonus / Express tools grab bag to the point you can not (legally) count on it being on a candidate CADD station.

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

In short yes, err on the side of kindness. If you want to minimize or belittle the efforts of others ala Godzillo please post to that other news server, otherwise post here as if you are speaking to friends face to face -- even if they are not here. While it is a high bar, one that I have publically struggled with myself, it is a goal worth aspiring to lest this great place degrade to the kind of chilly rooms found elsewhere.

[MP]

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" swamp mantra, the one thing that has made this place different than other forums.

In my opinion of course.

[MP]

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.

 

That wasn't my point. My point was how would you feel if that language was directed at you?

I do however, have no doubt that you probably helped out the original author in a friendly, disarming manner.

[ronjonp]

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" 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

[MP]

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

Thank you Ron. I was feeling I was on my own on this (but not about to back down either). I really appreciate you stepping up to voice your opinion and acknowledge mine. A lot.

<thumbs up icon goes here>

[CAB]

MP
I totally agree with your position.
Silence due to embarrassment over my unthinking first response.

The swamp is a great place for all CAD people of any level or interest.
Let's keep it that way.

[MP]

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....

Sorry Luis but it's not about whether you know someone as a pro or not but whether the dialog was rude. As for comparisons, of what value is that? So and so is not as bad as so and so -- so it's ok? Horse pucky. As the target of much undeserved rudeness yourself I find your take quite baffling, though I respect you for defending Joe.

I'm done.

[Chuck Gabriel]

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, but I have to say I agree with MP.  I prefer to be treated with respect, and so I try to treat others with respect.

[Kerry]

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, < .. >

Yep, It's a tough decision !

I try to apply Asimovs 3 Laws of Robotics , but sometimes a blood rush comes over me ...

Isaac Asimov's "Three Laws of Robotics"
A robot may not injure a human being or, through inaction, allow a human being to come to harm.
A robot must obey orders given it by human beings except where such orders would conflict with the First Law.
A robot must protect its own existence as long as such protection does not conflict with the First or Second Law.

[JohnK]

Sup everyone.

Check this out: http://www.dianaskitchen.com/page/beans/madame.htm

EDIT: Fat fingers hit the (tab-enter)

[JohnK]

...*Ptthht!* I give [you] the answer to all of the probems mentioned in this thread and [you] just ignore me. Fine maybe some original quotes will help.

o  The only way to win an argument is to avoid one. -- Se7en

o  All arguments between two people have a minimum of at least two loosers -- Se7en

o  To have an argument with oneself is much more rewarding; at least then you
   stand a chance coaxing the other party to your way of thinking. -- Se7en

o  Two arguee's walk into a club. ...Good maybe now we can get some peace. --Se8en

o  How many arguee's does it take to change a light bulb? ...ONE! You got a fricken
   problem with that?!?! -- Se8en

[CADaver]

VERY old functions REPL askes for block name, REPLS ask to select a block to match:

Code: [Select]

;;;;;;;;;
;;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)
)


[Keith™]

Ok .. lets look at this from a fresh perspective. I have not followed this thread too close, but it appears as though there is a "bash joe" party going on. This certainly does not follow in the spirit of the swamp that some have touted as being the appropriate behavior.
Upon examination of Joe's comments, (there were several), the basic facts which are ...

• Joe fails to see what is interesting in this particular piece of code
• The code is bloated
• Expresstools has a very similar function
• Code from places OTHER THAN TheSwamp and/or the Autodesk forum is GENERALLY trash
• Just because a function does what it says it should do does not mean it SHOULD be used or that it is worth using
• "Pete's Magic Block Replacer" seems a bit like the author may have been a cad manager or someone more interested in protecting one's job than writing good code
• Joe stands by his comments regardless of whether "Pete" sees it or not.

Now to offer a bit of commentary on these basic "facts" as they have been presented ...
#1 - This is a simple commentary on his personal thoughts about this code ... I have seen similar comments from just about every seasoned programmer that frequents this forum. To speak out in this particular instance is hypocritical for anyone who has ever made such similar statements. I will refrain from name calling as it solves nothing ... you know who you are.

#2 - This statement is 100% accurate and to suggest otherwise helps no one ... however to suggest that a piece of code is bloated will allow those who are learning to code, that there are much more efficient methods that may be used to accomplish a task. This could be correctly used as a fine example of how code may become bloated , particularly when the programmer is inexperienced.

#3 - This is absolutely true ... and yes I do realize that many people may not have Expresstools or may elect to not use them for whatever reason. I personally only use 4 or 5 of them although I have the full suite. For the remaining items I have built my own custom tools, much like many of the fine folks who frequent TheSwamp, however, I suspect that most folks who purchase AutoCAD do have the Expresstools, as they have been included in every release of AutoCAD since R2000 (as far as I can tell) up to and including R2004 ... R14 is the only version that used Bonus tools ... and they were abismal ... but that is merely my own opinion .. others may vary.

#4 - This one is a bit shaky as I have seen some fine examples of code on websites other than TheSwamp and/or Autodesk forums ... but the author did temper the statement with the disclaimer "GENERALLY" ... thus he may not consider all code from other sources as trash, but then again this is his particular commentary ... yours may differ,  nothing wrong with that .. it is just different that's all ...

#5 - Ok .. here is where it gets nasty ... I want everyone here who uses an alternate O/S or web browser, (i.e. no Windows or Internet Explorer), that takes offense to this comment to sincerely do some soul searching ... imagine this comment ... "Just because Windows/IE does what is says it is supposed to do, does not mean it should be used or that it is worth using" ... Now step back and re-examine your position. I suspect that a whole lot of Swampers use alternative browsers .. i.e. Firefox,  Mozilla, Opera ... heck, I even wrote my own browser ... and if Mark goes back in his logs he may even find it there .. I called it "Swamp Browser" ... still use it on occasion too ... more of an exercise than a desire to create a better browser. It was fast and sleek ... and unencumbered by a majority of the security flaws of other browsers ... but just because I have it does not mean that it is desirable to use it .. or that it should be used. Enough about this ... I think I have gotten my point across.

#6 - Ok ... first off,  there is nothing magic about it ... although it may seem like it to a layman .. thus I got the same exact feeling as did Joe. The author is someone who feels self-important (as most cad managers would likely feel) you know the kind that are self absorbed ... I know you do as I have seen the comments from you folks ... the ITwit and the stupid CAD manager threads pop up almost weekly, and have for a long time. The mere fact that the writer of the code alludes to the fact that it is somehow magic or states unequivocally that it is "Pete's" says a whole lot about how he wishes to portray himself. To me that screams "YOU CAN'T DO WITHOUT ME .... BUWAHAHAHAHA" thus the end user being unfamiliar with coding would indeed feel that the person is valuable and deserves to have their job protected, regardless of whther the code is bloated or follows any kind of good programming practices. There is nothing inherently wrong with this statement ... it is what it is ... and many of us HAVE portrayed ourselves as "invaluable" to our respective employers ... all for the sake of self importance. If the shoe fits, wear it... but please don't pretend that "Pete", whomever he may be, is not (or at very least was not at the time of the code writing) a person with a percocious attitude. To do so would be completely inaccurate in my humble opinion.

#7 - Finally, while some of you have chosen to take offense to this comment, I personally find it refreshing ... I do not need to guess where he stands ... this piece of code could have just as well been something I produced many years ago before I would have known better (not this particular piece, but you get the picture) and I would prefer that someone be completely open and honest when dealing with me ... Do YOU like to be treated differently by people when they know you are around? i.e. would you prefer that your co-worker be open about the fact that they think you are an idiot or would you prefer that they be nice to you while you are standing there, then talk crap about you when you leave ... this kind of puts a different perspective on it now doesn't it. I don't know anyone who would prefer to be lied to or at very least be patronized by people who have a dislike for them or their work habits. Being honest and open about ones feelings is perhaps the one last thing that we can do ... now of course I am not advocating wholesale bashing, but if it looks like a duck, walks like a duck and quacks like a duck, it just might be a duck ... and I will be hard pressed to call it a turkey.

Ok .. if you have gotten this far in my unbelievably bloated commentary (dangit I can be long winded) you should note that while I would not have made those comments myself, I will stand behind the honesty in which Joe made them. If they had been inflamitory or derogatory I would have been the first to delete it ... 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. Personally I find the ensuing commentary much ado about nothing and it serves no purpose except to prompt people to take sides ... and as it stands here now, I am ashamed that I feel compelled to engage in perpetuating this discussion.

Where oh where has the time gone when people could engage in honest and open debate without getting their feelings hurt.

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))
 )
 (princ)
)


[MP]

You can't tell me with a straight face you that if Mark Thomas posted a routine all you mods would let this post to stand without rebuke --

Maybe I don't get it, but I fail to see what's interesting about Mark's bloated code.

Mark's Magic ... ? That should tell you that Mark is probably a CAD manager more interested in protecting his job than writing good code. If Mark is around, I won't retract that statement.

And I'm saying that everyone deserves that courtesy.

To add to what I've already said on this topic -- people should feel comfortable posting to the swamp without fear of ridicule, insult and character assassinations based on wild assed assertions and assumptions.

As for the hypocritical suggestion Mr. Blackie, I stepped down as the swamp's admin because of this very issue -- and you know that. It doesn't mean I'm perfect, far from it -- if I were I wouldn't have felt compelled to step down nor would I had said previously in this thread "While it is a high bar, one that I have publically struggled with myself, it is a goal worth aspiring to ...".

This is not a bash Joe party. That's the last thing I want, and no one who chimed in to offer their opinion provided more than statements about their own philosophy or a preference for a positive, edifying type environment. There's no mob mentality going on here Keith so just put that notion away. I have valued Joe's expertise, perspective and contributions over the years. That hasn't changed nor will it, but I could not ignore my conscience and let that post stand without an accounting.

Finally this not about a failure to acknowledge inferior code. Horse pucky. You can fully address all the shortcomings of programming technique without being insulting, belittling and abrasive.

It just takes a little more effort.

[Mark]

For the record, I wanted to stay out of this.

I found Joe's comments a bit harsh myself and not what I would like to see here on theswamp. The last thing I want is for someone new to programming or theswamp to be ashamed of posting their code.

I didn't see the previous comments as "Joe bashing".

How the heck can you guys tell what type of person Pete is, not to mention his his job title, from two words, "Pete's Magic" ? *grin*

...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...

The thought did cross my mind. I was late to the party myself so I left said post in tact. If this conversation goes much further in the direction it seems to be going you can expect the whole thread to disappear.

[Kerry]

< ... >
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))
)

)


Keith, Is this what you consider to be an example of good, acceptable code style. ?

I ask because I think that most people learn by example, or osmosis if you like, and I wanted to know if your post was meant as a real example.

[Keith™]

The example was meant as just that an example ... it certainly may be improved upon, however drastic or slight is entirely up to the person looking at the code. For the intent, it works as described, however, just because it works does not mean that is should be used or that it is desirable to do so. All code is provided with that understanding.

To critique my own code, I might point out a few flaws that are neither desirable or good coding practice ...
1. None of the vars are localized, thus it may crash with other software.
2. The code is not commented, thus the novice may not readily understand the code
3. The use of unrequired variables is not desirable in working code ... but may be helpful while learning

I am sure there are others, and if you like you may point them out ... I have big shoulders and I can take it ... but if you would like to see an example of what I would consider as acceptable coding and correction of the above items I describe, given the above example of simplification of block replacement, see below:

;;; 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")

Now while this code is nicely formatted, commented localized and has variables that the user can readily identify (and what they should contain), the basics of the code is the same.

Personally I feel .. teach how to code first, then work on semantics

[Kerry]

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 ?

[Mark]

I ask because I think that most people learn by example, or osmosis if you like...

Interesting theory Kerry, if I understand you correctly.

So you're saying if people read enough books or other material on programming lisp then eventually they will know how to write lisp without actually opening a text editor?

[Kerry]

While that is true to an extent, punching out code IS the best teacher.

Some of it may be horrible at first, but as knowledge improves, so does the code.

The problem with learning by osmosis is that if the examples are not good the derived code will be less than good, and the coder may not know the difference. We have to learn to question every line we write < or read >.

The real intent of my comment was to express my belief that we should be a little carefull with the code we post as examples and never shy from judgement our our own, or sample code.

[Keith™]

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 ?

All valid questions .. it is presumed that the user will know what the program is supposed to do. After all, they must load the program and enter the command name at the command line. If the user does not know that they must select blocks with a block replacement utility, then they should not be using the code.

Remember the use of code should be to improve performace and make a users life a bit easier. It should not be used to make bad users good. No amount of coding can make up for incompetence.

Commenting every line does make for alot of writing and can overwhelm the code, as is exhibited above, however, it is necessary in many instances for the complete understanding of the code, particularly for a novice. If we are not talking about a novice coder, then the user wouldn't be looking too closely at the code to learn from .. thus the learning by viewing debate would not apply and we would be discussing a completely different scenario ... i.e. what would be appropriate learning material for a novice/intermediate/expert coder.

Now the issue with attsync ... as I have said ... just because the program does what it is supposed to do does not mean it is desirable to use it. The fact of the matter is, if the user replaces a block with any block replacement program, they will all require attsync if attributes are part of the block, either that or the code must update the attributes. Either way, the user will be required to act upon the block after updating.

[Kerry]

Thanks for clarifying that Keith.

In line with your comments and intent,
and as an alternate example of style < retaining the same essential functioning code >,
Here's another alternative which may read a little better for readers of all skill levels.

Code: [Select]

;;; 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")



[Keith™]

Indeed ...

[deegeecees]

Just tried "sub_blk.lsp", works great except for attributed blocks. Add an "ATTREQ = 0" line and its all good.