Insert block to multiple points

[loftpc]

I am trying find a lisp routine that will allow me to window objects, with object snap set, and insert a block to whatever point object snap was set to. ... i.e. I have a bunch of circles and need to insert the block at the center of each, or line segments that create an X and would insert the block to the intersection. The block would be the same (cor) and rotation would always be o and scale would always be 1. I've tried the pt2blk routine that I've seen but it doesn't work as I need.

Any help would be greatly appreciated! Thanks, Chip

[pbejse · Accepted solution]

---

@loftpc wrote:

This really works well and is very much appreciated. This will save a tremendous amount of time. I look forward to seeing if you're able to include the apparent intersection snap.

---

I agree with @Kent1Cooper about the term "apparent intersection"  and it may produce unexpected results.

We can include an extend option on the code but it may produce something like this 

with acExtendBoth option

with acExtendThisEntity option

For apparent intersection, It's totally different  with multiple objects selected than selecting only 2 objects.

Anyway, here's a code that includes the apparent intersection from _+dsettings but ignores most of it in the process

(vlax-invoke (car lst) 'IntersectWith e acExtendNone));<- acExtendOtherEntity a better option me thinks

in most cases endpoint mode is more than enough.

(defun c:mark2 ( / l2p osm cur fltr f f2 ss curves _inters lst l )
;;;		pBe | Apr 2022			;;;
(defun l2p (l)
 (if l
   (cons (list (car l) (cadr l) (caddr l)) (l2p (cdddr l)))
   )
 )  
(setq osm (getvar 'osmode))
(setq func (lambda (cd) (if (= cd (logand osm cd)) cd )))
(setq func2 (lambda (x) (equal (distance pt x) 0.0 1e-8)))
(setq func3 '(entmakex (list (cons 0 "INSERT") (cons 2  "cor") (cons 10 pt))))
(setq cur (vl-some 'func
		   '(1 2 4 32 2048);< end/mid/cen/int/app int
	  )
)
(setq fltr "CIRCLE,ARC" )   
	(cond	 
	 ((and
	   (setq f '(list (vlax-curve-getStartPoint e)
		     (vlax-curve-getEndPoint e)))
	   (= cur 1 ) (setq f2 f))
	 )
	 ((= cur 2)
	     (setq f2 '(list (vlax-curve-getPointAtParam e 
		(* 0.50 (apply '+ (mapcar '(lambda (p)
			  (vlax-curve-getParamAtPoint e p)) (eval f)))))))
	    )
	 ((setq curves (= cur  4))(setq f2
		'(list (vlax-get (vlax-ename->vla-object e) 'Center))))
	 ((setq _inters (member cur '(32 2048)))
	  )	 
	 )

(cond
  ((null (setq ss (ssget  (list (cons 0  (if curves fltr  "*LINE,ARC"))))))	)
  ( _inters
	(repeat (sslength ss)
	       (setq lst (cons (vlax-ename->vla-object (setq en (ssname ss 0))) lst))
	       (ssdel en ss)
	     )
	   (while lst
	       (foreach e (cdr lst)
	         (foreach pt (l2p (vlax-invoke (car lst) 'IntersectWith e acExtendOtherEntity));<-- this here 
	           (if (not (vl-some 'func2 l))
	             (setq l (cons pt l))
	           )
	         )
	       )
	       (setq lst (cdr lst)))
   (if l (foreach pt l (eval func3)))
	)
  ((repeat (setq i (sslength ss))
    (setq e (ssname ss (setq i (1- i))))
	    (foreach pt (eval f2)
	      (if (not (vl-some 'func2 l))
	             (progn
		       (setq l (cons pt l))
		        (eval func3)
		       )
		)
	      )
	    )
	  )
  )
  (princ)
  )

HTH

[loftpc]

My deepest thanks go out to all who offered solutions and suggestions for my request(s). What a great forum to be a part of. I was able to use these routines to effectively save hours copying the same block from point to point just by setting the object snap and windowing the lines, arcs and circles the block needed to be added to. Thank you all again. Chip