Shorten Pline Start and End Points

[DGCSCAD]

I'm looking to shorten the start and end point of a selected pline, as shown, moving the points inward by one unit. I've looked at a few functions, like Lee Mac's Double Extend and then M Ribar's variation of it, but those are a bit over my head.

A nudge in the right direction would be very much appreciated.

[Kent1Cooper]

Do you need a routine?  LENGTHEN, DElta option, give it a negative value, pick near both ends.  [That could be automated if you really need to do it by just picking the Polyline once.]

[DGCSCAD]

---

@Kent1Cooper wrote:

Do you need a routine?  LENGTHEN, DElta option, give it a negative value, pick near both ends.  [That could be automated if you really need to do it by just picking the Polyline once.]

---

Thanks for the reply.

Yes, I need it in a routine. The pline will be a selection set via (ssget "L").

[ronjonp]

Here's a quick one with not much error checking:

(defun c:foo (/ el p1 p2 s)
  ;; RJP » 2024-01-31
  (if (setq s (ssget ":L" '((0 . "LWPOLYLINE"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq el (entget e))
      (setq p1 (vlax-curve-getpointatdist e 1.))
      (setq p2 (vlax-curve-getpointatdist
		 e
		 (1- (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
	       )
      )
      (setq el (subst (cons 10 p1) (assoc 10 el) el))
      (setq el (subst (cons 10 p2) (assoc 10 (reverse el)) el))
      (entmod el)
    )
  )
  (princ)
)

[Sea-Haven]

Will subst 10 alter wrong end depending on direction of pline ? May be better to check end selected and do a VLAX-put co-ordinates changing 1st or last cordinate.

Same pline but reversed direction for 2nd test.

(10 1.54526680238305 208.551459673255)

(10 -5.6644506531008 195.296946813404)

[komondormrex]

you mean, you need it to incorporate into another routine?

(setq pline (car (entsel "\nPick open straight segmented pline: "))
	  nudge -1
	  vertices (mapcar 'cdr (vl-remove-if-not '(lambda (group) (= 10 (car group))) (entget pline)))
	  first_vertex_nudged (mapcar '+ '(0 0) (polar (car vertices) (angle (cadr vertices) (car vertices)) nudge))
	  vertices (reverse vertices)
	  last_vertex_nudged (mapcar '+ '(0 0) (polar (car vertices) (angle (cadr vertices) (car vertices)) nudge))  
	  vertices (cdr (reverse (cdr vertices)))
	  vertices (append (cons first_vertex_nudged vertices) (list last_vertex_nudged)) 
)
(vlax-put (vlax-ename->vla-object pline) 'coordinates (apply 'append vertices))

[ВeekeeCZ]

Or possibly something like this

(defun lengthendeltaboth (e d)
  (if (> (+ (vlax-curve-getdistatpoint e (vlax-curve-getendpoint e)) d) 0)
    (vl-cmdf "_.lengthen" "_delta" (/ d 2.)
	     (list e (trans (vlax-curve-getpointatparam e (vlax-curve-getstartparam e)) 0 1))
	     (list e (trans (vlax-curve-getpointatparam e (vlax-curve-getendparam e)) 0 1)) "")))

d as delta could be both positive or negative, and it's overall .

[Kent1Cooper]

If the shortening might ever extend beyond the next vertex in [i.e. shorten it by more than the length of the end segment], or if an end segment might ever be an arc, then I think the LENGTHEN-based approach with a negative Delta value is the only way.  Repositioning the end vertices or replacing the entire vertex list won't do what you want.

If shortening more than the end-segment length, you would get the end at the right place, but the Polyline would turn back to there from the next-to-last vertex, which would still extend beyond that new endpoint.  What you want to do should result in fewer vertices, not just a different location for the end one.

With an arc end segment even if not shortening by more than its length, the bulge factor of the shortened end segment would not be right.

[ronjonp]

---

@Sea-Haven wrote:

Will subst 10 alter wrong end depending on direction of pline ? May be better to check end selected and do a VLAX-put co-ordinates changing 1st or last cordinate.

Same pline but reversed direction for 2nd test.

(10 1.54526680238305 208.551459673255)

(10 -5.6644506531008 195.296946813404)

---

Test it .. it should. As mentioned though if the end has a vertice less than 1 unit in length the code will give undesired results.

[DGCSCAD]

---

@ronjonp wrote:

Here's a quick one with not much error checking:

(defun c:foo (/ el p1 p2 s)
  ;; RJP » 2024-01-31
  (if (setq s (ssget ":L" '((0 . "LWPOLYLINE"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq el (entget e))
      (setq p1 (vlax-curve-getpointatdist e 1.))
      (setq p2 (vlax-curve-getpointatdist
		 e
		 (1- (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
	       )
      )
      (setq el (subst (cons 10 p1) (assoc 10 el) el))
      (setq el (subst (cons 10 p2) (assoc 10 (reverse el)) el))
      (entmod el)
    )
  )
  (princ)
)

---

Thanks all for the quick responses! It's very much appreciated and a bit to chew on.

ronjonp, I went with yours since it's the easiest for me to understand at the moment. I need to change the 1.0 shortened length to 1.75. I figured out the p1 variable, which works, but not sure about the other end?

(defun Nudge_1 (/ el p1 p2 s)
  ;; RJP » 2024-01-31
  ;(if (setq s (ssget ":L" '((0 . "LWPOLYLINE"))))
   (if (setq s ss_center2)
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq el (entget e))
      (setq p1 (vlax-curve-getpointatdist e 1.75))
      (setq p2 (vlax-curve-getpointatdist
		 e
		 (1- (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
	       )
      )
      (setq el (subst (cons 10 p1) (assoc 10 el) el))
      (setq el (subst (cons 10 p2) (assoc 10 (reverse el)) el))
      (entmod el)
    )
  )
  (princ)
)

[ronjonp]

@DGCSCAD Try this:

(setq p2
       (vlax-curve-getpointatdist e (- (vlax-curve-getdistatparam e (vlax-curve-getendparam e)) 1.75))
)

[DGCSCAD]

---

@ronjonp wrote:

@DGCSCAD Try this:

(setq p2
       (vlax-curve-getpointatdist e (- (vlax-curve-getdistatparam e (vlax-curve-getendparam e)) 1.75))
)

---

That worked! Thank you!

After almost 2 decades of not needing to do much coding, I'm in a position where I need to relearn a lot of it, so I'll probably have many, many... many questions. I've been back at the Swamp poking around and seeing a lot of your code recently. I have another question about a piece of code penned by you, but I'll make another thread that is titled/suited for the situation.

[Sea-Haven]

Re read the post again missed wants to do both ends so using a dxf 10 is ok. Need to read a bit slower.

The other way is to just update the co-ordinates using VLA-get-co-ordinates and making  a new list.

[Kent1Cooper]

---

@Sea-Haven wrote:

Re read the post again missed wants to do both ends so using a dxf 10 is ok. Need to read a bit slower.

The other way is to just update the co-ordinates using VLA-get-co-ordinates and making  a new list.

---

...except in the situation described in Messages 8 & 9.

[Sea-Haven]

Another method, but as suggested will check if length end point to new point is greater than length of segment.

; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/shorten-pline-start-and-end-points/td-p/12532682
 
;;---------------------=={ Subst Nth }==----------------------;;
;;                                                            ;;
;;  Substitutes an item at the nth position in a list.        ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  a - item to substitute                                    ;;
;;  n - position in list to make the substitution             ;;
;;  l - list in which to make the substitution                ;;
;;------------------------------------------------------------;;
;;  Returns:  Resultant list following the substitution       ;;
;;------------------------------------------------------------;;

(defun c:extpl ( / obj oldsnap lst pt1 pt2 pt3 pt4 pt5 pt6 len1 dist )
(defun LM:SubstNth ( a n l )
    (if l
        (if (zerop n)
            (cons a (cdr l))
            (cons (car l) (LM:SubstNth a (1- n) (cdr l)))
        )
    )
)
(setq oldsnap (getvar 'osmode))

(setvar 'osmode 0)

(setq obj (vlax-ename->vla-object (car  (entsel "Pick pline "))))
(setq lst (vlax-safearray->list (vlax-variant-value (vla-get-coordinates obj))))

(if (= lst 4)
(alert "The object is only a 2 pt pline or a line ")
)

(setq dist (getreal "\Enter distance Enter = 1.0 "))

(if (= dist nil)(setq dist 1.0))

(setq pt1 (list (nth 0 lst) (nth 1 lst)))
(setq pt2 (list (nth 2 lst) (nth 3 lst)))
(setq pt5 (polar pt1 (angle pt1 pt2) dist))
(setq len1 (distance pt1 pt2))

(if (> len1 dist)
  (progn
  (setq lst (LM:SubstNth (car pt5) 0 lst))
  (setq lst (LM:SubstNth (cadr pt5) 1 lst))
    )
  (progn 
  (alert "Distance entered is to great will now exit")
  (setq miss "Yes")
  )
)

(setq pt3 (list (nth (- (length lst) 4) lst) (nth (- (length lst) 3) lst)))
(setq pt4 (list (nth (- (length lst) 2) lst) (last lst)))
(setq pt6 (polar pt4 (angle pt4 pt3) dist))
(setq len1 (distance pt3 pt4))

(if (> len1 dist)
  (progn
  (setq lst (LM:SubstNth (car pt6) (- (length lst) 2) lst))
  (setq lst (LM:SubstNth (cadr pt6) (- (length lst) 1) lst))
  )
  (setq miss "Yes")
)

(setvar 'osmode oldsnap)
(if (= Miss "yes")
(exit)
(vlax-put obj 'coordinates lst)
)
(princ)
)