Need Lisp To Extend Polylines To The First Intersection

[Engineer_Yasser]

 

Please I Need Lisp To Extend Selected Polylines To The First Intersection Only

When I Select All Yellow Polylines, Extend Till Intersect With The 1st Yellow Polyline Then Stop

 

 

 

 

Sample.dwg

[BIGAL]

Rather than fix maybe look at how drawn in 1st place. Not sure how your creating say second set of linework.

 

 

[Engineer_Yasser]

@BIGAL

 

From Civil 3D Roads Corridor after exploding

[Engineer_Yasser]

 

I succeeded in creating Lisp 90% Perfect  ...

Can anyone optimize it for not looping all the polylines but only polylines within 50m from the polyline start point.

I used ( Intersections  -  Lee Mac ) function

 

(if (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
		(vl-cmdf "change" "p" "" "p" "TH" 0 "")
		(vl-cmdf "change" "p" "" "p" "EL" 0 "")
		(repeat (sslength ss)
			(setq pline_ent (ssname ss 0))
			(setq pline_entget (entget pline_ent))
			(setq pline_obj (vlax-ename->vla-object pline_ent))
			(setq pline_Start (list (car (vlax-curve-getStartPoint pline_obj)) (cadr (vlax-curve-getStartPoint pline_obj))))
			(setq pline_End (list (car (vlax-curve-getEndPoint pline_obj)) (cadr (vlax-curve-getEndPoint pline_obj))))
			
			(setq min_dist 9999999999)
			(setq nPoint '())
			(setq n 1)
			(repeat (1- (sslength ss))
				(setq X_ent (ssname ss n))
				(setq X_pline (entget X_ent))
				(setq X_ent_Obj (vlax-ename->vla-object X_ent))
				(if (setq X_point_list (LM:intersections pline_obj X_ent_Obj acExtendThisEntity))
					(progn
						(setq nPoint (list (car (car X_point_list)) (cadr (car X_point_list))))
						(setq dist1 (distance nPoint pline_Start))
						(setq dist2 (distance nPoint pline_End))
						(if (< dist1 dist2)
							(if (and (< dist1 min_dist) (< dist1 50))
								(progn
									(setq min_dist dist1)
									(setq final_start pline_Start)
									(setq final_nPoint nPoint)
								)
							)
						)
						
					)
				)
				(setq n (1+ n))
			)
				
			(setq x 0)
			(repeat (length pline_entget)
				(if (and (= (car (nth x pline_entget)) 10) (equal final_start (cdr (nth x pline_entget)))) (entmod (setq pline_entget (subst (cons 10 final_nPoint) (nth x pline_entget) pline_entget))))
				(setq x (1+ x))
			)
			
			(setq min_dist 9999999999)
			(setq nPoint '())
			(setq n 1)
			(repeat (1- (sslength ss))
				(setq X_ent (ssname ss n))
				(setq X_pline (entget X_ent))
				(setq X_ent_Obj (vlax-ename->vla-object X_ent))
				(if (setq X_point_list (LM:intersections pline_obj X_ent_Obj acExtendThisEntity))
					(progn
					  	(if (car (cdr X_point_list))
						  	(setq nPoint (list (car (car (cdr X_point_list))) (cadr (car (cdr X_point_list)))))
							(setq nPoint (list (car (car X_point_list)) (cadr (car X_point_list))))
						)
						(setq dist1 (distance nPoint pline_Start))
						(setq dist2 (distance nPoint pline_End))
						(if (< dist2 dist1)
							(if (and (< dist2 min_dist) (< dist2 50))
								(progn
									(setq min_dist dist2)
									(setq final_End pline_End)
									(setq final_nPoint nPoint)
								)
							)
						)
						
					)
				)
				(setq n (1+ n))
			)
				
			(setq x 0)
			(repeat (length pline_entget)
				(if (and (= (car (nth x pline_entget)) 10) (equal final_End (cdr (nth x pline_entget)))) (entmod (setq pline_entget (subst (cons 10 final_nPoint) (nth x pline_entget) pline_entget))))
				(setq x (1+ x))
			)
			(ssdel pline_ent ss)
			(ssadd pline_ent ss)
		)
		(vl-cmdf "regen")
	)
)
			
        
(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)
)

 

Edited February 20 by Engineer_Yasser

[Jonathan Handojo]

This was something that I also challenged myself to do. Though not perfect, the purpose of this program was to "neaten" Revit exported or similar pipelines so that they are all "filleted" and "trimmed" cleanly so that it works with my other commands that I've created.

 

I don't know how useful this will be, but if it doesn't suit your requirements, I'll give another crack at it.

 

You will probably just have to select the lines separately (the yellow and green lines).

 

 

 

Neaten.lsp

[Engineer_Yasser]

4 hours ago, Jonathan Handojo said:

This was something that I also challenged myself to do. Though not perfect, the purpose of this program was to "neaten" Revit exported or similar pipelines so that they are all "filleted" and "trimmed" cleanly so that it works with my other commands that I've created.

 

I don't know how useful this will be, but if it doesn't suit your requirements, I'll give another crack at it.

 

You will probably just have to select the lines separately (the yellow and green lines).

 

 

 

Neaten.lsp 14.62 kB · 1 download

 

@Jonathan Handojo

 

I don't know how to thank  you for your help, The lisp is working very fast and Perfect  

 

Thanks Again 

 

[Jonathan Handojo]

17 hours ago, Engineer_Yasser said:

 

@Jonathan Handojo

 

I don't know how to thank  you for your help, The lisp is working very fast and Perfect  

 

Thanks Again 

 

No worries. Glad it worked.

 

While you're at it, try this one, to remove all those annoying vertices. It's quite satisfying to see it

RXV.lsp

[Engineer_Yasser]

11 hours ago, Jonathan Handojo said:

No worries. Glad it worked.

 

While you're at it, try this one, to remove all those annoying vertices. It's quite satisfying to see it

RXV.lsp 14.28 kB · 1 download

 

I appreciate your help .. This lisp makes the drawing much better