Topic: Swap block that resides in nest

[ArgV]

Hi,

May be this one ?

Code: [Select]

;; MBLOCKREPLACE (gile)
;; Replace one or more blocks by another one

(defun c:MBlockReplace (/ *error* acdoc blst target source)
  (defun *error* (msg)
    (vla-EndUndoMark acdoc)
    (princ)
  )
  (vl-load-com)
  (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (vlax-for b (vla-get-Blocks acdoc)
    (if (and
          (= (vla-get-IsLayout b) :vlax-false)
          (= (vla-get-IsXref b) :vlax-false)
          (not (wcmatch (setq name (vla-get-Name b)) "`**,*|*"))
        )
      (setq blst (cons (vla-get-Name b) blst))
    )
  )
  (setq target (ListBox "MBlockReplace"
                        "Select the block(s) to be replaced"
                        (mapcar 'cons blst blst)
                        2
               )
  )
  (setq source (ListBox "MBlockReplace"
                        "Select a block to replace block(s)"
                        (mapcar 'cons blst blst)
                        1
               )
  )
  (vla-StartUndoMark acdoc)
  (vlax-for blk
            (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
    (vlax-for obj blk
      (if (and
            (= (vla-get-ObjectName obj) "AcDbBlockReference")
            (vl-position (vla-get-Name obj) target)
          )
        (vla-put-Name obj source)
      )
    )
  )
  (vla-regen (vla-get-ActiveDocument (vlax-get-acad-object)) acAllViewports)
  (vla-EndUndoMark acdoc)
  (princ)
)

;; ListBox (gile)
;; DialogBox which allows one more choices in a list
;;
;; Arguments
;; title : The dialog title (STR)
;; msg ; message (STR), "" or nil for none
;; keylab : an association list which type is ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = popup list
;;        1 = single choice list
;;        2 = multipe choices list
;;
;; Return : the option key (flag = 0 or 1) or the option keys list (flag = 2)
;;
;; Example
;; (listbox "Layout" "Choos a layout" (mapcar 'cons (layoutlist) (layoutlist)) 1)

(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
  (setq tmp  (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
  )
  (write-line
    (strcat "ListBox:dialog{label=\"" title "\";")
    file
  )
  (if (and msg (/= msg ""))
    (write-line (strcat ":text{label=\"" msg "\";}") file)
  )
  (write-line
    (cond
      ((= 0 flag) "spacer;:popup_list{key=\"lst\";")
      ((= 1 flag) "spacer;:list_box{key=\"lst\";")
      (T "spacer;:list_box{key=\"lst\";multiple_select=true;")
    )
    file
  )
  (write-line "}spacer;ok_cancel;}" file)
  (close file)
  (setq dcl_id (load_dialog tmp))
  (if (not (new_dialog "ListBox" dcl_id))
    (exit)
  )
  (start_list "lst")
  (mapcar 'add_list (mapcar 'cdr keylab))
  (end_list)
  (action_tile
    "accept"
    "(or (= (get_tile \"lst\") \"\")
    (if (= 2 flag) (progn
    (foreach n (str2lst (get_tile \"lst\") \" \")
    (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)))
    (setq choice (reverse choice)))
    (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))))
    (done_dialog)"
  )
  (start_dialog)
  (unload_dialog dcl_id)
  (vl-file-delete tmp)
  choice
)

Hey Gile, thanks for the help. I tried to run this, it dies as soon as I hit "ok" on the dialog box, and I don't feel like fixing any more stuff today.. did enough of that at work.

thanks,

-ArgV

[CAB]

If you could post some test DWGs I'm sure a solution would be found.

[gile]

Hey Gile, thanks for the help. I tried to run this, it dies as soon as I hit "ok" on the dialog box

Sorry, one more time I forgot to join a sub routine.
Here's the complete code

Code: [Select]

;; MBLOCKREPLACE (gile)
;; Replace one or more blocks by another one

(defun c:MBlockReplace (/ *error* acdoc blst target source)
  (defun *error* (msg)
    (vla-EndUndoMark acdoc)
    (princ)
  )
  (vl-load-com)
  (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (vlax-for b (vla-get-Blocks acdoc)
    (if (and
          (= (vla-get-IsLayout b) :vlax-false)
          (= (vla-get-IsXref b) :vlax-false)
          (not (wcmatch (setq name (vla-get-Name b)) "`**,*|*"))
        )
      (setq blst (cons (vla-get-Name b) blst))
    )
  )
  (setq target (ListBox "MBlockReplace"
                        "Select the block(s) to be replaced"
                        (mapcar 'cons blst blst)
                        2
               )
  )
  (setq source (ListBox "MBlockReplace"
                        "Select a block to replace block(s)"
                        (mapcar 'cons blst blst)
                        1
               )
  )
  (vla-StartUndoMark acdoc)
  (vlax-for blk
            (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
    (vlax-for obj blk
      (if (and
            (= (vla-get-ObjectName obj) "AcDbBlockReference")
            (vl-position (vla-get-Name obj) target)
          )
        (vla-put-Name obj source)
      )
    )
  )
  (vla-regen (vla-get-ActiveDocument (vlax-get-acad-object)) acAllViewports)
  (vla-EndUndoMark acdoc)
  (princ)
)

;; ListBox (gile)
;; DialogBox which allows one more choices in a list
;;
;; Arguments
;; title : The dialog title (STR)
;; msg ; message (STR), "" or nil for none
;; keylab : an association list which type is ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = popup list
;;        1 = single choice list
;;        2 = multipe choices list
;;
;; Return : the option key (flag = 0 or 1) or the option keys list (flag = 2)
;;
;; Example
;; (listbox "Layout" "Choos a layout" (mapcar 'cons (layoutlist) (layoutlist)) 1)

(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
  (setq tmp  (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
  )
  (write-line
    (strcat "ListBox:dialog{label=\"" title "\";")
    file
  )
  (if (and msg (/= msg ""))
    (write-line (strcat ":text{label=\"" msg "\";}") file)
  )
  (write-line
    (cond
      ((= 0 flag) "spacer;:popup_list{key=\"lst\";")
      ((= 1 flag) "spacer;:list_box{key=\"lst\";")
      (T "spacer;:list_box{key=\"lst\";multiple_select=true;")
    )
    file
  )
  (write-line "}spacer;ok_cancel;}" file)
  (close file)
  (setq dcl_id (load_dialog tmp))
  (if (not (new_dialog "ListBox" dcl_id))
    (exit)
  )
  (start_list "lst")
  (mapcar 'add_list (mapcar 'cdr keylab))
  (end_list)
  (action_tile
    "accept"
    "(or (= (get_tile \"lst\") \"\")
    (if (= 2 flag) (progn
    (foreach n (str2lst (get_tile \"lst\") \" \")
    (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)))
    (setq choice (reverse choice)))
    (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))))
    (done_dialog)"
  )
  (start_dialog)
  (unload_dialog dcl_id)
  (vl-file-delete tmp)
  choice
)

;; Str2Lst
;; Transforms a string with separator into a list of strings
;;
;; Arguments
;; str = the string
;; sep = the separator pattern

(defun str2lst (str sep / pos)
  (if (setq pos (vl-string-search sep str))
    (cons (substr str 1 pos)
  (str2lst (substr str (+ (strlen sep) pos 1)) sep)
    )
    (list str)
  )
)

[CAB]

David,
Took a look at your routine & found some bugs.
Revised code:

Code: [Select]

(defun c:rnblk (/ bl   ; Block List
                tdef ; Table Definition
                bn   ; Block Name existing
                bnt 
                fe
                fd  ;
                nn  ; New Name
                )
  ;;"old_name"  . "new_name"
  (setq bl '(("Drillbit5" . "Drillbit")
             ("Drillbit3" . "Drillbit")
             ("Drillbit7" . "Drillbit")
            )
  )
  ;;  itterate the Block Collection
  (while (setq tdef (tblnext "BLOCK" (not tdef)))
    (setq bn (cdr (assoc 2 tdef))
          fe (cdr (assoc -2 tdef))
    )
    (princ (strcat "\n" bn))
    (while fe
      (and (setq fd (entget fe))
           (= "INSERT" (cdr (assoc 0 fd)))
           (setq bnt (cdr(assoc 2 fd)))
           (setq nn (cdr (assoc bnt bl)))
           (tblsearch "BLOCK" nn)
           (entmod (subst (cons 2 nn) (assoc 2 fd) fd))
      )
      (setq fe (entnext fe))
    )
   
  )
  (command "REGENALL")
  (prin1)
)

[David Bethel]

I probably should have made a sample dwg to test it on,  Thanks  -David

[CAB]

A couple of tweaks and it worked well in my test.
Note that the new block must exist in the DWG.

[ArgV]

A couple of tweaks and it worked well in my test.
Note that the new block must exist in the DWG.

I've heard about the difference between blocks and inserts, but have never really 'understood' the difference. However, this works great for nested blocks. Thanks.

-ArgV

[Lee Mac]

There is a lot of information about the differences in this thread:

http://www.cadtutor.net/forum/showthread.php?t=36729