add option to lisp routine to connect a block to any nearest block point

[jtm2020hyo]

I need a Lisp to connect selected blocks the nearest block of any block-point. since base-point( insert-point ) to any nearest block of the selected blocks.

here I attached a lisp (bbl8-by-dbhunia.lsp) that connect selected block to nearest block with multiple options.

here the post where was developed:

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/modify-lisp-to-work-only-at-certain-...

[marko_ribar]

Very lightly tested on your DWG and on some other...

(defun c:connblks2neablks ( / car-sort nexplode ss1 ss2 i bl sss2 in clst bp c lil ssn2 bln sssn2 inn )

  (vl-load-com)

  ;;; (car-sort '(2 4 1 3 5 1) '<) => nil
  ;;; (car-sort '(2 4 1 3 5 1) '<=) => 1
  (defun car-sort ( l f / removenth r k )

    (defun removenth ( l n / k )
      (setq k -1)
      (vl-remove-if '(lambda ( x ) (= (setq k (1+ k)) n)) l)
    )

    (setq k -1)
    (vl-some '(lambda ( a ) (setq k (1+ k)) (if (vl-every '(lambda ( x ) (apply f (list a x))) (removenth l k)) (setq r a))) l)
    r
  )

  (defun nexplode ( sss2 )
    (if
      (and
        (sssetfirst nil sss2)
        (setq ssn2 (ssget "_I" '((0 . "INSERT"))))
        (sssetfirst nil nil)
      )
      (repeat (setq in (sslength ssn2))
        (setq bln (ssname ssn2 (setq in (1- in))))
        (if (= (vla-get-isxref (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (entget bln))))) :vlax-false)
          (progn
            (vl-cmdf "_.EXPLODE" bln)
            (while (< 0 (getvar 'cmdactive))
              (vl-cmdf "")
            )
            (setq sssn2 (ssget "_P"))
            (repeat (setq inn (sslength sssn2))
              (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (ssname sssn2 (setq inn (1- inn)))))))
                (setq clst (cons (ssname sssn2 inn) clst))
              )
            )
            (if sssn2
              (nexplode sssn2)
            )
          )
        )
      )
    )
  )

  (while
    (or
      (prompt "\nSelect blocks you want to connect...")
      (not (setq ss1 (ssget '((0 . "INSERT")))))
    )
    (prompt "\nEmpty sel. set... Retry selecting blocks you want to connect...")
  )
  (while
    (or
      (prompt "\nSelect blocks you want to connect to...")
      (not (setq ss2 (ssget "_:L" '((0 . "INSERT")))))
    )
    (prompt "\nEmpty sel. set... Retry selecting blocks you want to connect to on unlocked layer(s)...")
  )
  (if (= 8 (logand 8 (getvar 'undoctl)))
    (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
  )
  (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
  (repeat (setq i (sslength ss2))
    (setq bl (ssname ss2 (setq i (1- i))))
    (if (= (vla-get-isxref (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (entget bl))))) :vlax-false)
      (progn
        (vl-cmdf "_.EXPLODE" bl)
        (while (< 0 (getvar 'cmdactive))
          (vl-cmdf "")
        )
        (setq sss2 (ssget "_P"))
        (repeat (setq in (sslength sss2))
          (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (ssname sss2 (setq in (1- in)))))))
            (setq clst (cons (ssname sss2 in) clst))
          )
        )
        (if sss2
          (nexplode sss2)
        )
      )
    )
  )
  (repeat (setq i (sslength ss1))
    (setq bl (ssname ss1 (setq i (1- i))))
    (setq bp (cdr (assoc 10 (entget bl))))
    (setq c (car-sort clst '(lambda ( a b ) (<= (distance bp (vlax-curve-getclosestpointto a bp)) (distance bp (vlax-curve-getclosestpointto b bp))))))
    (setq lil (cons (list bp (vlax-curve-getclosestpointto c bp)) lil))
  )
  (vl-cmdf "_.UNDO" "_B")
  (foreach li lil
    (entmake (list '(0 . "LINE") (cons 10 (car li)) (cons 11 (cadr li)) '(62 . 1)))
  )
  (princ)
)

HTH., M.R.

[ronjonp]

Here's another way to do it:

(defun c:foo (/ _cp b e p p2 s)
  ;; RJP » 2018-12-28
  (defun _cp (e p / r)
    (cond
      ((= 'list (type (setq r (vl-catch-all-apply 'vlax-curve-getclosestpointto (list e p))))) r)
    )
  )
  (cond	((and (setq e (car (entsel "\nPick larger block: ")))
	      (= "INSERT" (cdr (assoc 0 (entget e))))
	      (setq b (vlax-invoke (vlax-ename->vla-object e) 'explode))
	      (print "Pick blocks to attach to larger block...")
	      (setq s (ssget '((0 . "insert"))))
	 )
	 (ssdel e s)
	 (foreach bl (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (setq p (cdr (assoc 10 (entget bl))))
	   (setq p2 (car (vl-sort (mapcar '(lambda (x) (_cp x p)) b)
				  '(lambda (r j) (< (distance p r) (distance p j)))
			 )
		    )
	   )
	   (and p2 (entmakex (list '(0 . "line") '(8 . "line") (cons 10 p) (cons 11 p2) '(62 . 1))))
	 )
	 (mapcar 'vla-delete b)
	)
  )
  (princ)
)

[dbhunia]

Try this.......Lightly tested.....

[marko_ribar]

Here is also lightly tested version that is now applicable to all curves, weather they belong to blocks or not... Also it is allowed selection of INSERTS that can be part of selection sets either for connecting, or connecting to blocks... So basically you can select the same blocks twice and line will be connecting their insertion points to curves that are closest to insertion points - most offten curves of those same blocks...

BTW. I think OP dissapeared and request is a little exshibition like - not for real world appliance in working situations using CAD...

(defun c:connblks2neacurves ( / car-sort nexplode cmde ss1 ss2 el s2 i bl sss2 in clst bp c lil ssn2 bln sssn2 inn )

  (vl-load-com)

  ;;; (car-sort '(2 4 1 3 5 1) '<) => nil
  ;;; (car-sort '(2 4 1 3 5 1) '<=) => 1
  (defun car-sort ( l f / removenth r k )

    (defun removenth ( l n / k )
      (setq k -1)
      (vl-remove-if '(lambda ( x ) (= (setq k (1+ k)) n)) l)
    )

    (setq k -1)
    (vl-some '(lambda ( a ) (setq k (1+ k)) (if (vl-every '(lambda ( x ) (apply f (list a x))) (removenth l k)) (setq r a))) l)
    r
  )

  (defun nexplode ( sss2 )
    (cond
      ( (and
          sss2
          (sssetfirst nil sss2)
          (setq ssn2 (ssget "_I" '((0 . "INSERT"))))
          (sssetfirst nil nil)
        )
        (repeat (setq in (sslength sss2))
          (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (ssname sss2 (setq in (1- in))))))) (not (vl-position (ssname sss2 in) clst)))
            (setq clst (cons (ssname sss2 in) clst))
          )
        )
        (foreach bln (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssn2)))
          (if (= (vla-get-isxref (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (entget bln))))) :vlax-false)
            (progn
              (vl-cmdf "_.EXPLODE" bln)
              (while (< 0 (getvar 'cmdactive))
                (vl-cmdf "")
              )
              (setq sssn2 (ssget "_P"))
              (repeat (setq inn (sslength sssn2))
                (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (ssname sssn2 (setq inn (1- inn))))))) (not (vl-position (ssname sssn2 inn) clst)))
                  (setq clst (cons (ssname sssn2 inn) clst))
                )
              )
              (if sssn2
                (nexplode sssn2)
              )
            )
          )
        )
      )
      ( (and
          sss2
          (sssetfirst nil sss2)
          (not (setq ssn2 (ssget "_I" '((0 . "INSERT")))))
          (sssetfirst nil nil)
        )
        (repeat (setq in (sslength sss2))
          (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (ssname sss2 (setq in (1- in))))))) (not (vl-position (ssname sss2 in) clst)))
            (setq clst (cons (ssname sss2 in) clst))
          )
        )
      )
    )
  )

  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (while
    (or
      (prompt "\nSelect blocks you want to connect...")
      (not (setq ss1 (ssget '((0 . "INSERT")))))
    )
    (prompt "\nEmpty sel. set... Retry selecting blocks you want to connect...")
  )
  (while
    (or
      (prompt "\nSelect entities you want to connect to...")
      (not (setq ss2 (ssget "_:L")))
    )
    (prompt "\nEmpty sel. set... Retry selecting entities you want to connect to on unlocked layer(s)...")
  )
  (if (= 8 (logand 8 (getvar 'undoctl)))
    (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
  )
  (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
  (setq el (entlast) s2 (ssadd))
  (repeat (setq i (sslength ss2))
    (ssadd (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object (ssname ss2 (setq i (1- i)))))) s2)
  )
  (repeat (setq i (sslength s2))
    (setq bl (ssname s2 (setq i (1- i))))
    (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list bl))))
      (if (not (vl-position bl clst))
        (setq clst (cons bl clst))
      )
      (if (= (cdr (assoc 0 (entget bl))) "INSERT")
        (if (= (vla-get-isxref (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (entget bl))))) :vlax-false)
          (progn
            (vl-cmdf "_.EXPLODE" bl)
            (while (< 0 (getvar 'cmdactive))
              (vl-cmdf "")
            )
            (setq sss2 (ssget "_P"))
            (repeat (setq in (sslength sss2))
              (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (ssname sss2 (setq in (1- in))))))) (not (vl-position (ssname sss2 in) clst)))
                (setq clst (cons (ssname sss2 in) clst))
              )
            )
            (if sss2
              (nexplode sss2)
            )
          )
        )
      )
    )
  )
  (repeat (setq i (sslength ss1))
    (setq bl (ssname ss1 (setq i (1- i))))
    (setq bp (cdr (assoc 10 (entget bl))))
    (setq c (car-sort clst '(lambda ( a b ) (<= (distance bp (vlax-curve-getclosestpointto a bp)) (distance bp (vlax-curve-getclosestpointto b bp))))))
    (setq lil (cons (list bp (vlax-curve-getclosestpointto c bp)) lil))
  )
  (while (setq el (entnext el))
    (if (and el (not (vlax-erased-p el)))
      (entdel el)
    )
  )
  (foreach li lil
    (entmake (list '(0 . "LINE") (cons 10 (car li)) (cons 11 (cadr li)) '(62 . 1)))
  )
  (setvar 'cmdecho cmde)
  (princ)
)

HTH., M.R.

[jtm2020hyo]

I will need to test each lisp routine and compare.

So I need a time before answer to everyone.

For now I can just says thank for your help boys.

[marko_ribar]

@jtm2020hyo

I have mistake in my first code : You have to replace complete (nexplode) sub function from my second code to my first code... Then it should perform as desired - that's why I said it's lightly tested... My second code is fine IMHO...

Thanks for understanding...

M.R.

[jtm2020hyo]

@marko_ribar @dbhunia @ronjonp
hello friends.
I was testing all your lisp and I found that all lisp works with my drawings.
So I will keep testing. If none give me errors I will mark all your lisp as a SOLUTION.

[Kent1Cooper]

---

@jtm2020hyo wrote:

... to connect selected blocks .... to any nearest block of the selected blocks. ....

---

That makes it sound like the Circle in your image is a Block, not just a Circle, and that it is among the selected Blocks.  But some of those smaller Blocks are closer to points on other smaller Blocks  than they are to the Circle:

Also, if the Circle is one of the selected Blocks, shouldn't there also be a red line from its  insertion point to the nearest point on one of the other Blocks?  [If  its insertion point is at its center, that would be to the smaller Block that's inside it.]

So I'm wondering:  Do you really want to connect each Block's insertion point to the closest point on any other Block  [my yellow lines], as your description  suggests?  Or do you want one thing selected as a "target"  [the Circle here, whether or not it's a Block], and to connect the other Blocks to the nearest point on that [your red lines], as your image  suggests?

[jtm2020hyo]

@Kent1Cooper @marko_ribar @dbhunia @ronjonp

hello friends.
I was testing all the routines posted in this post.

All routines work perfectly with regular blocks, but I found the same problem in all routines. all routines do not work with Dynamic Blocks.
here attached the file where I was testing.

So. Thanks to everyone for your help.

PD: routines should ignore any TEXT, MTEXT, RTEXT, DTEXT or Attributes.

 

[marko_ribar]

Assuming that you only want to connect dynamic blocks to all curves free or belonging normal blocks, try this mod...

BTW. It's so sloow that I even haven't waited to see testing results, but I suppose that the code is now fine - suit your needs...

(defun c:conndynblks2neacurves ( / car-sort nexplode cmde ss1 ss2 el s2 i bl sss2 in clst bp c lil ssn2 bln sssn2 inn )

  (vl-load-com)

  ;;; (car-sort '(2 4 1 3 5 1) '<) => nil
  ;;; (car-sort '(2 4 1 3 5 1) '<=) => 1
  (defun car-sort ( l f / removenth r k )

    (defun removenth ( l n / k )
      (setq k -1)
      (vl-remove-if '(lambda ( x ) (= (setq k (1+ k)) n)) l)
    )

    (setq k -1)
    (vl-some '(lambda ( a ) (setq k (1+ k)) (if (vl-every '(lambda ( x ) (apply f (list a x))) (removenth l k)) (setq r a))) l)
    r
  )

  (defun nexplode ( sss2 )
    (cond
      ( (and
          sss2
          (sssetfirst nil sss2)
          (setq ssn2 (ssget "_I" '((0 . "INSERT"))))
          (sssetfirst nil nil)
        )
        (repeat (setq in (sslength sss2))
          (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (ssname sss2 (setq in (1- in))))))) (not (vl-position (ssname sss2 in) clst)))
            (setq clst (cons (ssname sss2 in) clst))
          )
        )
        (foreach bln (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssn2)))
          (if (= (vla-get-isxref (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (entget bln))))) :vlax-false)
            (progn
              (vl-cmdf "_.EXPLODE" bln)
              (while (< 0 (getvar 'cmdactive))
                (vl-cmdf "")
              )
              (setq sssn2 (ssget "_P"))
              (repeat (setq inn (sslength sssn2))
                (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (ssname sssn2 (setq inn (1- inn))))))) (not (vl-position (ssname sssn2 inn) clst)))
                  (setq clst (cons (ssname sssn2 inn) clst))
                )
              )
              (if sssn2
                (nexplode sssn2)
              )
            )
          )
        )
      )
      ( (and
          sss2
          (sssetfirst nil sss2)
          (not (setq ssn2 (ssget "_I" '((0 . "INSERT")))))
          (sssetfirst nil nil)
        )
        (repeat (setq in (sslength sss2))
          (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (ssname sss2 (setq in (1- in))))))) (not (vl-position (ssname sss2 in) clst)))
            (setq clst (cons (ssname sss2 in) clst))
          )
        )
      )
    )
  )

  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (while
    (or
      (prompt "\nSelect dynamic blocks you want to connect...")
      (not (setq ss1 (ssget '((0 . "INSERT") (2 . "`*U*")))))
    )
    (prompt "\nEmpty sel. set... Retry selecting blocks you want to connect...")
  )
  (while
    (or
      (prompt "\nSelect entities you want to connect to - all except dynamic blocks...")
      (not (setq ss2 (ssget "_:L" '((-4 . "<not") (-4 . "<and") (0 . "INSERT") (2 . "`*U*") (-4 . "and>") (-4 . "not>")))))
    )
    (prompt "\nEmpty sel. set... Retry selecting entities you want to connect to on unlocked layer(s)...")
  )
  (if (= 8 (logand 8 (getvar 'undoctl)))
    (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
  )
  (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
  (setq el (entlast) s2 (ssadd))
  (repeat (setq i (sslength ss2))
    (ssadd (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object (ssname ss2 (setq i (1- i)))))) s2)
  )
  (repeat (setq i (sslength s2))
    (setq bl (ssname s2 (setq i (1- i))))
    (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list bl))))
      (if (not (vl-position bl clst))
        (setq clst (cons bl clst))
      )
      (if (= (cdr (assoc 0 (entget bl))) "INSERT")
        (if (= (vla-get-isxref (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (entget bl))))) :vlax-false)
          (progn
            (vl-cmdf "_.EXPLODE" bl)
            (while (< 0 (getvar 'cmdactive))
              (vl-cmdf "")
            )
            (setq sss2 (ssget "_P"))
            (repeat (setq in (sslength sss2))
              (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (ssname sss2 (setq in (1- in))))))) (not (vl-position (ssname sss2 in) clst)))
                (setq clst (cons (ssname sss2 in) clst))
              )
            )
            (if sss2
              (nexplode sss2)
            )
          )
        )
      )
    )
  )
  (repeat (setq i (sslength ss1))
    (setq bl (ssname ss1 (setq i (1- i))))
    (setq bp (cdr (assoc 10 (entget bl))))
    (setq c (car-sort clst '(lambda ( a b ) (<= (distance bp (vlax-curve-getclosestpointto a bp)) (distance bp (vlax-curve-getclosestpointto b bp))))))
    (setq lil (cons (list bp (vlax-curve-getclosestpointto c bp)) lil))
  )
  (while (setq el (entnext el))
    (if (and el (not (vlax-erased-p el)))
      (entdel el)
    )
  )
  (foreach li lil
    (entmake (list '(0 . "LINE") (cons 10 (car li)) (cons 11 (cadr li)) '(62 . 1)))
  )
  (setvar 'cmdecho cmde)
  (princ)
)

HTH., M.R.

[ronjonp]

---

@jtm2020hyo wrote:

@Kent1Cooper @marko_ribar @dbhunia @ronjonp

hello friends.
I was testing all the routines posted in this post.

All routines work perfectly with regular blocks, but I found the same problem in all routines. all routines do not work with Dynamic Blocks.
here attached the file where I was testing.

So. Thanks to everyone for your help.

PD: routines should ignore any TEXT, MTEXT, RTEXT, DTEXT or Attributes.

 

---

FWIW you really should originally post a sample drawing closer to reality of what you want. Your original 'sample' file is nothing like the latest. Your first drawing is all blocks but this one is now dynamic blocks and that need to find the closest distance to polylines?

You also might want to cleanup the names of the blocks for your visibility states:

[jtm2020hyo]

---

@ronjonp wrote:

---

@jtm2020hyo wrote:

@Kent1Cooper @marko_ribar @dbhunia @ronjonp

hello friends.
I was testing all the routines posted in this post.

All routines work perfectly with regular blocks, but I found the same problem in all routines. all routines do not work with Dynamic Blocks.
here attached the file where I was testing.

So. Thanks to everyone for your help.

PD: routines should ignore any TEXT, MTEXT, RTEXT, DTEXT or Attributes.

 

---

FWIW you really should originally post a sample drawing closer to reality of what you want. Your original 'sample' file is nothing like the latest. Your first drawing is all blocks but this one is now dynamic blocks and that need to find the closest distance to polylines?

You also might want to cleanup the names of the blocks for your visibility states:

---

I attached drawing I need to connect the DYNAMIC block named "#tableros" to the biggest block (full of polylines).
since insert point to any nearest point from selected block. I need to ignore all *text or attributes.

[jtm2020hyo]

---

@dbhunia wrote:

Try this.......Lightly tested.....

---

hello friend. your lisp code works with dynamic block. but connect with selected block with 45 degrees Line.

 attached file where is tested your lisp here below

thanks for your help.

[jtm2020hyo]

---

@marko_ribar wrote:

Assuming that you only want to connect dynamic blocks to all curves free or belonging normal blocks, try this mod...

BTW. It's so sloow that I even haven't waited to see testing results, but I suppose that the code is now fine - suit your needs...

(defun c:conndynblks2neacurves ( / car-sort nexplode cmde ss1 ss2 el s2 i bl sss2 in clst bp c lil ssn2 bln sssn2 inn )

  (vl-load-com)

  ;;; (car-sort '(2 4 1 3 5 1) '<) => nil
  ;;; (car-sort '(2 4 1 3 5 1) '<=) => 1
  (defun car-sort ( l f / removenth r k )

    (defun removenth ( l n / k )
      (setq k -1)
      (vl-remove-if '(lambda ( x ) (= (setq k (1+ k)) n)) l)
    )

    (setq k -1)
    (vl-some '(lambda ( a ) (setq k (1+ k)) (if (vl-every '(lambda ( x ) (apply f (list a x))) (removenth l k)) (setq r a))) l)
    r
  )

  (defun nexplode ( sss2 )
    (cond
      ( (and
          sss2
          (sssetfirst nil sss2)
          (setq ssn2 (ssget "_I" '((0 . "INSERT"))))
          (sssetfirst nil nil)
        )
        (repeat (setq in (sslength sss2))
          (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (ssname sss2 (setq in (1- in))))))) (not (vl-position (ssname sss2 in) clst)))
            (setq clst (cons (ssname sss2 in) clst))
          )
        )
        (foreach bln (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssn2)))
          (if (= (vla-get-isxref (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (entget bln))))) :vlax-false)
            (progn
              (vl-cmdf "_.EXPLODE" bln)
              (while (< 0 (getvar 'cmdactive))
                (vl-cmdf "")
              )
              (setq sssn2 (ssget "_P"))
              (repeat (setq inn (sslength sssn2))
                (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (ssname sssn2 (setq inn (1- inn))))))) (not (vl-position (ssname sssn2 inn) clst)))
                  (setq clst (cons (ssname sssn2 inn) clst))
                )
              )
              (if sssn2
                (nexplode sssn2)
              )
            )
          )
        )
      )
      ( (and
          sss2
          (sssetfirst nil sss2)
          (not (setq ssn2 (ssget "_I" '((0 . "INSERT")))))
          (sssetfirst nil nil)
        )
        (repeat (setq in (sslength sss2))
          (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (ssname sss2 (setq in (1- in))))))) (not (vl-position (ssname sss2 in) clst)))
            (setq clst (cons (ssname sss2 in) clst))
          )
        )
      )
    )
  )

  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (while
    (or
      (prompt "\nSelect dynamic blocks you want to connect...")
      (not (setq ss1 (ssget '((0 . "INSERT") (2 . "`*U*")))))
    )
    (prompt "\nEmpty sel. set... Retry selecting blocks you want to connect...")
  )
  (while
    (or
      (prompt "\nSelect entities you want to connect to - all except dynamic blocks...")
      (not (setq ss2 (ssget "_:L" '((-4 . "<not") (-4 . "<and") (0 . "INSERT") (2 . "`*U*") (-4 . "and>") (-4 . "not>")))))
    )
    (prompt "\nEmpty sel. set... Retry selecting entities you want to connect to on unlocked layer(s)...")
  )
  (if (= 8 (logand 8 (getvar 'undoctl)))
    (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
  )
  (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
  (setq el (entlast) s2 (ssadd))
  (repeat (setq i (sslength ss2))
    (ssadd (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object (ssname ss2 (setq i (1- i)))))) s2)
  )
  (repeat (setq i (sslength s2))
    (setq bl (ssname s2 (setq i (1- i))))
    (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list bl))))
      (if (not (vl-position bl clst))
        (setq clst (cons bl clst))
      )
      (if (= (cdr (assoc 0 (entget bl))) "INSERT")
        (if (= (vla-get-isxref (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (entget bl))))) :vlax-false)
          (progn
            (vl-cmdf "_.EXPLODE" bl)
            (while (< 0 (getvar 'cmdactive))
              (vl-cmdf "")
            )
            (setq sss2 (ssget "_P"))
            (repeat (setq in (sslength sss2))
              (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (ssname sss2 (setq in (1- in))))))) (not (vl-position (ssname sss2 in) clst)))
                (setq clst (cons (ssname sss2 in) clst))
              )
            )
            (if sss2
              (nexplode sss2)
            )
          )
        )
      )
    )
  )
  (repeat (setq i (sslength ss1))
    (setq bl (ssname ss1 (setq i (1- i))))
    (setq bp (cdr (assoc 10 (entget bl))))
    (setq c (car-sort clst '(lambda ( a b ) (<= (distance bp (vlax-curve-getclosestpointto a bp)) (distance bp (vlax-curve-getclosestpointto b bp))))))
    (setq lil (cons (list bp (vlax-curve-getclosestpointto c bp)) lil))
  )
  (while (setq el (entnext el))
    (if (and el (not (vlax-erased-p el)))
      (entdel el)
    )
  )
  (foreach li lil
    (entmake (list '(0 . "LINE") (cons 10 (car li)) (cons 11 (cadr li)) '(62 . 1)))
  )
  (setvar 'cmdecho cmde)
  (princ)
)

HTH., M.R.

---

hello friend. I was testing your code. I found that your code explode my biggest block.
can you modify to use your code with dynamic blocks and not explode blocks.

file tested attached below.
thanks for your help.

[jtm2020hyo]

---

@Kent1Cooper wrote:

---

@jtm2020hyo wrote:

... to connect selected blocks .... to any nearest block of the selected blocks. ....

---

That makes it sound like the Circle in your image is a Block, not just a Circle, and that it is among the selected Blocks.  But some of those smaller Blocks are closer to points on other smaller Blocks  than they are to the Circle:

Also, if the Circle is one of the selected Blocks, shouldn't there also be a red line from its  insertion point to the nearest point on one of the other Blocks?  [If  its insertion point is at its center, that would be to the smaller Block that's inside it.]

So I'm wondering:  Do you really want to connect each Block's insertion point to the closest point on any other Block  [my yellow lines], as your description  suggests?  Or do you want one thing selected as a "target"  [the Circle here, whether or not it's a Block], and to connect the other Blocks to the nearest point on that [your red lines], as your image  suggests?

---

sorry for my bad English

I need to selected blocks (A) to connect to others selected blocks (B) since insert point (A) to the nearest point  (B)

other options or opinions are well received.
thanks for your help.

[jtm2020hyo]

---

@ronjonp wrote:

---

@jtm2020hyo wrote:

@Kent1Cooper @marko_ribar @dbhunia @ronjonp

hello friends.
I was testing all the routines posted in this post.

All routines work perfectly with regular blocks, but I found the same problem in all routines. all routines do not work with Dynamic Blocks.
here attached the file where I was testing.

So. Thanks to everyone for your help.

PD: routines should ignore any TEXT, MTEXT, RTEXT, DTEXT or Attributes.

 

---

FWIW you really should originally post a sample drawing closer to reality of what you want. Your original 'sample' file is nothing like the latest. Your first drawing is all blocks but this one is now dynamic blocks and that need to find the closest distance to polylines?

You also might want to cleanup the names of the blocks for your visibility states:

---

In attached file I need to connect rectangles block (dynamic block) to the block with arcs and lines (regular block)

But I need in your code to connect dynamic blocks with others dynamic blocks.

I was testing your code with my attached file. I converted my dynamic block to regular block and use your lisp. I found that your code explodes my large block. 

your code work good with few regular blocks.

It was an honor to test your code.

thanks for your help.

 

[dbhunia]

I considered to draw the line along the direction of the line passing through the insertion points of the both blocks.......

if you check the code with other blocks you will get it ......

[marko_ribar]

OK, now it shouldn't explode your blocks, I just have no time to test it on my PC... Mind that you still have many entities to process, so all I can say is be patient... When asked for selections type on both prompts "all" and wait and cross your fingers to get what you want...

(defun c:conndynblks2neacurves ( / car-sort elst->ss nexplode cmde ss1 ss2 el s2 i bl sss2 in clst bp c lil ssn2 bln sssn2 inn )

  (vl-load-com)

  ;;; (car-sort '(2 4 1 3 5 1) '<) => nil
  ;;; (car-sort '(2 4 1 3 5 1) '<=) => 1
  (defun car-sort ( l f / removenth r k )

    (defun removenth ( l n / k )
      (setq k -1)
      (vl-remove-if '(lambda ( x ) (= (setq k (1+ k)) n)) l)
    )

    (setq k -1)
    (vl-some '(lambda ( a ) (setq k (1+ k)) (if (vl-every '(lambda ( x ) (apply f (list a x))) (removenth l k)) (setq r a))) l)
    r
  )

  (defun elst->ss ( lst / qq )
    (setq qq (ssadd))
    (foreach e lst
      (ssadd e qq)
    )
    qq
  )

  (defun nexplode ( sss2 )
    (cond
      ( (and
          sss2
          (sssetfirst nil (elst->ss sss2))
          (setq ssn2 (ssget "_I" '((0 . "INSERT"))))
          (sssetfirst nil nil)
        )
        (repeat (setq in (length sss2))
          (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (nth (setq in (1- in)) sss2))))) (not (vl-position (nth in sss2) clst)))
            (setq clst (cons (nth in sss2) clst))
          )
        )
        (foreach bln (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssn2)))
          (if (= (vla-get-isxref (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (entget bln))))) :vlax-false)
            (progn
              (setq sssn2 (vlax-invoke (vlax-ename->vla-object bln) 'explode))
              (setq sssn2 (mapcar 'vlax-vla-object->ename sssn2))
              (repeat (setq inn (length sssn2))
                (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (nth (setq inn (1- inn)) sssn2))))) (not (vl-position (nth inn sssn2) clst)))
                  (setq clst (cons (nth inn sssn2) clst))
                )
              )
              (if sssn2
                (nexplode sssn2)
              )
            )
          )
        )
      )
      ( (and
          sss2
          (sssetfirst nil (elst->ss sss2))
          (not (setq ssn2 (ssget "_I" '((0 . "INSERT")))))
          (sssetfirst nil nil)
        )
        (repeat (setq in (length sss2))
          (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (nth (setq in (1- in)) sss2))))) (not (vl-position (nth in sss2) clst)))
            (setq clst (cons (nth in sss2) clst))
          )
        )
      )
    )
  )

  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (while
    (or
      (prompt "\nSelect dynamic blocks you want to connect...")
      (not (setq ss1 (ssget '((0 . "INSERT") (2 . "`*U*")))))
    )
    (prompt "\nEmpty sel. set... Retry selecting blocks you want to connect...")
  )
  (while
    (or
      (prompt "\nSelect entities you want to connect to - all except dynamic blocks...")
      (not (setq ss2 (ssget "_:L" '((-4 . "<not") (-4 . "<and") (0 . "INSERT") (2 . "`*U*") (-4 . "and>") (-4 . "not>")))))
    )
    (prompt "\nEmpty sel. set... Retry selecting entities you want to connect to on unlocked layer(s)...")
  )
  (if (= 8 (logand 8 (getvar 'undoctl)))
    (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
  )
  (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
  (setq el (entlast) s2 (ssadd))
  (repeat (setq i (sslength ss2))
    (ssadd (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object (ssname ss2 (setq i (1- i)))))) s2)
  )
  (repeat (setq i (sslength s2))
    (setq bl (ssname s2 (setq i (1- i))))
    (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list bl))))
      (if (not (vl-position bl clst))
        (setq clst (cons bl clst))
      )
      (if (= (cdr (assoc 0 (entget bl))) "INSERT")
        (if (= (vla-get-isxref (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (entget bl))))) :vlax-false)
          (progn
            (setq sss2 (vlax-invoke (vlax-ename->vla-object bl) 'explode))
            (setq sss2 (mapcar 'vlax-vla-object->ename sss2))
            (repeat (setq in (length sss2))
              (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list (nth (setq in (1- in)) sss2))))) (not (vl-position (nth in sss2) clst)))
                (setq clst (cons (nth in sss2) clst))
              )
            )
            (if sss2
              (nexplode sss2)
            )
          )
        )
      )
    )
  )
  (repeat (setq i (sslength ss1))
    (setq bl (ssname ss1 (setq i (1- i))))
    (setq bp (cdr (assoc 10 (entget bl))))
    (setq c (car-sort clst '(lambda ( a b ) (<= (distance bp (vlax-curve-getclosestpointto a bp)) (distance bp (vlax-curve-getclosestpointto b bp))))))
    (setq lil (cons (list bp (vlax-curve-getclosestpointto c bp)) lil))
  )
  (while (setq el (entnext el))
    (if (and el (not (vlax-erased-p el)))
      (entdel el)
    )
  )
  (foreach li lil
    (entmake (list '(0 . "LINE") (cons 10 (car li)) (cons 11 (cadr li)) '(62 . 1)))
  )
  (setvar 'cmdecho cmde)
  (princ)
)

Regards, M.R.

[marko_ribar]

Actually I think there is one lack in the code - this :

...

(defun nexplode ( sss2 )

...

should be :

...

(defun nexplode ( sss2 / sssn2 )

...

So, replace it and test again... I still didn't get results, but I think that with this revision, should work as expected...