xav1029 Posted September 14, 2015 Share Posted September 14, 2015 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#. Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 15, 2015 Share Posted September 15, 2015 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]) Quote Link to comment Share on other sites More sharing options...
xav1029 Posted September 15, 2015 Author Share Posted September 15, 2015 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? Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 15, 2015 Share Posted September 15, 2015 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. Quote Link to comment Share on other sites More sharing options...
tombu Posted September 15, 2015 Share Posted September 15, 2015 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. Quote Link to comment Share on other sites More sharing options...
xav1029 Posted September 15, 2015 Author Share Posted September 15, 2015 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 Quote Link to comment Share on other sites More sharing options...
xav1029 Posted September 15, 2015 Author Share Posted September 15, 2015 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? Quote Link to comment Share on other sites More sharing options...
tombu Posted September 15, 2015 Share Posted September 15, 2015 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. Quote Link to comment Share on other sites More sharing options...
xav1029 Posted September 15, 2015 Author Share Posted September 15, 2015 (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. Quote Link to comment Share on other sites More sharing options...
xav1029 Posted September 15, 2015 Author Share Posted September 15, 2015 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) ) Quote Link to comment Share on other sites More sharing options...
tombu Posted September 15, 2015 Share Posted September 15, 2015 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? Quote Link to comment Share on other sites More sharing options...
xav1029 Posted September 15, 2015 Author Share Posted September 15, 2015 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 Quote Link to comment Share on other sites More sharing options...
xav1029 Posted September 15, 2015 Author Share Posted September 15, 2015 (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 Quote Link to comment Share on other sites More sharing options...
ymg3 Posted September 15, 2015 Share Posted September 15, 2015 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 Quote Link to comment Share on other sites More sharing options...
tombu Posted September 15, 2015 Share Posted September 15, 2015 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) ) Quote Link to comment Share on other sites More sharing options...
xav1029 Posted September 15, 2015 Author Share Posted September 15, 2015 (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 Quote Link to comment Share on other sites More sharing options...
xav1029 Posted September 15, 2015 Author Share Posted September 15, 2015 I have the code working, but for some reason it won't let me post until a mod reviews it Quote Link to comment Share on other sites More sharing options...
BIGAL Posted September 16, 2015 Share Posted September 16, 2015 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) ) ) ) Quote Link to comment Share on other sites More sharing options...
xav1029 Posted September 16, 2015 Author Share Posted September 16, 2015 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.