LISP to - Connect line to base point of a block

[nkamphui]

Hi all,

Is there a LISP that connects lines to the base point of a block? See attached pictures.

[hak_vz]

(defun bbp ()(trans (cdr(assoc 10 (entget(car(entsel)))))0 1))

Copy this line above and past into a console and hit <enter>

This creates function (bbp). You can copy (bbp) in clipboard and paste it when needed.

And then select  connecting line end point i.e point you have to connect to block base point and move its handle.

When asked for new point paste or type (bbp) and hit enter

It asks you to select a block, and when selected it return its base point. So line and will move to that position.

Before you receive some better code you may use it and finish your work. Remember, Acad is drafting program  so changing 100 block shouldn't be a problem at all.

[ВeekeeCZ · Accepted solution]

This works quite well for 3dpolylines.

BUT not with lwpolylines - if there is one, you need to unselect its block! See HERE  what I mean.

(vl-load-com)

(defun c:FixPlineToBlock ( / s i e o c lst-b lst-p)

  (if (setq s (ssget '((0 . "POLYLINE,INSERT"))))
    (repeat (setq i (sslength s))
      (setq e (ssname s (setq i (1- i)))
	    o (vlax-ename->vla-object e))
      (if (= "INSERT" (cdr (assoc 0 (entget e))))
	(setq lst-b (cons (cdr (assoc 10 (entget e))) lst-b))
	(setq lst-p (cons (cons o (progn
				    (setq c (reverse (vlax-get o 'Coordinates)))
				    (list (nth 2 c) (nth 1 c) 0)))
			  lst-p)))))
  (if (and lst-b lst-p)
    (foreach b lst-b
      (setq lst-p (vl-sort lst-p (function (lambda (p1 p2) (< (distance b (cdr p1)) (distance b (cdr p2)))))))
      (vlax-put (caar lst-p) 'Coordinates (append (reverse (cdddr (reverse (vlax-get (caar lst-p) 'Coordinates)))) b))
      (setq lst-p (cdr lst-p))))
  (princ)
  )

[pbejse]

---

@nkamphui wrote:

?

---

If its not don't worry about it. 😊

[nkamphui]

Thanks for the reply. @ВeekeeCZ solution worked best for me.

[stevor]

And Autolisp probably could save time, maybe 99%+,

by doing them all at once.

One way could be to define a search distance, like 3

Drawing Units, if the DUs are by cm, from an insert

 point of an INSERT, ie, 'block,  to find the closest 'pipe,' 

using the ssget "c" function.

Then modify that pipe object to match the insert pt,

with the entmod function.

[nkamphui]

Thankyou very much, works perfect! Transformed all lines to 3D polylines without issues. Only lines that are perfectly straight dissappear when executing this LISP. But i can do those by hand. Thanks again!

[ВeekeeCZ]

---

@ВeekeeCZ wrote:

This works quite well for 3dpolylines.

BUT not with lwpolylines - if there is one, you need to unselect its block! See HERE  what I mean.

---

... or pair it the other way around. For each pline end point search for the closest block insertion point. But I guess the way it is now is good enough.

[pbejse]

---

@nkamphui wrote:

Thankyou very much, works perfect!

---

Now you see the rainbow  @nkamphui 🙂

[hak_vz]

---

@nkamphui wrote:

Thanks for the reply. @ВeekeeCZ solution worked best for me.

---

Where @ВeekeeCZ solution don't work you can apply this (Lwpoly) . I'm at work and don't have a time to code something like he did. My solution is single line function written "out of sleave". I'm glad that you received a solution to your problem.

[ВeekeeCZ · Accepted solution]

---

@ВeekeeCZ wrote:

---

@ВeekeeCZ wrote:

This works quite well for 3dpolylines.

BUT not with lwpolylines - if there is one, you need to unselect its block! See HERE  what I mean.

---

... or pair it the other way around. For each pline end point search for the closest block insertion point. 

---

The other way around without the need to unselect no-match blocks. Also added distance limitation.

(vl-load-com)

(defun c:FixPlineToBlock ( / s i e o c lst-b lst-p)

  (if (setq s (ssget '((0 . "POLYLINE,INSERT"))))
    (repeat (setq i (sslength s))
      (setq e (ssname s (setq i (1- i))))
      (if (= "INSERT" (cdr (assoc 0 (entget e))))
	(setq lst-b (cons (cdr (assoc 10 (entget e)))
			  lst-b))
	(setq lst-p (cons (cons (setq o (vlax-ename->vla-object e))
				(setq c (reverse (vlax-get o 'Coordinates))
				      c (list (nth 2 c) (nth 1 c) 0)))
			  lst-p)))))
  (if (and lst-b lst-p)
    (foreach p lst-p
      (setq lst-b (vl-sort lst-b '(lambda (b1 b2) (< (distance b1 (cdr p)) (distance b2 (cdr p))))))
      (if (< (distance (car lst-b) (cdr p)) 2.)
	(progn
	  (vlax-put (car p) 'Coordinates (append (reverse (cdddr (reverse (vlax-get (car p) 'Coordinates)))) (car lst-b)))
	  (setq lst-b (cdr lst-b))))))
  (princ)
  )

[nkamphui]

This works even better thanks!