extend lines,polylines or 3dpolylines on specific layers to specific closed objects on specific layers

[pyou]

Hi

 

Would it be possible to extend strings on specific layers to the objects on specific layers only. It is important that strings would look for closest features only to be extended to. For example there are circles or rectangles in the drawing and lines, polylines or 3d polylines surrounded those features, gaps usually really small. Maybe possible to set specific radius from the centre of individual circle or rectangle, so it only uses and extends lines to it up to certain distance or something? I have attached an example drawing. As I imagine this would be ideally one click only so lisp code searches for features and lines in the drawing and does this job automatically. 

 

Thank you for help.

 

(defun c:ExtendPolylinesToBoundary (/ polyLayers boundaryLayers polys boundaries polyCount poly boundaryCount boundary closestBoundary minDist dist)
  ;; Define the layers for polylines and boundary objects
  (setq polyLayers '("Layer1" "Layer2" "Layer3" "Layer4" "Layer5" "Layer6" "Layer7"))    ;; List of polyline layers
  (setq boundaryLayers '("Feature1" "Feature2"))  ;; List of boundary layers
  
  ;; Function to get objects on specific layers
  (defun getObjectsOnLayers (layerNames objType)
    (apply 'ssadd
           (mapcar
             '(lambda (layerName)
                (ssget "X" (list (cons 0 objType) (cons 8 layerName))))
             layerNames))
  )

  ;; Get the polylines on the specified layers
  (setq polys (ssget "X" (list (cons 0 "LWPOLYLINE") (cons 8 (apply 'strcat (mapcar 'strcat polyLayers))))))

  ;; Get the boundary objects (closed polylines and circles) on the specified layers
  (setq boundaries (apply 'ssadd (mapcar '(lambda (layer) (ssget "X" (list (cons 8 layer) (cons 0 "LWPOLYLINE,CIRCLE")))) boundaryLayers)))

  ;; Function to get the distance between two points
  (defun distance (p1 p2)
    (sqrt (+ (expt (- (car p1) (car p2)) 2) (expt (- (cadr p1) (cadr p2)) 2)))
  )

  ;; Function to extend polyline to the closest boundary
  (defun extendPolylineToClosestBoundary (poly)
    (setq minDist nil)
    (setq closestBoundary nil)
    (setq polyEndPts (mapcar '(lambda (vtx) (cdr (assoc 10 (entget (nth vtx (entget poly)))))) (vlax-get (vlax-ename->vla-object poly) 'Coordinates)))
    (setq boundaryCount (sslength boundaries))
    (repeat boundaryCount
      (setq boundary (ssname boundaries (setq boundaryCount (1- boundaryCount))))
      (foreach endPt polyEndPts
        (cond
          ((eq (cdr (assoc 0 (entget boundary))) "CIRCLE")
           (setq boundaryCenter (cdr (assoc 10 (entget boundary))))
           (setq dist (distance endPt boundaryCenter))
          )
          ((eq (cdr (assoc 0 (entget boundary))) "LWPOLYLINE")
           (setq dist (vlax-curve-getDistAtParam (vlax-ename->vla-object boundary) (vlax-curve-getStartParam (vlax-ename->vla-object boundary))))
          )
        )
        (if (or (not minDist) (< dist minDist))
          (progn
            (setq minDist dist)
            (setq closestBoundary boundary)
          )
        )
      )
    )
    (if closestBoundary
      (command "_.extend" "_MOde" "_standard" poly closestBoundary "")
    )
  )
  
  ;; Check if we have polylines and boundary objects
  (if (and polys boundaries)
    (progn
      (setq polyCount (sslength polys))
      (repeat polyCount
        (setq poly (ssname polys (setq polyCount (1- polyCount))))
        (extendPolylineToClosestBoundary poly)
      )
    )
    (princ "\nNo polylines or boundary objects found on specified layers.")
  )
  (princ)
)

;; Command to call the function
(princ "\nType ExtendPolylinesToBoundary to run the script.")
(princ)

 

 

extend to object on the layer.dwg

Edited June 23 by pyou

[BIGAL]

Out of time now but "Extend" select sq or circle then use "Fence" which is an offset of the object to find all the other objects. Yep need chords for circle.

 

[ronjonp]

Post removed.. 

Edited June 24 by ronjonp

[pyou]

This probably too complex to create such a lisp.

[BIGAL]

There is a bug in this it works in a manual sense will extend to the 3 object types Circle, Polyline and Lwpolyline. Perhaps other eyes will see what is wrong. It's frustrating when code sort of works.

 

; https://www.cadtutor.net/forum/topic/87058-extend-linespolylines-or-3dpolylines-on-specific-layers-to-specific-closed-objects-on-specific-layers/
; extend object on layer

(defun dopoly (plent / )
(setq lst '())
(command "offset" "0.25" plent (getvar 'extmax) "")
(setq e (entlast))
(setq v (entnext e)
 x (entget  v)
)
(while (= "VERTEX" (cdr (assoc 0 x)))
 (setq lst (cons (cdr (assoc 10 x)) lst)
 v (entnext v)
 x (entget  v)
 )
)
(setq lst (reverse lst))
(setq lst (cons (last lst) lst))
(command "erase" (entlast) "")
)

(defun dopline (plent / )
(setq lst '())
(command "offset" "0.25" plent (getvar 'extmax) "")
(setq lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
(setq lst (cons (car lst) lst))
(command "erase" (entlast) "")
)


(defun docircle (circ / )
(setq lst '())
(setq pt (cdr (assoc 10 (entget circ))))
(setq rad (+ (cdr (assoc 40 (entget circ))) 0.25))
(setq ang 0.0 inc (/ (* 2.0 pi) 20.0) lst '())
(repeat 19
  (setq newpt (polar pt ang rad))
  (setq lst (cons (list (car newpt) (cadr newpt)) lst))
  (setq ang (+ ang inc))
)
)

(defun doextend (lst end / )
(command "_EXTEND")
(while (= (getvar "cmdactive") 1 )
(command ent)
(command "")
(command "F")
(repeat (setq x (length lst))
  (command (nth (setq x (- x 1)) lst))
)
(command "")
(command "")
)
)

(defun c:exxx ( / )
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(setq ss (ssget '((0 . "*POLYLINE,CIRCLE")(8 . "Feature1,Feature2"))))

(if (= ss nil)
(progn (alert "No objects selected please try again\n\nWill now exit ")(exit))
)

(repeat (setq x (sslength ss))
(setq ent (ssname ss (setq x (- x 1))))
(setq entg (entget ent))
(setq obname (cdr (assoc 0 entg)))
(cond
((= obname "CIRCLE")
 (progn
   (docircle ent)
   (doextend lst ent)
 ))
((= obname "LWPOLYLINE")
 (progn
   (dopline ent)
   (doextend lst ent)
 ))
((= obname "POLYLINE")
 (progn
   (dopoly ent)
   (doextend lst ent)
 ))
 (alert "wrong object")
 )
)

(setvar 'osmode oldsnap)
(princ)
)
(c:exxx)

 

 

[ronjonp]

Here's one that will extend lines to circles and plines that are at the same elevation.

(defun c:foo (/ bndry bndrys d d2 el fz lines lo p p p1 p2 p3 s z)
  (cond	((setq s (ssget ":L" '((0 . "CIRCLE,LINE,LWPOLYLINE"))))
	 (setq fz 0.25)
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (if (= "LINE" (cdr (assoc 0 (setq el (entget e)))))
	     (setq lines (cons (list e (cdr (assoc 10 el)) (cdr (assoc 11 el))) lines))
	     (setq bndrys (cons e bndrys))
	   )
	 )
	 (foreach line lines
	   (foreach b bndrys
	     (setq p (vlax-curve-getclosestpointto b (cadr line)))
	     (setq p2 (vlax-curve-getclosestpointto b (caddr line)))
	     (setq d (distance p (cadr line)))
	     (setq d2 (distance p2 (caddr line)))
	     (setq z (cond ((and (<= d d2) (<= d fz)) 'startpoint)
			   ((and (<= d2 d) (<= d2 fz)) 'endpoint)
		     )
	     )
	     (cond (z
		    (setq lo (vlax-ename->vla-object (car line)))
		    (if	(setq p3 (vlax-invoke lo 'intersectwith (vlax-ename->vla-object b) 1))
		      (vlax-put	lo
				z
				(if (< (distance (mapcar '+ p3 '(0 0 0)) p)
				       (distance (mapcar '+ (cdddr p3) '(0 0 0)) p)
				    )
				  (mapcar '+ p3 '(0 0 0))
				  (mapcar '+ (cdddr p3) '(0 0 0))
				)
		      )
		    )
		   )
	     )
	   )
	 )
	)
  )
  (princ)
)

 

[pyou]

Thanks, What makes it difficult to work with lines at different elevations, does it require a different lisp coding structure and could only work separately?

Edited June 28 by pyou

[ronjonp]

Those objects will not be within the tolerance distance of 0.25 that the code uses. Front view of circle ( blue ) and 3dpolys ( red ).