Place a circle on a selected blocks insert point

[rodb]

Hi everyone. You have a dwg with multiple sets of different blocks and a circle you want to place on the insert point of each set blocks. 

You select the circle then select one of the blocks in the set and the circle is placed on the insert point of each of the blocks in that set. It would save time from doing it manually and save on mistakes.

[pbejse]

---

@RodB wrote:

Hi everyone. You have a dwg with multiple sets of different blocks and a circle you want to place on the insert point of each set blocks. 

You select the circle then select one of the blocks in the set and the circle is placed on the insert point of each of the blocks in that set. It would save time from doing it manually and save on mistakes.

---

By set you mean the same block name?

[rodb]

Yes thats what I meant so you might have 10 blocks of the same name but you only need to pick one of the blocks with that name. Then you can assign a different circle to another set of blocks with a different name by just picking one of them.

[pbejse]

---

@RodB wrote:

Yes thats what I meant so you might have 10 blocks of the same name but you only need to pick one of the blocks with that name. Then you can assign a different circle to another set of blocks with a different name by just picking one of them.

---

Select a  circle, then select a block . Got it:

(defun C:MarkNEblk (/ aDoc cir rad blk ss )
  (vl-load-com)
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if (and (setq cir (car (entsel "\nSelect Circle: ")))
           (eq (vla-get-ObjectName (setq cir (vlax-ename->vla-object cir))) "AcDbCircle")
           (setq rad (vla-get-radius cir))
           (setq blk (car (entsel "\nSelect Block: ")))
           (eq (vla-get-ObjectName (setq blk (vlax-ename->vla-object blk))) "AcDbBlockReference")
      )
    (progn (setq ss (ssget "_X"
                           (list '(0 . "INSERT") (cons 2 (strcat (setq bn (vla-get-EffectiveName blk)) ",`*U*")))
                    )
           )
           (repeat (setq i (sslength ss))
             (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
             (if (eq (vla-get-EffectiveName e) bn)
                      (vla-AddCircle
                        (vla-ObjectIDtoObject adoc (vla-get-OwnerID e))
                        (vla-get-InsertionPoint e) rad
               )
             )
           )
    )
  )
  (princ)
)

[rodb]

Thats visual lisp isn't it? so its tricky for me to understand but I think you are drawing the circle instead of copying the circle? It may be that the object to place is a rectangle or other shape so I was thinking of doing a copy so the placed object could be any shape? It does look like its much easier to access bloakcs with visual lisp the good old Autolisp?

[rodb]

Unfortunately

just off to work in the snow now!

[pbejse]

---

@RodB wrote:

Thats visual lisp isn't it? so its tricky for me to understand but I think you are drawing the circle instead of copying the circle? It may be that the object to place is a rectangle or other shape so I was thinking of doing a copy so the placed object could be any shape? It does look like its much easier to access bloakcs with visual lisp the good old Autolisp?

---

Here's a none Vlisp version

(defun C:MarkNEblk2 (/ aDoc cir rad blk ss)
  (if (and (setq cir (car (entsel "\nSelect Circle: ")))
           (eq (cdr (Assoc 0 (setq cir (entget cir)))) "CIRCLE")
           (Setq rad (cdr (assoc 40 cir)))
           (setq blk (car (entsel "\nSelect Block: ")))
           (eq (cdr (Assoc 0 (setq blk (entget blk)))) "INSERT")
      )
    (progn (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 (cdr (assoc 2 blk))))))
           (repeat (setq i (sslength ss))
             (setq e (entget (ssname ss (setq i (1- i)))))
             (entmakex (list (cons 0 "CIRCLE") (Assoc 10 e) (cons 40 rad) (assoc 410 e)))
           )
    )
  )
  (princ)
)

I guess we can do that too. ,problem with "other shape" is the basepoint. Is that what you're after?

[pbejse]

HAve time to kill

(defun C:MarkNEblk3 (/ aDoc obj blk ss ll ur mo sp)
  (vl-load-com)
  (if (and (setq obj (car (entsel "\nSelect object for Marker: ")))
           (setq obj (vlax-ename->vla-object obj))
           (setq sp (progn (vla-GetBoundingBox obj 'll 'ur)
               (mapcar (function (lambda (a b) (/ (+ a b) 2.)))
                       (vlax-safearray->list ll)
                       (vlax-safearray->list ur))
               )
           )
           (setq blk (car (entsel "\nSelect Block: ")))
           (eq (cdr (Assoc 0 (setq blk (entget blk)))) "INSERT")
      )
    (progn (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 (cdr (assoc 2 blk))) (cons 410 (getvar 'ctab)))))
           (repeat (setq i (sslength ss))
             (setq e (entget (ssname ss (setq i (1- i)))))
             (setq mo (vla-copy obj))
             (vlax-invoke
               mo 'move sp
               (cdr (Assoc 10 e))
             )
           )
    )
  )
  (princ)
)

 command: MarkNEblk3

[rodb]

Just got home, yes that last vlisp works perfectly for circles and rectangles I am sure that will cover 95% of cases, I think trying to get it to use the point specified when picking the obj to stick onto the blocks is just an unecessary step, its a great solution! Well done and thanks very much!

[pbejse]

---

@RodB wrote:

Just got home, yes that last vlisp works perfectly for circles and rectangles I am sure that will cover 95% of cases, I think trying to get it to use the point specified when picking the obj to stick onto the blocks is just an unecessary step, its a great solution! Well done and thanks very much!

---

That can be arranged:

Replace this line 

(setq sp (progn (vla-GetBoundingBox obj 'll 'ur)
               (mapcar (function (lambda (a b) (/ (+ a b) 2.)))
                       (vlax-safearray->list ll)
                       (vlax-safearray->list ur))
               )
           )

 With this

(setq sp (getpoint "\nPick Basepoint: "))

 Then you're good to go.

HTH

[rodb]

That actually is absolutely perfect! So pleased, thank you!