How to find and select the nearest block to a point

GREETINGS EVERYONE

I need a lisp that find and select the nearest bock named "ManHole" to a point

.... this point is the insertion point of another selected block

say i select a block named "trench" at some point at the drawing ... then the lisp will search its surroundings for a block named "ManHole" and select/highlight the nearest one

any help will be appreciated

thanks in advance

Just pick the 1st block get its insertion point, then make a selection set of the other block and repeat through the slection point using distance ins1 ins2 keep the name of the entity which is minimum, with the selection set use a manual window so makes the search faster no need to pick the obvious way out there blocks.

Here is an example

(defun c:test ( / ent obj ins1 ins2 dist ss olddist)
(setq ent (car (entsel "pick 1st block")))
(setq obj (vlax-ename->vla-object ent))
(setq ins1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj))))
(setq blname (vla-get-name (vlax-ename->vla-object (car (entsel "pick 2nd block")))))
(setq ss (ssget (list (cons 0 "Insert")(cons 2 blname))))
(setq oldist 0.0)
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq ins2 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj))))
(Setq dist (distance ins1 ins2))
(if (< olddist dist)
(princ)
(progn
(setq olddist dist)
(setq handel (vla-get-handle obj))
)
)
(alert (strcat "distance is " (rtos olddist 2 2)))
)
)

Aywa ya handasa.

Try this routine and let me know.

(defun c:Test ( / blk s e ss p i sn en pt d new )
 ;; Tharwat - Date: 09.May.2017	;;
 (setq blk "ManHole") ;; [ ManHole ] = Regular block (not a Dynamic)	;;
 (if (and (setq s (car (entsel "\nPick base Block :")))
          (eq (cdr (assoc 0 (setq e (entget s)))) "INSERT")
          (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blk) (cons 410 (getvar 'CTAB)))))
          (setq p (cdr (assoc 10 e)))
          )
   (repeat (setq i (sslength ss))
     (setq sn (ssname ss (setq i (1- i)))
           en (entget sn)
           pt (cdr (assoc 10 en))
           )
     (cond ((not d) (setq d (list (distance p pt) sn)))
           ((< (setq new (distance p pt)) (car d)) (setq d (list new sn))))
     )
   )
 (if d (sssetfirst nil (ssadd (cadr d))))
 (princ)
 )

Just pick the 1st block get its insertion point, then make a selection set of the other block and repeat through the slection point using distance ins1 ins2 keep the name of the entity which is minimum, with the selection set use a manual window so makes the search faster no need to pick the obvious way out there blocks.

 

Here is an example

(defun c:test ( / ent obj ins1 ins2 dist ss olddist)
(setq ent (car (entsel "pick 1st block")))
(setq obj (vlax-ename->vla-object ent))
(setq ins1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj))))
(setq blname (vla-get-name (vlax-ename->vla-object (car (entsel "pick 2nd block")))))
(setq ss (ssget (list (cons 0 "Insert")(cons 2 blname))))
(setq oldist 0.0)
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq ins2 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj))))
(Setq dist (distance ins1 ins2))
(if (< olddist dist)
(princ)
(progn
(setq olddist dist)
(setq handel (vla-get-handle obj))
)
)
(alert (strcat "distance is " (rtos olddist 2 2)))
)
)

it works well after this little modification

(defun c:manhole ( / ent obj ins1 ins2 dist ss olddist)
(setq ent (car (entsel "pick 1st block")))
(setq obj (vlax-ename->vla-object ent))
(setq ins1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj))))
(setq blname (vla-get-name (vlax-ename->vla-object (car (entsel "pick 2nd block")))))
(setq ss (ssget (list (cons 0 "Insert")(cons 2 blname))))
(setq olddist 10000)
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq ins2 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj))))
(Setq dist (distance ins1 ins2))
(if (< olddist dist)
(princ)
(progn
(setq olddist dist)
(setq handel (vla-get-handle obj))

;(setq objHandle (vla-get-handle (vlax-ename->vla-object obj)))
)
)

(setq extremes (ssadd obj))
(sssetfirst nil extremes)

(alert (strcat "distance is " (rtos olddist 2 2)))
)
)

as it shows the distance between the base block and other blocks distributed around it

but it still doesn't select/highlight the target block with minimum distance

Aywa ya handasa.

 

Try this routine and let me know.

 

(defun c:Test ( / blk s e ss p i sn en pt d new )
 ;; Tharwat - Date: 09.May.2017	;;
 (setq blk "ManHole") ;; [ ManHole ] = Regular block (not a Dynamic)	;;
 (if (and (setq s (car (entsel "\nPick base Block :")))
          (eq (cdr (assoc 0 (setq e (entget s)))) "INSERT")
          (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blk) (cons 410 (getvar 'CTAB)))))
          (setq p (cdr (assoc 10 e)))
          )
   (repeat (setq i (sslength ss))
     (setq sn (ssname ss (setq i (1- i)))
           en (entget sn)
           pt (cdr (assoc 10 en))
           )
     (cond ((not d) (setq d (list (distance p pt) sn)))
           ((< (setq new (distance p pt)) (car d)) (setq d (list new sn))))
     )
   )
 (if d (sssetfirst nil (ssadd (cadr d))))
 (princ)
 )

worked like a charm ...

thanks a lot

worked like a charm ...

thanks a lot

You're welcome.

You're welcome.

can you please extend the lisp so that it draw a line between the base block and the selected one ..

i modified it a little bit but there is some cases the lisp give me error "unknow command"

(defun c:xv ( / blk s e ss  i sn en pt d new ft p)
 ;; Tharwat - Date: 09.May.2017	;;
 (setq blk "ManHole") ;; [ ManHole ] = Regular block (not a Dynamic)	;;
 (if (and (setq s (car (entsel "\nPick base Block :")))
          (eq (cdr (assoc 0 (setq e (entget s)))) "INSERT")
          (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blk) (cons 410 (getvar 'CTAB)))))
          (setq p (cdr (assoc 10 e)))
          )
   (repeat (setq i (sslength ss))
     (setq sn (ssname ss (setq i (1- i)))
           en (entget sn)
           pt (cdr (assoc 10 en))
           )
     (cond ((not d) (setq d (list (distance p pt) sn)))
           ((< (setq new (distance p pt)) (car d)) (setq d (list new sn)
		ft pt)))
     )
   )
 (if d (sssetfirst nil (ssadd (cadr d))))
 
 
 (command "pline" p ft "")
  
 (princ)
 )

can you please extend the lisp so that it draw a line between the base block and the selected one ..

 

i modified it a little bit but there is some cases the lisp give me error "unknow command"

Like this:

(if d (progn (sssetfirst nil (ssadd (cadr d)))
              (command "_.pline" "_non" p "_non" (cdr (assoc 10 (entget (cadr d)))) "")))

I was not sure what you wanted to do so remove Alert line and just replace with (command "LIne" ins1 ins2 "')

this part in code :

 (setq blk "ManHole") ;; [ ManHole ] = Regular block (not a Dynamic)	;;

what if it's a dynamic block and it's ?

thanks in advance

A dynamic block still has a name and a insertion point.

Hello guys, thx good job with this!

Tharwat would it be possible to modify the script so I could work with multiple blocks?

Using the same block names as the OP to be clear : let's say you have a drawing with a lot of "manhole" blocks, that's what I would need

Thx.