;programm to exchange blocks inside drawings
;;;*-*REV 19.01.99 BaumS: blockexg: Corrected genhandupdate-call
;;;*-*REV 09.02.96 bau: improoved

;Dialog for input
;I took used dialog in gendcl.dd
; there is only one bug I use CANCEL instead of ABORT sorry!
(defun blockexg-input (head valold)
    (gendclload "gen" "gendcl")
    (gendclnew "gendcl" "input")
    (set_tile "kopf"  head)
    (set_tile "text" valold)
    (mode_tile "text" 2)
    (gendclaction "gendcl" "input" "text" "(setq value $value)")
    (gendclaction "gendcl" "input" "accept"
          "(gendcldone)")
    (gendclaction "gendcl" "input" "cancel"
          "(setq value nil)(gendcldone)")
    (gendcleck)
    (gendclstart)
    (if (not value) (getpoint ""))
value
)
;function called only in the beginning
(defun blockexg-start ()
 ;startfunction to set the variables
 (gen1sv)
 (setq bloold (gencfgget "gen@temp@bloold"))
 (setq blonew (gencfgget "gen@temp@blonew"))
 (prompt "\nFunction erases existing block and")
 (prompt "\ninserts new block with old attributs")
 ;read the values from the configuration
 (if (not bloold)(progn
   (gencfgnew "gen@temp@bloold"'(("TYPE""GenCfgString")("dwg" nil)("cfg" nil))
   (setq bloold "")
 )))
 (if (not blonew)(progn
   (gencfgnew "gen@temp@blonew" '(("TYPE""GenCfgString")("dwg" nil)("cfg" nil))
   (setq blonew "")
 )))
 ;in script the script does not stop with getstring, etc. so we must
 ;make DCL-File ?!
 (setq bloold (blockexg-input "Name des alten Blocks" bloold))
 (gencfgset "gen@temp@bloold" bloold)
 (setq exist nil)
 ;new block must exist
 (while (not exist)
   (setq blonew (blockexg-input "Name des neuen Blocks" blonew))
   (setq blonew (strcat(gendwgohne blonew) ".dwg"))
   (setq exist(findfile blonew))
   (if (not exist)(prompt (strcat "\nDatei " blonew " ist nicht vorhanden!")))
 )
 ;store blocknames in configuration
 (gencfgset "gen@temp@blonew" blonew)
 (gen1un)
)

;;;*-*REV 19.01.99 BaumS: Corrected genhandupdate-call
;function to exchange data
(defun blockexg ( / oldelis )
 (gen1sv)
 ;read from configuration
 ;why is it made so complicated ?
 ;because entmod does not update the position of attributes
 ;so we had to insert a new block and erase the old one
 (setq blooldcfg (gencfgget "gen@temp@bloold")
   bloold (gendwgohne(gendwgfilter blooldcfg))
   blonewcfg (gencfgget "gen@temp@blonew")
   ;blonew is the pure blockname (no path, no .dwg)
   blonew (gendwgohne(gendwgfilter blonewcfg))
 )
 (print (strcat bloold ">" blonew))
 ;makes sense only if the old block is there
 (if (tblsearch "BLOCK" bloold)(progn
  ;make selectionsset
  (setq ss (ssget "_X" (list '(0 . "INSERT")(cons 2 bloold))))
  ;read attributes
  (setq i 0)
  (while (and ss (setq oldename (ssname ss i)))(progn  
    ;change entity list
    (setq entlis (entget oldename '("*")))
    ;reenter the attributes
    (setq attlis (genal-al oldename))
    (command "_.ucs" "_w")
    (setvar "attdia" 0)(setvar "attreq" 0)
    ;insert the block with the old data from the block
    (command "_.insert" 
       blonewcfg
       (cdr(assoc 10 entlis))
       "_XYZ"
       (cdr(assoc 41 entlis))
       (cdr(assoc 42 entlis))
       (cdr(assoc 43 entlis))
       (genanggrad(cdr(assoc 50 entlis)))
    )
    ;attribute 
    ;this is the genius function to exchange attributes
    (genlade "gen" "genbas7" genalblock)
    (genalexchg(list(list"ENAME"(entlast))(list"ATTRI"attlis)))
    ;eed-data if there append again
    (if (assoc -3 entlis)(progn
      (setq lis (reverse(cons(assoc -3 entlis)(reverse(entget (entlast))))))
      (entmod lis)
    ))
    (setq entlis (entget oldename '("*")))
    (entdel oldename)
    ;this takes care for the objects
    (genhandupdate 
      (list 
        (list "OLD" oldename)
        (list "OLDELIS" entlis)
        (list "NEW" (entlast))
      )
    )
    (command "_.save" "")
    (setq i (1+ i))
  ))
 ))
 (gen1un)
)