Split and sort a pointlist

[EnM4st3r]

Hi, I made a lisp with the help of others here to extend a line to the boundarys of a closed polyline.
I tried to make a little extra change, so it creates a new line for every 2 points.
The reason of that is, so if it finds like 4,6 or more intersection points so a Line gets created between those.
Like that example:

To do that i take the points returned from LM:intersections and try to split them into 2 lists.
However this pointlist is not really sorted so the created lines get messed up sometimes.

Do you have tips for a better split-list function and how to sort that depending on the direction of the starting line?

(defun c:test123 ()
  (create-intersecting-lines (car (entsel "\nLine: ")) (car (entsel "\nPolyline: ")))
  (princ)
)

(defun create-intersecting-lines (line poly / LM:intersections split-list makeline linex splitted-lst line-list)
  
  (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)
  );defun
  
  (defun split-list (lst / i list1 list2)
    (setq i 1)
    (foreach x lst
      (if (= i 1) 
        (setq list1 (cons x list1) 
              i 2
        ) 
        (setq list2 (cons x list2)
              i 1
        )
      )
    )
    (list list1 list2)
  );defun
  
  (defun makeline (p1 p2 / v1 v2 lineobj)
    (setq v1 (vlax-3d-point p1))
    (setq v2 (vlax-3d-point p2))
    (setq lineobj (vla-addline (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) v1 v2))
    (vlax-vla-object->ename lineobj)
  );defun
  
  (setq linex (entget line)
        lineobj (vlax-ename->vla-object line)
        polyobj (vlax-ename->vla-object poly)
  )
  (setq splitted-lst (split-list (LM:intersections lineobj polyobj acExtendThisEntity)))
  (setq line-list (mapcar 'makeline (car splitted-lst)(cadr splitted-lst))) ;; makeline needs osmode 0?
  (entdel line)
  line-list
)

[ВeekeeCZ]

You can sort them by distance along the line: 

(vl-sort lp '(lambda (e1 e2) (< (distance p (car e1)) (distance p (car e2)))))

where p is the line starting point (code 10)

If you have a polyline, you can similarly use (vlax-curve-getdistatpoint pl pt).

To split them, if it's a line, I would prefer to use vla-copy method over vla-addline to have the same properties.

If you have used entmod, then simple change to entmake  makes a copy with the same properties.

Try (entmake (entget (car (entsel)))).

[calderg1000 · Accepted solution]

Regards @EnM4st3r 

Try this code, with minimal testing...

;;;___		 
(defun c:ext_mln (/ snp lp snl x ln lnv lcd ps pe)
  (princ "\nPick object Boundary ")
  (setq
    snp	(cadar (ssnamex (ssget "_+.:E:S" '((0 . "lwpolyline")))))
  )
  (setq
    lp	(mapcar
	  'cdr
	  (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget snp))
	)
    snl	(cadar (ssnamex (ssget "cp" lp '((0 . "line")))))
    ln	(list snp snl)
    lnv	'()
  )
  (foreach x ln
    (setq lnv (cons (vlax-ename->vla-object x) lnv))
  )
  (setq	lcd (vlax-safearray->list
	      (vlax-variant-value
		(vla-intersectwith (car lnv) (cadr lnv) acExtendboth)
	      )
	    )
  )
  (setq lint (cc lcd))
  (setq lst (vl-sort lint '(lambda (x y) (< (car x) (car y)))))
  (setq ptln (cp lst))
  (foreach x ptln
    (command "_.line" (car x) (cadr x) "")
  )
  (vla-erase (vlax-ename->vla-object snl))
)
  
(defun cp (lp / lt ps)
  (setq lt '())
  (repeat (/ (length lp) 2)
    (setq
      ps (list (car lp) (cadr lp))
      lp (cdr (member (cadr lp) lp))
      lt (cons ps lt)
    )
  )
)

(defun cc (lp / lt ps)
  (setq lt '())
  (repeat (/ (length lp) 3)
    (setq
      ps (list (car lp) (cadr lp) (caddr lp))
      lp (cdr (member (caddr lp) lp))
      lt (cons ps lt)
    )
  )
)

[Sea-Haven]

When you use Intersectwith it works out the points in order, so you can draw individual lines, could do draw pt1-pt2, skip pt2-pt3 draw pt3-pt4 and so on, or draw all and just erase not required seems much easier. 

(setq intpt1 (vlax-invoke obj2 'intersectWith obj1 acExtendThisEntity))
(51.0796620546632 238.657773626381 0.0 32.3900209516242 102.080675970058 0.0 37.8842478550707 142.230487312128 0.0 43.9523286411653 186.573814053386 0.0)

(command "line" "51.0796620546632,238.657773626381,0.0" "32.3900209516242,102.0806759700580,0" "37.8842478550707,142.2304873121280,0" "43.9523286411653,186.573814053386,0.0" "")

CalderG1000 gave it a try, drew 2 lines skipped middle as required GOOD, but incorrect angle on lines produced.

[calderg1000]

Querido @Sea-Haven 

Donde podría estar mi error angular...?, en mis pruebas el código funciona bien, Gracias.

[ВeekeeCZ]

@calderg1000 

do you know what is the most common issue we solve here? It's running osnaps.

[Sea-Haven]

Hi, found it need to set Osmode to 0 else osnaps screw up result. Works great.

[calderg1000]

Thank you  @Sea-Haven,  for taking the time to view the test and review the code. As for deactivating Osnap, I also thought about it, but I avoid doing it when I think it is not necessary. What it indicates so far I am concluding that it is valid when a point is selected with the pointer, but when its coordinates are specified, the pointer no longer intervenes and it will not be necessary to deactivate it. It's my deduction, except for a better opinion...
Greetings.

[john.uhden]

@Sea-Haven & @ВeekeeCZ ,

You both (and a multitude of others) know that any user can turn osnaps back on at most any time.  If using the command or vl-cmdf functions, one could prefix any point input with "_non".  (Yes, I know grammatically that I should have placed the period within the preceding quote " but then an observer might think the period was required.  So I broke one of my elementary school rules.  Hope Mr. Finan forgives me in spite of his residence on the other side of The Rainbow Bridge.)

[Sea-Haven]

May have been my Bricscad for testing, set osmode 0 works then. 

[ВeekeeCZ]

It's good to see some that know a typographical well. I was about to think that nobody knows anything today. There are people who consider punctuation masks a waste of time.

[EnM4st3r]

Thanks @Everyone, i'll take a closer look at all the answer when I have time

[Kent1Cooper]

---

@Sea-Haven wrote:

When you use Intersectwith it works out the points in order.....

---

For me, that order is not positional in space, but in progression along the Polyline.  In this analagous situation, asking for intersections of the green Polyline and the yellow Line being the object that needs to be extended, the result comes out in order along the Polyline, not in order along the virtual extension of the Line.  [The Polyline starts at upper left and goes down from there and around CCW.]

I drew a new Polyline [white] along the sequence of intersection points in the (intersectwith) return, and converted all its segments to arcs so you can see how the order goes.  That would not give the result you anticipate, using every successive pair of points to draw a Line -- they'd overlap and go across the spaces outside the Polyline.

[EnM4st3r]

yes thats exactly what was my problem. The command of @calderg1000 seems to handle this correctly with his cc, cp and the vl-sort function. Altough i dont completely understand the logic here...

[EnM4st3r]

ok i think i understood the sorting logic. however it still messes up when multiple intersection points have the same x value, so changed the sort function to this:

'(lambda (x y) (if (= (car x) (car y)) (< (cadr x) (cadr y)) (< (car x) (car y))))

[ВeekeeCZ]

---

@EnM4st3r wrote:

ok i think i understood the sorting logic. however it still messes up when multiple intersection points have the same x value, so changed the sort function to this:

'(lambda (x y) (if (= (car x) (car y)) (< (cadr x) (cadr y)) (< (car x) (car y))))

---

Does not seem so. Why did you drop the distance sorting example? 

Your expression, you should never use a plain comparison for real numbers. Always use a fuzz (equal x y 1e-9) 

[ВeekeeCZ]

;; makeline needs osmode 0?

no, you don't. not for your or entmake approach.

but calderg1000's approach, yes, always.

[ВeekeeCZ · Accepted solution]

Ok, this is the approach I was suggesting.

(defun c:test123 ()
  (create-intersecting-lines (car (entsel "\nLine: ")) (car (entsel "\nPolyline: ")))
  (princ)
  )

(defun create-intersecting-lines (line poly / LM:intersections lineobj polyobj lst omin p1 p2 obj)
  
  (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 lineobj (vlax-ename->vla-object line))
	   (setq polyobj (vlax-ename->vla-object poly))

	   (setq lst (LM:intersections lineobj polyobj acExtendThisEntity))
	   (>= (length lst) 2)
	   (setq pmin (apply 'mapcar (cons 'min lst)))
	   (setq lst (vl-sort lst '(lambda (p1 p2) (< (distance pmin p1) (distance pmin p2)))))
	   )
    
    (progn
      
      (vla-put-startpoint lineobj (vlax-3d-point (car lst)))   ; change the original
      (vla-put-endpoint lineobj (vlax-3d-point (cadr lst)))
      
      (while (and (setq lst (cddr lst))
		  (setq p1 (car lst))
		  (setq p2 (cadr lst))
		  )
	(setq obj (vla-copy lineobj))				; copy the original
	(vla-put-startpoint obj (vlax-3d-point p1))
	(vla-put-endpoint obj (vlax-3d-point p2)))))
  (princ)
  )

[komondormrex]

hey there,

check the shorter one

(defun make_points (coordinates_raw_list / point_list)
  	(if coordinates_raw_list
		(setq point_list (cons
							   (list (car coordinates_raw_list) (cadr coordinates_raw_list) (caddr coordinates_raw_list))
							   (make_points (cdddr coordinates_raw_list))
						 )
		)
	)
  	point_list
)

(defun c:draw_trimmed_intersections (/ line pline intersection_points_list index line_copy)
	(setq line (vlax-ename->vla-object (car (entsel "\nPick line: ")))
		  pline (vlax-ename->vla-object (car (entsel "\nPick pline: ")))
		  intersection_points_list (make_points (vlax-invoke pline 'intersectwith line acextendotherentity))
		  intersection_points_list (vl-sort intersection_points_list 
		  								  '(lambda (point_1 point_2) (> (distance (car intersection_points_list) point_1) 
																		(distance (car intersection_points_list) point_2)
																	 )
										   )
								   )
		  intersection_points_list (vl-sort intersection_points_list 
		  								  '(lambda (point_1 point_2) (> (distance (car intersection_points_list) point_1) 
																		(distance (car intersection_points_list) point_2)
																	 )
										   )
								   )
		  index 0
	)
	(foreach line_list (mapcar '(lambda (point_1 point_2) (list point_1 point_2)) intersection_points_list (cdr intersection_points_list))
		(if (= 1 (gcd (setq index (1+ index)) 2))
			(progn
				(vlax-put (setq line_copy (vla-copy line)) 'startpoint (car line_list))
				(vlax-put line_copy 'endpoint (cadr line_list))
			)
		)
	)
	(vla-erase line)
	(princ)
)

[EnM4st3r]

---

---

d

---

Why did you drop the distance sorting example? 

---

 tbh i didnt know where to implement it in my code and also did not completely understand the logic..

Gave it another thought, i think the idea was to use the sorting on the Pointlist I get from LM:intersections right?
so i sort the list before splitting it?

But i think i dont need (car e1) and (car e2) for that as i can use it without the car. so in my original code it would work like that.

  (setq linex (entget line)
        p10 (cdr (assoc 10 linex))
        lineobj (vlax-ename->vla-object line)
        polyobj (vlax-ename->vla-object poly)
  )
  (setq pointlist (LM:intersections lineobj polyobj acExtendThisEntity))
  (setq sorted-pointlist (vl-sort pointlist '(lambda (e1 e2) (< (distance p10 e1) (distance p10 e2)))))
  (setq splitted-lst (split-list sorted-pointlist))
 
  (setq line-list (mapcar 'makeline (car splitted-lst)(cadr splitted-lst)))
  (entdel line)
  line-list
);defun