Sloped stretch lisp routine

Hey guys I work strictly with AMEP piping interface for a plumbing company, but the built in sloped piping interface is terrible. The main reason that it is unusable is because the suggested routing isn't what one would do in the real world.

I am looking for a lisp routine that works like the built in STRETCH command, but incorporates a change in Z calculated by the displacement*slope. For example, if I type in STE, I would want to stretch with a +1/8" per foot slope. STNE would stretch with a -1/8" per foot slope.

I found this thread which has a lisp that controls the stretch to one axis only.

Appreciate any help on how to modify the routine to suite my needs. I am still trying to learn autolisp, and am finding it confusing when compared to C#.

I think in that case you need to type the destination point manually if you are working in WCS .

eg:

(command "_.stretch" (ssget) "" "" [color="magenta"]< Include the destination point here. eg: [color="blue"]'(0. 0. 25.0)[/color] >[/color])

I think in that case you need to type the destination point manually if you are working in WCS .

 

eg:

 

(command "_.stretch" (ssget) "" "" [color="magenta"]< Include the destination point here. eg: [color="blue"]'(0. 0. 25.0)[/color] >[/color])

Is there a way to modify the z value of pt2, and pass that into the command?

I think you do not need stretch command but you need to modify or relocate a specific coordinate of the selected objects.

What are the objects that you are working on at the moment ? Though the possibilities of making this trick to work is too little I think.

Select the line near the end you want to change. Right-click or command line options include entering values to Lengthen, Shorten, new Total length, to a given Elevation, Percent, or Ratio.

;| Change the Length of a Line|;
; BY: Tom Beauford
; BeaufordT@LeonCountyFL.gov
; Leon County Public Works Engineering
;(or C:chl (load "ChgLen.lsp"));chl
; (load "ChgLen.lsp") chl
;=======================================================
(defun C:chl (/ ActDoc A pick B etype pt1 pt pt2 pt3 pt4 distold dist1 ang1 z1)
 (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
 (vla-StartUndoMark ActDoc)
 (setq A (entsel "\nSelect Entity: ")
    pick (osnap (cadr A) "endp")
       B (entget (car A))
   etype (cdr(assoc 0 B))
 ); setq
 (princ "\netype = ")
 (princ etype)
 (cond
   ((eq etype "LINE")
     (progn
       (setq pt1 (cdr (assoc 10 B)) pt2 (cdr (assoc 11 B)))
       (if (>(distance pt1 pick)(distance pick pt2))
        (setq pt pt1 pt1 pt2 pt2 pt)
       )
       (setq pt3 (list (car pt1)(cadr pt1)) pt4 (list (car pt2)(cadr pt2))
                 distold (distance pt3 pt4)
                 ang1 (angle pt2 pt1)
       )
       (princ "\nOld Distance=")
       (princ distold)
       (initget "Lengthen Shorten Total Elevation Percent Ratio")
       (if(= ¦¦global¦¦ nil)(setq ¦¦global¦¦ "Total"))
       (if(setq ¦¦notnil¦¦ (getkword (strcat " [Lengthen/Shorten/Total/Elevation/Percent/Ratio] <" ¦¦global¦¦ ">: ")))(setq ¦¦global¦¦ ¦¦notnil¦¦))
       (setvar "cmdecho" 0)

   (cond
     ((= ¦¦global¦¦ "Lengthen")
       (setq dist1 (+ distold (getreal "\nEnter Distance: "))
                 z1 (+(caddr pt2)(*(/ dist1 distold)(-(caddr pt1)(caddr pt2))))
       )
     ); Lengthen
     ((= ¦¦global¦¦ "Shorten")
       (setq dist1 (- distold (getreal "\nEnter Distance: "))
                 z1 (+(caddr pt2)(*(/ dist1 distold)(-(caddr pt1)(caddr pt2))))
       )
     ); Shorten
     ((= ¦¦global¦¦ "Total")
       (setq dist1 (getreal "\nEnter New Length: ")
                 z1 (+(caddr pt2)(*(/ dist1 distold)(-(caddr pt1)(caddr pt2))))
       )
     ); Total
     ((= ¦¦global¦¦ "Elevation")
       (setq z1 (getreal "\nEnter Elevation to Trim/Extend: ")
                 dist1 (*(/ distold (-(caddr pt1)(caddr pt2)))(- z1 (caddr pt2)))
         )
     ); Elevation
     ((= ¦¦global¦¦ "Percent")
       (setq z1 (+(caddr pt2)(* distold(getreal "\nEnter Slope in %: ")0.01))
                 dist1 distold
       )
     ); Percent
     ((= ¦¦global¦¦ "Ratio")
       (setq z1 (+(caddr pt2)(/ distold(getreal "\nEnter Run/Rise: ")))
                 dist1 distold
       )
     ); Ratio
   ); cond

       (setq pt1 (polar pt2 ang1 dist1)
                 pt1 (list (car pt1)(cadr pt1) z1)
       )
       (if pt (setq pt pt1 pt1 pt2 pt2 pt))
       (setq B (subst(cons 10 pt1)(assoc 10 B) B)
             B (subst(cons 11 pt2)(assoc 11 B) B)
       )
       (entmod B)
       (princ "\nOld Distance=")
       (princ distold)
       (princ ", New Distance=")
       (princ dist1)
     ); progn
   ); line
   ((or(eq etype "ARC")(eq etype "POLYLINE")(eq etype "LWPOLYLINE"))
     (progn
       (command "lengthen" pick)
     ); progn
   ); ARC, POLYLINE or LWPOLYLINE
 ); cond
 (vla-EndUndoMark ActDoc)
 (princ)
)

Slope is retained by all options.

I think you do not need stretch command but you need to modify or relocate a specific coordinate of the selected objects.

 

What are the objects that you are working on at the moment ? Though the possibilities of making this trick to work is too little I think.

We work strictly with 3D piping, so 3D pipes and Fittings. AMEP has built in sloped piping, but it is only usable with automatic routing. The automatic routing doesn't account for limitations in the plumbing code, and does not use male fittings properly.

Modeling a sloped pipe is simple enough. However once we add fittings (wye with a street(male) eight bend) and need to line up the pipes with points on the plan, things get messy. Currently we do not slope our pipes, and I just stretch it into place. We would like to stretch the pipes keeping a specific slope.

Hope this makes sense and I truly appreciate the help

Select the line near the end you want to change. Right-click or command line options include entering values to Lengthen, Shorten, new Total length, to a given Elevation, Percent, or Ratio.

;| Change the Length of a Line|;
; BY: Tom Beauford
; BeaufordT@LeonCountyFL.gov
; Leon County Public Works Engineering
;(or C:chl (load "ChgLen.lsp"));chl
; (load "ChgLen.lsp") chl
;=======================================================
(defun C:chl (/ ActDoc A pick B etype pt1 pt pt2 pt3 pt4 distold dist1 ang1 z1)
 (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
 (vla-StartUndoMark ActDoc)
 (setq A (entsel "\nSelect Entity: ")
    pick (osnap (cadr A) "endp")
       B (entget (car A))
   etype (cdr(assoc 0 B))
 ); setq
 (princ "\netype = ")
 (princ etype)
 (cond
   ((eq etype "LINE")
     (progn
       (setq pt1 (cdr (assoc 10 B)) pt2 (cdr (assoc 11 B)))
       (if (>(distance pt1 pick)(distance pick pt2))
        (setq pt pt1 pt1 pt2 pt2 pt)
       )
       (setq pt3 (list (car pt1)(cadr pt1)) pt4 (list (car pt2)(cadr pt2))
                 distold (distance pt3 pt4)
                 ang1 (angle pt2 pt1)
       )
       (princ "\nOld Distance=")
       (princ distold)
       (initget "Lengthen Shorten Total Elevation Percent Ratio")
       (if(= ¦¦global¦¦ nil)(setq ¦¦global¦¦ "Total"))
       (if(setq ¦¦notnil¦¦ (getkword (strcat " [Lengthen/Shorten/Total/Elevation/Percent/Ratio] <" ¦¦global¦¦ ">: ")))(setq ¦¦global¦¦ ¦¦notnil¦¦))
       (setvar "cmdecho" 0)

   (cond
     ((= ¦¦global¦¦ "Lengthen")
       (setq dist1 (+ distold (getreal "\nEnter Distance: "))
                 z1 (+(caddr pt2)(*(/ dist1 distold)(-(caddr pt1)(caddr pt2))))
       )
     ); Lengthen
     ((= ¦¦global¦¦ "Shorten")
       (setq dist1 (- distold (getreal "\nEnter Distance: "))
                 z1 (+(caddr pt2)(*(/ dist1 distold)(-(caddr pt1)(caddr pt2))))
       )
     ); Shorten
     ((= ¦¦global¦¦ "Total")
       (setq dist1 (getreal "\nEnter New Length: ")
                 z1 (+(caddr pt2)(*(/ dist1 distold)(-(caddr pt1)(caddr pt2))))
       )
     ); Total
     ((= ¦¦global¦¦ "Elevation")
       (setq z1 (getreal "\nEnter Elevation to Trim/Extend: ")
                 dist1 (*(/ distold (-(caddr pt1)(caddr pt2)))(- z1 (caddr pt2)))
         )
     ); Elevation
     ((= ¦¦global¦¦ "Percent")
       (setq z1 (+(caddr pt2)(* distold(getreal "\nEnter Slope in %: ")0.01))
                 dist1 distold
       )
     ); Percent
     ((= ¦¦global¦¦ "Ratio")
       (setq z1 (+(caddr pt2)(/ distold(getreal "\nEnter Run/Rise: ")))
                 dist1 distold
       )
     ); Ratio
   ); cond

       (setq pt1 (polar pt2 ang1 dist1)
                 pt1 (list (car pt1)(cadr pt1) z1)
       )
       (if pt (setq pt pt1 pt1 pt2 pt2 pt))
       (setq B (subst(cons 10 pt1)(assoc 10 B) B)
             B (subst(cons 11 pt2)(assoc 11 B) B)
       )
       (entmod B)
       (princ "\nOld Distance=")
       (princ distold)
       (princ ", New Distance=")
       (princ dist1)
     ); progn
   ); line
   ((or(eq etype "ARC")(eq etype "POLYLINE")(eq etype "LWPOLYLINE"))
     (progn
       (command "lengthen" pick)
     ); progn
   ); ARC, POLYLINE or LWPOLYLINE
 ); cond
 (vla-EndUndoMark ActDoc)
 (princ)
)

Slope is retained by all options.

Thanks for your help. However, that routine only works with lines and requires you to know the length or displacement. Is there any way to modify it to work with pipe objects?

Thanks for your help. However, that routine only works with lines and requires you to know the length or displacement. Is there any way to modify it to work with pipe objects?

Sorry, I'm not familiar with AMEP piping interface. That's as close as I can get.

(defun c:STE (/ *error* vl ov ss pt1 pt2 mypt2 myx myy myd myz)

 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov))
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))

 (setq vl '("CMDECHO" "OSMODE")
   ov (mapcar 'getvar vl))
 (mapcar 'setvar vl '(0 255))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
       (setvar "OSMODE" 0)
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* 0.125 myd) 12)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
       (command "_.stretch" ss "" ".xy"pt1 mypt2 0))) ; xy filter on pt1
   (princ "\n<< Nothing Selected >>"))
 
 (mapcar 'setvar vl ov)
 (princ)
)

This is what I have so far, but for some reason it does not work. I probably did the point manipulation in the wrong section of code or something. Any help would be appreciated.

NOTE: Most of the code comes from the link on the first page. I am not claiming it to be my work.

Worked out all the bugs in case anyone is interested:

(defun c:STE (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz)

 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov))
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))

 (setq vl '("CMDECHO" "OSMODE")
   ov (mapcar 'getvar vl))
 (mapcar 'setvar vl '(0 255))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
       (setvar "OSMODE" 0)
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* 0.125 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2 0))) 
   (princ "\n<< Nothing Selected >>"))
 
 (mapcar 'setvar vl ov)
 (princ)
)

This is what I have so far, but for some reason it does not work. I probably did the point manipulation in the wrong section of code or something. Any help would be appreciated.

 

NOTE: Most of the code comes from the link on the first page. I am not claiming it to be my work.

Lisp is limited in working with grips. Stretch as used in Lee's yst code actually performs a move. I don't know of a way to stretch an endpoint with lisp, but it may be possible with a CUI macro. It could use the stretch command then run a lisp to modify the slope.

Is there a way to reset the slope in your software?

Lisp is limited in working with grips. Stretch as used in Lee's yst code actually performs a move. I don't know of a way to stretch an endpoint with lisp, but it may be possible with a CUI macro. It could use the stretch command then run a lisp to modify the slope.

 

Is there a way to reset the slope in your software?

If you look at the last post I made, it works for stretching at +1/8" per foot (imperial mode only). I am working on making it work for +-1/16", +-1/8" , +-1/4".

This is the first lisp routine I've made so I don't even know how to add a user input for slope...maybe someone else can help with that

(defun c:STE (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz);STRETCH WITH +1/8" PER FOOT SLOPE

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* 0.125 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2))) 
   (princ "\n<< Nothing Selected >>"))
 (princ)
)

;------------------------------------------------------------------------------------------------------

(defun c:STNE (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz);STRETCH WITH -1/8" PER FOOT SLOPE

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* -0.125 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2))) 
   (princ "\n<< Nothing Selected >>"))
 (princ)
)

;------------------------------------------------------------------------------------------------------

(defun c:STS (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz);STRETCH WITH +1/16" PER FOOT SLOPE

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* 0.0625 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2))) 
   (princ "\n<< Nothing Selected >>"))
 (princ)
)

;------------------------------------------------------------------------------------------------------

(defun c:STNS (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz);STRETCH WITH -1/16" PER FOOT SLOPE

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* -0.0625 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2))) 
   (princ "\n<< Nothing Selected >>"))
 (princ)
)

;------------------------------------------------------------------------------------------------------

(defun c:STQ (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz);STRETCH WITH +1/4" PER FOOT SLOPE

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* 0.25 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2))) 
   (princ "\n<< Nothing Selected >>"))
 (princ)
)

;------------------------------------------------------------------------------------------------------

(defun c:STNQ (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz);STRETCH WITH -1/4" PER FOOT SLOPE

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* -0.25 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2))) 
   (princ "\n<< Nothing Selected >>"))
 (princ)
)

;------------------------------------------------------------------------------------------------------

(defun c:STH (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz);STRETCH WITH +1/2" PER FOOT SLOPE

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* 0.5 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2))) 
   (princ "\n<< Nothing Selected >>"))
 (princ)
)

;------------------------------------------------------------------------------------------------------

(defun c:STNH (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz);STRETCH WITH -1/2" PER FOOT SLOPE

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* -0.5 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2))) 
   (princ "\n<< Nothing Selected >>"))
 (princ)
)

Code for sloped stretch using common gravity pipe slopes.

COMMANDS:

STE -> +1/8" per foot

STNE -> -1/8" per foot

STQ -> +1/4" per foot

STNQ -> -1/4" per foot

STS -> +1/16" per foot

STNS -> -1/16" per foot

STH -> +1/2" per foot

STNH -> -1/2" per foot

tach onexav1029,

I must admit, I do not understand what you are trying to achieve.

A drawing is worth a thousand words. Maybe you should attached one

showing before and after.

This will go a long way in helping us helping you.

ymg

Try:

(defun c:STE (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz)

 (defun *error* (msg)
   (if ov (mapcar 'setvar vl ov))
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))

 (setq vl '("CMDECHO" "OSMODE")
   ov (mapcar 'getvar vl))
 (mapcar 'setvar vl '(0 255))
 
 (if (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: "))
     )
     (progn
       (if (= slope nil)(setq slope 0.125))
       (setq tom (getreal (strcat " Slope:<" (rtos slope 2 3) ">: ")))
       (if tom (setq slope tom tom nil))
       (setvar "OSMODE" 0)
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* 0.125 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2 0)
     ) 
     (princ "\n<< Nothing Selected >>")
   )
 
 (mapcar 'setvar vl ov)
 )
 (princ)
)

(defun c:STE (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz);STRETCH WITH +1/8" PER FOOT SLOPE

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* 0.125 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2))) 
   (princ "\n<< Nothing Selected >>"))
 (princ)
)

;------------------------------------------------------------------------------------------------------

(defun c:STNE (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz);STRETCH WITH -1/8" PER FOOT SLOPE

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* -0.125 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2))) 
   (princ "\n<< Nothing Selected >>"))
 (princ)
)

;------------------------------------------------------------------------------------------------------

(defun c:STS (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz);STRETCH WITH +1/16" PER FOOT SLOPE

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* 0.0625 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2))) 
   (princ "\n<< Nothing Selected >>"))
 (princ)
)

;------------------------------------------------------------------------------------------------------

(defun c:STNS (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz);STRETCH WITH -1/16" PER FOOT SLOPE

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* -0.0625 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2))) 
   (princ "\n<< Nothing Selected >>"))
 (princ)
)

;------------------------------------------------------------------------------------------------------

(defun c:STQ (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz);STRETCH WITH +1/4" PER FOOT SLOPE

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* 0.25 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2))) 
   (princ "\n<< Nothing Selected >>"))
 (princ)
)

;------------------------------------------------------------------------------------------------------

(defun c:STNQ (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz);STRETCH WITH -1/4" PER FOOT SLOPE

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* -0.25 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2))) 
   (princ "\n<< Nothing Selected >>"))
 (princ)
)

;------------------------------------------------------------------------------------------------------

(defun c:STH (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz);STRETCH WITH +1/2" PER FOOT SLOPE

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* 0.5 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2))) 
   (princ "\n<< Nothing Selected >>"))
 (princ)
)

;------------------------------------------------------------------------------------------------------

(defun c:STNH (/ *error* vl ov ss pt1 pt2 mypt1 mypt2 myx myy myd myz);STRETCH WITH -1/2" PER FOOT SLOPE

 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*CANCEL*,*EXIT*"))
     (princ
(strcat "\n<< Error: " msg " >>")))
 (princ))
 
 (if
   (setq ss (ssget))
   (if
     (and
(setq pt1 (getpoint "\nSelect Base Point: "))
       (setq pt2 (getpoint pt1 "\nSelect Second Point: ")))
     (progn
(setq myx (- (car pt2) (car pt1))) ; sets the x axis displacement
(setq myy (- (cadr pt2) (cadr pt1))) ; sets the y axis displacement
(setq myd (sqrt (+ (* myx myx) (* myy myy)))) ;sets the distance
(setq myz (/ (* -0.5 myd) 12.0)) ; sets the z value based on 1/8" per foot
(setq mypt2 (list (car pt2) (cadr pt2) myz)) ; sets new point 2
(setq mypt1 (list (car pt1) (cadr pt1) 0.0)) ; sets new point 1 with 0 z value
       (command "_.stretch" ss "" mypt1 mypt2))) 
   (princ "\n<< Nothing Selected >>"))
 (princ)
)

Commands:

STE -> +1/8" per foot slope

STNE -> -1/8" per foot slope

STS -> +1/16" per foot slope

STNS -> -1/16" per foot slope

STQ -> +1/4" per foot slope

STNQ -> -1/4" per foot slope

STH -> +1/2" per foot slope

STNH -> -1/2" per foot slope

The only thing that is quirky is that you can't snap directly to pipe that are not at Z=0, you have to use extensions but gets the job done

I have the code working, but for some reason it won't let me post until a mod reviews it

My interpretation of a solution, pick line near end that is to be moved, pick new point, line is erased and redrawn with z based on start pt at 1/8 1/16 etc. Tombu a simple point swap so you know which end is picked.

(defun sel_obj ()
 (SETQ TP1 (entsel "\nSelect line object near end: "))
 (setq tpp1 (entget (car tp1)))     
 (setq clay (cdr (assoc 8 tpp1))) 
 (setq p1 (cdr (assoc 10 tpp1)))     
 (setq p2 (cdr (assoc 11 tpp1)))     
 (setq p3 (cadr tp1))
 (setq ht (cdr (assoc 40 tpp1))) 
 (setq el (caddr p1))             
 
 (setq d1 (distance p1 p3))
 (setq d2 (distance p2 p3))
   (if (> d1 d2)
   (progn 
   (setq temp p1)
   (setq p1 p2)
   (setq p2 temp)
   )
   )
 
)

Here is the finished routine.

STE-> stretch with +1/8" per foot slope

STNE-> stretch with -1/8" per foot slope

STS-> stretch with +1/16" per foot slope

STNS-> stretch with -1/16" per foot slope

STQ-> stretch with +1/4" per foot slope

STNQ-> stretch with -1/4" per foot slope

STH-> stretch with +1/2" per foot slope

STNH-> stretch with -1/2" per foot slope

This routine's main purpose is for sloped 3D gravity piping which uses standard plumbing code slopes

ST.LSP