Need LSIP for Extend/Join Lines to Nearest block edges.

[mbk.ee11]

Hello,

There are certain blocks in the drawing, between each block polylines are there under the fixed layer "D500". These polylines both the ends are not connected to blocks. It has some gaps. What I need here is, all the polyline under the layer D500 should be snapped to nearest block edges. Please suggest any LISP. Attached reference DWG.

Thanks in advance!

[Kent1Cooper]

Can you count on all of those Polylines always being short of the nearest Block, with a gap?  And none of them being without any Block beyond an end?  If so, a routine could find all the Polylines, start an EXTEND command and select everything as extension boundaries, and just go around and pick on each end of each Polyline to Extend it.  If any already touch a Block edge, that would Extend them across it, though maybe that doesn't matter for those Blocks that have Wipeouts [but not all do].

[CADaSchtroumpf]

This try?

You can change the variable "dist_find" : here fixed at 5.0

(defun c:test ( / ss_pl n ent obj pt_start pt_end coord dist_find ss_blk pt_ins)
  (setq ss_pl (ssget "_X" '((0 . "LWPOLYLINE") (8 . "D500") (410 . "Model"))))
  (cond
    (ss_pl
      (repeat (setq n (sslength ss_pl))
        (setq
          ent (ssname ss_pl (setq n (1- n)))
          obj (vlax-ename->vla-object ent)
          pt_start (vlax-curve-getStartPoint ent)
          pt_end (vlax-curve-getEndPoint ent)
          coord (vlax-get obj 'Coordinates)
          dist_find 5.0
        )
        (foreach pt (list pt_start pt_end)
          (setq
            ss_blk
            (ssget "_C"
              (mapcar '- pt (list dist_find dist_find 0.0)) (mapcar '+ pt (list dist_find dist_find 0.0))
              '((0 . "INSERT") (8 . "DCD,LE") (410 . "Model"))
            )
          )
          (cond
            (ss_blk
              (setq pt_ins (cdr (assoc 10 (entget (ssname ss_blk 0)))))
              (if (equal pt pt_start)
                (setq coord (cons (car pt_ins) (cons (cadr pt_ins) (cddr coord))))
                (setq coord (reverse (cons (cadr pt_ins) (cons (car pt_ins) (cddr (reverse coord))))))
              )
              (vlax-put obj 'Coordinates coord)
            )
          )
        )
      )
    )
  )
  (prin1)
)

[mbk.ee11]

This code is joining all the line under layer D500. since the blocks has mask there is no visibility. But what is actually requirement is, those polylines both ends should be extend and snap to nearby(available in opposite direction) blocks edges.

[mbk.ee11]

To answer your questions,

all of those Polylines always being short of the nearest Block, with a gap? - Yes

And none of them being without any Block beyond an end? -  Yes, These polylines have always blocks at both sides.

a routine could find all the Polylines, start an EXTEND command and select everything as extension boundaries, and just go around and pick on each end of each Polyline to Extend it. - Exactly

If any already touch a Block edge, that would Extend them across it, though maybe that doesn't matter for those Blocks that have Wipeouts - No, if they already touched block edge, no need to extend further. If it does, then it needs to be trimmed out.

I have attached example DWG with BEFORE and AFTER for clear understanding.

[Kent1Cooper]

---

@mbk.ee11 wrote:

.... if they already touched block edge, no need to extend further. If it does, then it needs to be trimmed out. ....

---

That part makes it complicated -- it has to check whether there's a Block [on one of those Layers] at an endpoint of a Polyline, and if there is, don't Extend.  And that means it has to Zoom in sufficiently and tighten down the Pickbox size, to know whether it's really there as opposed to just within pick range.

Accounting for that kind of stuff, this seems to work in minimal testing.  No *error* handling yet or other typical controls, but see if it works for you:

(defun C:EPB ; = Extend Polylines to Blocks
  (/ pb ss n pl)
  (setq pb (getvar 'pickbox))
  (setvar 'pickbox 1)
  (if (setq ss (ssget "_X" '((0 . "LWPOLYLINE") (8 . "D500"))))
    (repeat (setq n (sslength ss)) ; then
      (setq pl (ssname ss (setq n (1- n))))
      (command "_.zoom" "_object" pl "" "_zoom" "0.95x")
      (foreach pt
        (list
          (vlax-curve-getStartPoint pl)
          (vlax-curve-getEndPoint pl)
        ); list
        (if (not (ssget pt '((0 . "INSERT") (8 . "DCD,LE"))))
          (command "_.extend" "" (list pl pt) "")
        ); if
      ); foreach
      (command "_.zoom" "_previous" "_.zoom" "_previous")
    ); repeat
  ); if
  (setvar 'pickbox pb)
  (prin1)
)

If a Polyline already encroaches inside a Block but not to a point where selection at its endpoint would find the Block, then it will be Extended farther -- nothing here covers Trimming out in that situation, which would involve a very different analysis if it's even possible to determine.

[komondormrex]

hey,

check the code below

;******************************************************************************************************************************************

;	komondormrex, may 2023

;******************************************************************************************************************************************

(defun get_nearest_intersection (probe insert_object / raw_intersection_point_list intersection_point_list intersections_list)
	(setq probe_start_point (vlax-get probe 'startpoint))
	(foreach object (vlax-invoke insert_object 'explode)
		(if (not (member (vla-get-objectname object) '("AcDbAttributeDefinition" "AcDbHatch")))
			(if (< 3 (length (setq raw_intersection_point_list (vlax-invoke probe 'intersectwith object acextendnone))))
					(progn
						(repeat (/ (length raw_intersection_point_list) 3)
							(setq intersection_point_list (append intersection_point_list (list (list (car raw_intersection_point_list)
																  (cadr raw_intersection_point_list)
																  (caddr raw_intersection_point_list)
															)
												  		)
							  )
								  raw_intersection_point_list (cdddr raw_intersection_point_list)
							)
						)
						(setq intersections_list (append intersections_list intersection_point_list))
					)
					(setq intersections_list (append intersections_list (list raw_intersection_point_list)))
			)
		)
		(vla-erase object)
	)
	(if (<= 1 (length (setq intersections_list (vl-remove nil intersections_list))))
		(car intersections_list)
		(car (vl-sort intersections_list
					 '(lambda (point_1 point_2) (< (distance probe_start_point point_1) (distance probe_start_point point_2))
					  )
			 )
		)
	)
)

;******************************************************************************************************************************************

(defun c:extend_selected_insert_edge (/ probe_line probe_length start_vertex next_start_vertex probe_end_point insert_on_route extend_to_point
										pline_vertices_raw_list end_vertex before_end_vertex
						 			 )
	(setq probe_line (vla-addline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
				     	(vlax-3d-point '(0 0))
				      	(vlax-3d-point '(0 0))
		  	 		 )
		  probe_length 15.0
	)
	(foreach pline_object (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_:l" '((0 . "lwpolyline") (8 . "D500")))))))
		(setq start_vertex (trans (vlax-curve-getstartpoint pline_object) 0 1))
		(setq next_start_vertex (trans (vlax-curve-getpointatparam pline_object 1) 0 1))

		(vla-put-startpoint probe_line (vlax-3d-point (trans start_vertex 1 0)))
		(vla-put-endpoint probe_line (vlax-3d-point (trans (setq probe_end_point (polar start_vertex (angle next_start_vertex start_vertex) probe_length)) 1 0)))
		(if (setq insert_on_route_sset (ssget "_f" (list start_vertex probe_end_point) '((0 . "insert"))))
			(progn
				(setq insert_on_route (vlax-ename->vla-object (ssname insert_on_route_sset 0)))
				(if (setq extend_to_point (get_nearest_intersection probe_line insert_on_route))
					(progn
						(setq pline_vertices_raw_list (append (list (car extend_to_point) (cadr extend_to_point)) (cddr (vlax-get pline_object 'coordinates))))
						(vla-put-coordinates pline_object (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length pline_vertices_raw_list))))
												      pline_vertices_raw_list
										)
						)
					)
				)
			)
		)
	  	(setq end_vertex (trans (vlax-curve-getendpoint pline_object) 0 1))
		(setq before_end_vertex (trans (vlax-curve-getpointatparam pline_object (1- (vlax-curve-getendparam pline_object))) 0 1))
		(vla-put-startpoint probe_line (vlax-3d-point (trans before_end_vertex 1 0)))
		(vla-put-endpoint probe_line (vlax-3d-point (trans (setq probe_end_point (polar end_vertex (angle before_end_vertex end_vertex) probe_length)) 1 0)))
		(if (setq insert_on_route_sset (ssget "_f" (list end_vertex probe_end_point) '((0 . "insert"))))
			(progn
				(setq insert_on_route (vlax-ename->vla-object (ssname insert_on_route_sset 0)))
				(if (setq extend_to_point (get_nearest_intersection probe_line insert_on_route))
					(progn
						(setq pline_vertices_raw_list (append (reverse (cddr (reverse (vlax-get pline_object 'coordinates))))
															  (list (car extend_to_point) (cadr extend_to_point))
													  )
						)
						(vla-put-coordinates pline_object (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble
																									(cons 0 (1- (length pline_vertices_raw_list)))
																			   )
												     						    pline_vertices_raw_list
														  )
						)
					)
				)
			)
		)
	)
	(vla-erase probe_line)
	(princ)
)

;******************************************************************************************************************************************