Edit LISP to find geometric center and ignore duplicates in a list.

[osayed643PD]

Hi, I am still in the process of learning AUTOLISP, and would like to edit some script.  Recently I asked a question and someone gave me this code which I am grateful for. but I have been trying to edit it for the past few days.

basically it selects a polyline, finds intersection points with the polyline and selected objects, then places text at points of intersection

the problem is 

1- many times the polyline intersects twice with an object, so it places two text objects

2-  the text should be at the geometric center of the polyline or block if necessary to transform it.

i really have tried and it was too complex for my level .. any help would be truly appreciated.

(vl-load-com)

(defun c:IntersNumbering ( / LM:intersections p s l o z e)
  
  (or *in-n* (setq *in-n* 0))
  
  ;; Intersections  -  Lee Mac ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode.
  ;; ob1,ob2 - [vla] VLA-Objects ;;     mod - [int] acextendoption enum of intersectwith method
  
  (defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if
      (and
	(vlax-method-applicable-p ob1 'intersectwith)

	(vlax-method-applicable-p ob2 'intersectwith)

	(setq lst (vlax-invoke ob1 'intersectwith ob2 mod)
	      )
	     )
      (repeat
	(/ (length lst) 3)
	(setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
	      lst (cdddr lst))))
    (reverse rtn))
  
  ; ======================================================================================================
  
  
  (if (and (setq p (car (entsel "\nSelect a polyline: ")
			              );car
		        );setq
	   (princ "Select intersecting polylines and blocks, ")
	   
	   (setq s (ssget '((0 . "LWPOLYLINE,LINE,INSERT")))) 
	   (or (ssdel p s) t)
	   (setq *in-n* (cond ((setq f (getint (strcat "\nStart with <" (itoa (1+ *in-n*)) ">: ")))
			       (1- f))
			      (*in-n*)))
	   
	   (setq o (vlax-ename->vla-object p))
	   (setq l '()
		 z (getvar 'textsize))
	   );and
    (repeat (setq i (sslength s))
      (setq e (vlax-ename->vla-object (ssname s (setq i (1- i))))
	    l (append (LM:intersections o e acextendnone) l))))
  
  (and l
       (setq l (vl-sort l '(lambda (p1 p2) (< (vlax-curve-getdistatpoint p p1) (vlax-curve-getdistatpoint p p2)))))
       (foreach p l (entmake (list (cons 0 "TEXT") (cons 10 p) (cons 40 z) (cons 1 (itoa (setq *in-n* (1+ *in-n*))))))))
  
  (princ)
  )

[osayed643PD]

here is a sample, the rectangles are the objects that I want to label at the geometric center. the line crossing them is the direction of sorting of the numbering.

[ВeekeeCZ · Accepted solution]

I see that you have probably progressed to the next page in your learning since you were able to figure out that the programmer needs to have a dwg file available. Thumbs up!

So I was able to test the code below on your file and it works fine.

(vl-load-com)

(defun c:IntersNumbering ( / LM:intersections p s l o z e x g)
  
  (or *in-n* (setq *in-n* 0))
  
  ;; Intersections  -  Lee Mac ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode.
  ;; ob1,ob2 - [vla] VLA-Objects ;;     mod - [int] acextendoption enum of intersectwith method
  
  (defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
	     (vlax-method-applicable-p ob2 'intersectwith)
	     (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
	     )
      (repeat (/ (length lst) 3)
	(setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
	      lst (cdddr lst))))
    (reverse rtn))
  
  ; ======================================================================================================
  
  
  (if (and (setq p (car (entsel "\nSelect a polyline: ")))
	   (princ "Select intersecting polylines and blocks, ")
	   (setq s (ssget '((0 . "LWPOLYLINE,LINE,INSERT"))))
	   (or (ssdel p s) t)
	   (setq *in-n* (cond ((setq f (getint (strcat "\nStart with <" (itoa (1+ *in-n*)) ">: ")))
			       (1- f))
			      (*in-n*)))
	   
	   (setq o (vlax-ename->vla-object p))
	   (setq z (getvar 'textsize))
	   )
    (repeat (setq i (sslength s))
      (setq e (vlax-ename->vla-object (ssname s (setq i (1- i)))))
      (if (and (setq x (LM:intersections o e acextendnone))
	       (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list e 'll 'ur))))
	       (setq g (mapcar '/ (apply 'mapcar (cons '+ (mapcar 'vlax-safearray->list (list ll ur)))) '(2 2)))
	       )
	(setq l (cons (list (car x) g) l)))))
  
  (and l
       (setq l (vl-sort l '(lambda (p1 p2) (< (vlax-curve-getdistatpoint p (car p1)) (vlax-curve-getdistatpoint p (car p2))))))
       (foreach p l (entmake (list (cons 0 "TEXT") (cons 10 (cadr p)) (cons 40 z) (cons 1 (itoa (setq *in-n* (1+ *in-n*))))))))
  
  (princ)
  )

[osayed643PD]

Hi thanks for your encouragement, and I really appreciate your effort. 

but the script you just sent doesn't work on my files or the file provided, no output and no errors. The previous one did work though.

[osayed643PD]

Hi again, I restarted AutoCAD and it works. Thank you kind genius.