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

[JBerns]

@loftpc,

A quick search found this thread that discussed inserting a block at all POINT objects in a drawing:

https://www.cadtutor.net/forum/topic/10845-inserting-the-same-block-to-multiple-points-in-drawing/ 

See if you can adapt this to your needs.

Or, some more searching may  find more examples. Sometimes just changing the search times get better results.

Hope this is helpful.

Regards,

Jerry

[loftpc]

Thanks for the suggestion but I do not really have "points" in the drawing I have line and arc segments that I need to insert a block to. I've searched high and low for different lisp routines but I've yet to find one that will allow me me to window the segments and have a block inserted to whatever object snap is set.

[JBerns]

I found this article and code by Bill Kramer:

https://www.cadalyst.com/cad/autocad/object-manipulation-visual-lisp-4806 

I am working on adapting it to your selection set of lines and circles.

Would you be able to provide a sample drawing of lines, circles, and the block you want to insert?

Regards,

Jerry

[CADaSchtroumpf]

I have this for make point, but you can try to use an insert block

(vl-load-com)
(defun l-coor2l-pt (lst flag / )
  (if lst
    (cons
      (list
        (car lst)
        (cadr lst)
        (if flag
          (+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst))
          (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0)
        )
      )
      (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag)
    )
  )
)
(defun c:ptdef2pt3D ( / js n ename l_pt l_pr)
  (while
    (null
      (setq js (ssget '((0 . "*POLYLINE,LINE,ARC") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>"))))
    )
    (princ "\nSelect is empty!")
  )
  (setvar "CMDECHO" 0)
  (repeat (setq n (sslength js))
    (setq ename (vlax-ename->vla-object (ssname js (setq n (1- n)))) l_pt nil)
    (setq l_pr (list 'StartPoint 'EndPoint 'Coordinates 'FitPoints))
    (foreach n l_pr
      (if (vlax-property-available-p ename n)
        (setq l_pt
          (if (eq n 'Coordinates)
            (progn
              (append
                (if (eq (vla-get-ObjectName ename) "AcDbPolyline")
                  (l-coor2l-pt (vlax-get ename n) nil)
                  (l-coor2l-pt (vlax-get ename n) T)
                )
                l_pt
              )
            )
            (cons (vlax-get ename n) l_pt)
          )
        )
      )
    )
    (mapcar
      '(lambda (x)
        (entmake (list (cons 0 "POINT") (cons 8 (getvar "CLAYER")) (cons 10 x)))
        ;(command "_.insert" "YOUR_BLOCK_NAME" "X" 1 "Y" 1 "_Rotate" 0.0 "_none" (trans x 0 1))
      )
      l_pt
    )
  )
  (setvar "CMDECHO" 1)
  (sssetfirst nil js)
  (prin1)
)

Uncomment  (command "_.insert" and put your block name

Comment the line with (entmake

[loftpc]

Attached is a drawing named lot lines. I just want to specify an object snap, endpoint in this case, and insert the block "cor" at every instance. Currently I am copying the block from endpoint to endpoint. 

Attached is a routine I found but it does not seem to work. I am not a programmer and may have not saved it correctly. Maybe you could give it and try and let me know if it works for you. If it does work maybe you could send me the lisp routine and I could download it. That would be much appreciated.

Again, thanks, Chip

Here's a quick and dirty LISP solution. It will operate on ALL point objects in a drawing; if you'd rather select the points manually, or with a window, leave the "x" out of the second line: (defun C:PT2BLK ( / ss blk n) (setq ss (ssget "x" '((0 . "POINT"))) blk (getstring "\nName of Block: ") )::setq (if (and ss (tblsearch "block" blk)) (progn (setq n (1- (sslength ss))) (while (>= n 0) (setq pt (cdr (assoc 10 (entget (ssname ss n)))) n (1- n) );; setq (command "_.-insert" blk pt "" "" "") );;while );;progn );; if (princ) ) ___ 

[loftpc]

Thank you for the suggestion but I could not get this to work. I can insert a point at every endpoint when windowed but I can not insert my block to the point.

[CADaSchtroumpf]

If your block name is "cor"

This seem to work, but i think that you must run OVERKILL after

(vl-load-com)
(defun l-coor2l-pt (lst flag / )
  (if lst
    (cons
      (list
        (car lst)
        (cadr lst)
        (if flag
          (+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst))
          (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0)
        )
      )
      (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag)
    )
  )
)
(defun c:ptdef2pt3D ( / js n ename l_pt l_pr)
  (while
    (null
      (setq js (ssget '((0 . "*POLYLINE,LINE,ARC") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>"))))
    )
    (princ "\nSelect is empty!")
  )
  (repeat (setq n (sslength js))
    (setq ename (vlax-ename->vla-object (ssname js (setq n (1- n)))) l_pt nil)
    (setq l_pr (list 'StartPoint 'EndPoint 'Coordinates 'FitPoints))
    (foreach n l_pr
      (if (vlax-property-available-p ename n)
        (setq l_pt
          (if (eq n 'Coordinates)
            (progn
              (append
                (if (eq (vla-get-ObjectName ename) "AcDbPolyline")
                  (l-coor2l-pt (vlax-get ename n) nil)
                  (l-coor2l-pt (vlax-get ename n) T)
                )
                l_pt
              )
            )
            (cons (vlax-get ename n) l_pt)
          )
        )
      )
    )
    (mapcar
      '(lambda (x)
        (entmake (list (cons 0 "INSERT") (cons 8 (getvar "CLAYER")) (cons 2 "cor") (cons 10 x) (cons 41 1.0) (cons 42 1.0) (cons 43 1.0) (cons 50 0.0)))
      )
      l_pt
    )
  )
  (sssetfirst nil js)
  (prin1)
)

[loftpc]

So very close. The "cor" block inserts on all endpoints. Is there any way to have the block go to whatever object snap is set? Sometimes we insert to endpoints, but sometimes we use the center or intersection object snap. With this option I believe this would be perfect.

Thank you very much for the help!

Chip

[pbejse]

---

@loftpc wrote:

 Sometimes we insert to endpoints, but sometimes we use the center or intersection object snap.

---

Is it one or the other or a combination of 2 or 3? 

[loftpc]

A combination of all 3: endpoint, center, apparent intersection. Any possible way to have it go to whatever the object snap is set to?

[pbejse · Accepted solution]

---

@loftpc wrote:

A combination of all 3: endpoint, center, apparent intersection. Any possible way to have it go to whatever the object snap is set to?

---

We'll do intersection later

(defun c:marker ( / osm cur fltr f f2 ss curves l)
(setq osm (getvar 'osmode))
(setq cur (vl-some '(lambda (cd)
		      (if (= cd (logand osm cd))
			cd
		      )
		    )
		   '(1 2 4);< end/mid/cen, will do int later
	  )
)
(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))))
	 )

(if (setq ss (ssget  (list (cons 0  (if curves fltr  "*LINE,ARC")))))
  
  (repeat (setq i (sslength ss))
    (setq e (ssname ss (setq i (1- i))))
    (foreach pt (eval f2)
      (if (not (vl-some '(lambda (x) (equal (distance pt x) 0.0 1e-8)) l))
             (progn
	       (setq l (cons pt l))
	       (entmakex (list (cons 0 "INSERT")
		                  (cons 2  "cor")
		                  (cons 10 pt)))
	       )
	)
      )
    )
  )
  (princ)
  )

HTH

[loftpc]

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.

Thank you again, Chip

[JBerns · Accepted solution]

@loftpc,

It would appear there have been many solutions offered. Always a generous Community.

With the help of some code from Bill Kramer and Lee Mac, I offer my solution.

Be sure to edit the block name (bn) to match your actual block name.

Edit insertion layer too (DXF code 66 in EntMake section).

It could use error handling.

I hope it is helpful.

Regards,

Jerry

[Kent1Cooper]

---

@JBerns wrote:

....

Edit insertion layer too (DXF code 66 in EntMake section).

....

---

That would be 8 for the Layer [66 is related to Attributes].

[Kent1Cooper]

---

@loftpc wrote:

A combination of all 3: endpoint, center, apparent intersection. ....

---

Do you really mean apparent intersection?  Your sample drawing must have thousands of apparent intersections between pairs of entities, many of which surely you don't want, such as these:

and many of which would coincide with apparent intersections between some different pair(s) of entities, making a lot of duplicates.

[loftpc]

see below

[loftpc]

We bring engineering files over with spot elevations. Sometimes these are X's, sometimes circles, sometimes nodes. We insert our symbols onto the engineering files (saved down to 2010). I isolate their "marker" layer and insert our corner symbol, and copy, copy, copy .... We've occasionally had issues when the intersection snap didn't work, but the apparent intersection did. Intersection might be all we need. Truly, I really didn't know the difference. The routine in message 12 works great for the endpoints and circles. I was hoping we could just isolate the marker layer (shown in green) and insert our block at the intersection of all the X's. They are line segments.

Many thanks for the help! Chip

[loftpc]

Jerry, thank you for the help. When I ran this, it came up with an error. Our block is "cor" and layer is "cor sym".

Thank you, Chip

[JBerns]

@Kent1Cooper,

Thanks for the correction.