Highlight selected object

[msarqui]

Hello!

I found this routine here : http://www.cadtutor.net/forum/showthread.php?48458-Replace-Selected-Block-Or-Blocks-With-Another-Blo...

The routine is awesome, but I have a cosmetic issue. I noticed that it does not "highlight" the source block. It would be possible to upgrade it, in a way to have this traditional feature that indicate the source object has been selected?

(defun c:BRE (/ *error* blk f ss temp)
  ;; Replace multiple instances of selected blocks (can be different) with selected block
  ;; Size and Rotation will be taken from original block and original will be deleted
  ;; Required subroutines: AT:GetSel
  ;; Alan J. Thompson, 02.09.10

  (vl-load-com)

  (defun *error* (msg)
    (and f *AcadDoc* (vla-endundomark *AcadDoc*))
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
      (princ (strcat "\nError: " msg))
    )
  )

  (if
    (and
      (AT:GetSel
        entsel
        "\nSelect replacement block: "
        (lambda (x / e)
          (if
            (and
              (eq "INSERT" (cdr (assoc 0 (setq e (entget (car x))))))
              (/= 4 (logand (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 e))))) 4))
              (/= 4 (logand (cdr (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8 e)))))) 4))
            )
             (setq blk (vlax-ename->vla-object (car x)))
          )
        )
      )
      (princ "\nSelect blocks to be repalced: ")
      (setq ss (ssget "_:L" '((0 . "INSERT"))))
    )
     (progn
       (setq f (not (vla-startundomark
                      (cond (*AcadDoc*)
                            ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                      )
                    )
               )
       )
       (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
         (setq temp (vla-copy blk))
         (mapcar (function (lambda (p)
                             (vl-catch-all-apply
                               (function vlax-put-property)
                               (list temp p (vlax-get-property x p))
                             )
                           )
                 )
                 '(Insertionpoint Rotation XEffectiveScaleFactor YEffectiveScaleFactor
                   ZEffectiveScaleFactor
                  )
         )
         (vla-delete x)
       )
       (vla-delete ss)
       (*error* nil)
     )
  )
  (princ)
)

(defun AT:GetSel (meth msg fnc / ent good)
  ;; meth - selection method (entsel, nentsel, nentselp)
  ;; msg - message to display (nil for default)
  ;; fnc - optional function to apply to selected object
  ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
  ;; Alan J. Thompson, 05.25.10
  (setvar 'errno 0)
  (while (not good)
    (setq ent (meth (cond (msg)
                          ("\nSelect object: ")
                    )
              )
    )
    (cond
      ((vl-consp ent)
       (setq good (cond ((or (not fnc) (fnc ent)) ent)
                        ((prompt "\nInvalid object!"))
                  )
       )
      )
      ((eq (type ent) 'STR) (setq good ent))
      ((setq good (eq 52 (getvar 'errno))) nil)
      ((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again.")))
    )
  )
)

Thanks!

[Kent1Cooper]

The (redraw) function will do that.  If I'm getting the right entity name out of the special-purpose selection function [without studying that doo deeply], try adding this to highlight it before asking for Blocks to be replaced:

....

      )

      (not (redraw (car x) 3))
      (princ "\nSelect blocks to be repalced: ")

....

Since (redraw) always returns nil, I wrapped it in a (not) function so it would return T instead, and therefore contribute appropriately to the (and) function that's underway at the time.

Oh, and you should probably do another (redraw) when it's done, with the 4 argument to un-highlight it.  Otherwise it will remain highlighted until the next Regen.

[msarqui]

Hi Kent

It does not work

Error: bad argument type: lentityp nil

[Kent1Cooper]

---

@msarqui wrote:

.... 

It does not work

Error: bad argument type: lentityp nil

---

That's the "if" in my second sentence -- I tried using (car x) because that's what was used to make a VLA object in this line a little above:

          (setq blk (vlax-ename->vla-object (car x)))

But I see that's internal to the calling of the selection function, so....  How about:

(not (redraw (car ent) 3))

?

[msarqui]

I had the same error 😞
Error: bad argument type: lentityp nil

[Kent1Cooper · Accepted solution]

Another try:

(not (redraw (vlax-vla-object->ename blk) 3))

[msarqui]

Perfect!!!!

I also put (not (redraw (vlax-vla-object->ename blk) 4)) at the end to un-highlight it. And it works very well.

Thanks Kent!

[Kent1Cooper]

---

@msarqui wrote:

Perfect!!!!

I also put (not (redraw (vlax-vla-object->ename blk) 4)) at the end to un-highlight it. And it works very well.

Thanks Kent!

---

Good -- I should have delved a little deeper to begin with, and might have come up with the right approach sooner.

It doesn't hurt, but I expect there's no point in the (not) wrapper around the (redraw) function at the end.  It's needed earlier because it's within an (and) function and you don't want (redraw)'s nil return to spoil that, but assuming that where you're un-highlighting it you're no longer inside that (and) function, the (not) serves no purpose.

[msarqui]

You are right. It also works without the "(not"
Thanks!

[3dwannab]

I've a similar question. I want to grip highlight the new block afterward with something like:

(sssetfirst nil sset)

Also, the prompt for the new blocks doesn't appear for the:

(setq ss (ssget "_:L" '((0 . "INSERT"))))

Thanks.

[3dwannab]

Thanks for this LISP Kent.

I hope you don't mind me posting my edit but I got it working.

I've added redraw to old block selection like this post, Error handling for redraw and sssetfirst newly created blocks.

Thanks again 🙂

(defun c:BK_Replace (/ *error* oldblk newblk f ss1 ss2)
;; Replace multiple instances of selected blocks (can be different) with selected block
;; Size and Rotation will be taken from original block and original will be deleted
;; Required subroutines: AT:GetSel
;; Alan J. Thompson, 02.09.10
;; EDIT by 3dwannab, 09.04.18 - Added redraw to old block selection, Error handling for redraw and sssetfirst newly created blocks.
;; Found at: http://www.cadtutor.net/forum/showthread.php?48458-Replace-Selected-Block-Or-Blocks-With-Another-Block
(vl-load-com)
(defun *error* (msg)
 (and f *AcadDoc* (vla-endundomark *AcadDoc*))
 (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
 (progn
 (princ (strcat "\nError: " msg))
 (redraw (vlax-vla-object->ename oldblk) 4)
 )
 )
 (redraw (vlax-vla-object->ename oldblk) 4)
 )
(if
 (and
 (AT:GetSel
 entsel
 "\nSelect NEW block: "
 (lambda (x / e)
 (if
 (and
 (eq "INSERT" (cdr (assoc 0 (setq e (entget (car x))))))
 (/= 4 (logand (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 e))))) 4))
 (/= 4 (logand (cdr (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8 e)))))) 4))
 )
 (setq oldblk (vlax-ename->vla-object (car x)))
 )
 )
 )

 (not (redraw (vlax-vla-object->ename oldblk) 3))
 (princ "\nSelect OLD blocks to be replaced: ")
 (setq ss1 (ssget "_:L" '((0 . "INSERT"))))
 )
 (progn
 (setq f (not (vla-startundomark
 (cond (*AcadDoc*)
 ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
 )
 )
 )
 )

 ; Set ss2 to a null selection set:
 (setq ss2 (ssadd))

 (vlax-for x (setq ss1 (vla-get-activeselectionset *AcadDoc*))
 (setq newblk (vla-copy oldblk))

 (mapcar (function (lambda (p)
 (vl-catch-all-apply
 (function vlax-put-property)
 (list newblk p (vlax-get-property x p))
 )
 )
 )
 '(Insertionpoint Rotation XEffectiveScaleFactor YEffectiveScaleFactor
 ZEffectiveScaleFactor
 )
 )

 ; The following command adds the newblk entity to the selection set referenced by ss2:
 (ssadd (vlax-vla-object->ename newblk) ss2)

 (vla-delete x)
 )

 ; Select ss2
 (sssetfirst nil ss2)

 (redraw (vlax-vla-object->ename oldblk) 4)

 (vla-delete ss1)

 (*error* nil)
 )
 )
(princ)
)
(defun AT:GetSel (meth msg fnc / ent good)
;; meth - selection method (entsel, nentsel, nentselp)
;; msg - message to display (nil for default)
;; fnc - optional function to apply to selected object
;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
;; Alan J. Thompson, 05.25.10
(setvar 'errno 0)
(while (not good)
 (setq ent (meth (cond (msg)
 ("\nSelect OLD blocks to be replaced: ")
 )
 )
 )
 (cond
 ((vl-consp ent)
 (setq good (cond ((or (not fnc) (fnc ent)) ent)
 ((prompt "\nInvalid object!"))
 )
 )
 )
 ((eq (type ent) 'STR) (setq good ent))
 ((setq good (eq 52 (getvar 'errno))) nil)
 ((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again.")))
 )
 )
)

[Kent1Cooper]

---

@3dwannab wrote:

I've a similar question. I want to grip highlight the new block afterward with something like:

(sssetfirst nil sset)

Also, the prompt for the new blocks doesn't appear for the:

(setq ss (ssget "_:L" '((0 . "INSERT"))))

....

---

The first one looks like it should work, provided the 'sset' variable [I don't see how you're setting that] contains a selection set  [not, for example, an entity name].

For your second one, if you're talking about the code at the top of the thread, the prompt is before  that, and unfortunately, (ssget) always supplies its own plain "Select objects: " prompt [and always in the plural], which I don't think there's any way to get around.  [It's not like (entsel) for which you can spell out your own prompt.]  I usually give a partial  prompt beforehand, for which the prompt (ssget) supplies is the conclusion, such as:

(prompt "\nFor those to be replaced,")

(ssget ....

[3dwannab]

Looks like you were messaging as I posted my fix.

I didn't get the ssget prompt thing working but I thought I read somewhere that it's possible but that's not big deal. My main goal was to select the newly created block with sssetfirst

Thanks.