Associate entity with item to base point

[adaptacad]

Hello again guys, I've been trying to solve this problem for a few hours.
My goal is to NUMBER THE BLOCKS BY PROXIMITY.
I found in this >>link<< an example that the alto draws a polyline interconnecting the nearest blocks, my goal is to look like it, changing only that
I want to increment the attributes of the blocks (1,2,3,4 ....).

If someone can help me I will be very grateful, I thank you in advance.

(defun c:nbp ( )
  (defun :closer (a b c)(< (distance a b)(distance a c)))
  (if (and (setq sel (ssget '((0 . "INSERT")))) (setq pnt (car (entsel "\nSelect the starting point: "))))    
    (progn
      (foreach ent	(vl-remove-if 'listp (mapcar 'cadr (ssnamex sel)))
        (setq obj (vlax-ename->vla-object ent))
        (setq lst (cons (setq pnt (vlax-get obj 'insertionpoint)) lst))
      );for
      (setq rte (list pnt))
      (while lst
        (setq pnt (car (vl-sort lst '(lambda (x y)(:closer pnt x y)))))
        (setq lst (vl-remove pnt lst))
        (setq rte (cons pnt rte)) ;;t
      );;While
      ; (vl-cmdf "_.pline")
      ; (mapcar 'vl-cmdf (reverse rte))
      ; (vl-cmdf "")
    );progn
  );if
)

[CodeDing]

@adaptacad ,

---

@adaptacad wrote:

My goal is to NUMBER THE BLOCKS BY PROXIMITY.

I want to increment the attributes of the blocks (1,2,3,4 ....).

---

This sounds familiar. I remember @ronjonp  once wrote a very cool function that does this:

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/i-can-t-find-out-my-problem-in-this-... 

Maybe that can help get you on the right track!

Best,

~DD

[pbejse]

---

@adaptacad wrote:

I want to increment the attributes of the blocks (1,2,3,4 ....).

If someone can help me I will be very grateful, I thank you in advance.

---

You're saying the blocks doesnt have a number to start with? or regardless of the number it will be replace with whatever or wherver the user select as a starting point? and you dont really need the pline YES?

And if its a circle insert a text?

[adaptacad]

Hello @CodeDing  I will study the code, thank you very much.

[adaptacad]

@pbejse  Thank you very much
The starting number would be the block I selected.
I don't need to pline.
It will never be a circle, it will always be an assigned block.

[hak_vz]

---

@adaptacad wrote:

The starting number would be the block I selected. I don't need to pline. It will never be a circle, it will always be an assigned block.

---

(defun c:nbp_hak_vz ( /  *error* adoc take ss elist e ent pt el conlist pel cnt i)
	;Author:  hak_vz 
	;Wednesday, September 22, 2021
	;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
	;Posted at 
	;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/associate-entity-with-item-to-base-point/td-p/10639880
	;Connects block to next nearest block and and increment value of attribute number

	(vl-load-com)
	(defun *error* ( msg )
		(if (not (member msg '("Function cancelled" "quit / exit abort")))
			(princ)
		)
		(if elist (foreach e elist (entdel e)))
		(setq elist nil)
		(if (and adoc) (vla-endundomark adoc))
		(princ)
	)
	(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
	
	(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
	(vla-endundomark adoc)
	(vla-startundomark adoc)
	(setq ss (ssget '((0 . "INSERT"))) i -1)
	(cond 
		((and ss (>= (sslength ss) 2))
			(while (< (setq i (1+ i)) (sslength ss))
				(setq e (ssname ss i))
				(setq ent (entget e))
				(setq elist (cons (list (cdr (assoc 10 ent)) e) elist))
			)
			
			(cond 
				((and (setq pt (getpoint "\nSelect starting point >")))
					(setq elist (vl-sort elist '(lambda (x y) (< (distance (car x) pt)(distance (car y) pt)))))
					(setq e (car elist))
					(setq pt (take 2 (car e)) el (cadr e))
					(setq cnt (atoi(getpropertyvalue el "Number")))
					(setq conlist pt)
					(command "_.pline" pt pt "")
					(setq pel (vlax-ename->vla-object (entlast)))
					(while (and (setq elist (cdr elist)) (>= (length elist) 2))
						(setq elist (vl-sort elist '(lambda (x y) (< (distance (car x) pt)(distance (car y) pt)))))
						(setq e (car elist))
						(setq pt (take 2 (car e)) el (cadr e))
						(setq conlist (append conlist pt))
						(setpropertyvalue el "Number" (itoa(setq cnt (1+ cnt))))
					)
					(setq e (car elist))
					(setq pt (take 2 (car e)) el (cadr e))
					(setpropertyvalue el "Number" (itoa(setq cnt (1+ cnt))))
					(setq conlist (append conlist pt))
					(vlax-put pel 'Coordinates conlist)
					(vla-update pel)
				)
			)
		)
		(T (princ "\nNeed at least two blocks to join!!!"))
	)
	(vla-endundomark adoc)
(princ)
)

 If you don't need pline you can comment it.

[pbejse · Accepted solution]

---

@adaptacad wrote:

@pbejse  Thank you very much
The starting number would be the block I selected.
I don't need to pline.
It will never be a circle, it will always be an assigned block.

---

This is still based on the algo from the link and the code  at post # 1

(defun c:nbp (/ :closer _Ipt el inc plist)
  (defun :closer (a b c) (< (distance a b) (distance a c)))
  (defun _Ipt (o) (cdr (assoc 10 (entget o))))
  (if (and (setq el (ssget '((0 . "INSERT") (66 . 1))))
	   (setq pnt (car (entsel "\nSelect the starting point: "))
	   )
      )
    (progn
      (repeat (setq i (sslength el))
	(setq e (ssname el (setq i (1- i))))
	(setq plist (cons (list (_Ipt e) e) plist))
      )
      (setq p	(_Ipt pnt)
	    inc	1
      )
      (while plist
	(setq pnt
	       (car (vl-sort plist
			     '(lambda (x y) (:closer p (Car x) (car y)))
		    )
	       )
	)
	(setq plist (vl-remove pnt plist))
	(setpropertyvalue (Cadr pnt) "NUMBER" (itoa inc))
	(setq p	  (car pnt)
	      inc (1+ inc)
	)
      )
    )
  )
  (princ)
)

Command: nbp

HTH

EDITED: Removed unecessary variables and while function at the end of the code

[ronjonp · Accepted solution]

Here's another to try, written specifically for that block:

(defun c:foo (/ e n p s x)
  ;; RJP » 2021-09-22
  ;; Number blocks with attribute tag 'NUMBER'
  (cond	((and (setq e (car (entsel "\nPick a block to start numbering from: ")))
	      (setq p (cdr (assoc 10 (entget e))))
	      (= 'str (type (setq n (vl-catch-all-apply 'getpropertyvalue (list e "NUMBER")))))
	      (setq s (ssget ":L" (list (assoc 0 (entget e)) (assoc 2 (entget e)))))
	 )
	 (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
	 (setq s (mapcar '(lambda (x) (list x (cdr (assoc 10 (entget x))))) s))
	 (and (= 0 (setq n (atoi n))) (setq n 1))
	 (while	(car s)
	   (setq s (mapcar '(lambda (x) (list (car x) (cadr x) (distance p (cadr x)))) s))
	   (setq s (vl-sort s '(lambda (r j) (< (last r) (last j)))))
	   (setpropertyvalue (caar s) "NUMBER" (vl-princ-to-string n))
	   (setq n (1+ n))
	   (setq s (cdr s))
	   (setq p (cadr (car s)))
	 )
	)
  )
  (princ)
)

[adaptacad]

Wow!!! you are the best!! thank you very much @ronjonp  and @pbejse  worked perfectly!!!!

[ronjonp]

---

@adaptacad wrote:

Wow!!! you are the best!! thank you very much @ronjonp  and @pbejse  worked perfectly!!!!

---

Glad to help 🙂

[hak_vz]

@adaptacadI'm so sorry for being too lazy to read through all the posts to apply changes you came after you posted your request. I have written the code according to your initial post, when there was no other requests.

At the time I posted it I've noticed all the changes you've wished. I have added option to start counting with attribute value of selected block but didn't have time to remove polyline creation. Next time in your sample you should have state before and after the code runs. It's not your first post to this forum.

To remove polyline creation it just needs placing" ;" in front off

; (setq conlist pt)
; (command "_.pline" pt pt "")
; ...
; (setq conlist (append conlist pt))
; ...
; (setq conlist (append conlist pt))
; (vlax-put pel 'Coordinates conlist)