3d Polyline slope routine needed

[Anonymous]

Im in need of a command or routine that will take a flat polyline and slope it at a certain degree or run. 

For example, I drew a polyline from point A to B.  It includes arcs and straights and isnt closed.  I want to set point A at some elevation like 12'-0",  and then have a routine that will slope the polyline consistently from A to B at 1/4" every 12" or even 5/16" every 12".  Is there something like that anywhere or can someone help me out please?  Id be really grateful.

[devitg]

Please upload your sample.dwg

[Sea-Haven]

Do you want it as points then pretty easy the pline has a length so can work out a xy at a distance getpointatdist, The ratio of the rise * dist / length gives the Z value. The other way is to use trans and a UCS of the plane of the pline start and end points.

[Kent1Cooper]

---

@Sea-Haven wrote:

.... The other way is to use trans and a UCS of the plane of the pline start and end points.

---

That won't do what they want, if I understand correctly.  I think that would be the equivalent of just tilting the Polyline [and stretching it some within the tilted plane], which will give different slopes across segments running in different original directions, and depending on the shape, could even have some stretches sloping up instead of down, or vice versa, or not at all in the middle segment in this example:

@Anonymous , be aware that any arc segments in the original will not be able to remain arcs.  3DPolylines can't contain those, and LWPolylines and 2D "heavy" Polylines that can must lie in a single plane, which will suit your result only very rarely.  They will need to be broken up into line segments [lots of short ones if needed], or with a lot more working out, maybe they could become Splines.

[Anonymous]

I attached a sample of a pline that starts at elevation 17'-0" and the slope is 1/4"/ft.  The pline is 100'-0" long so the drop in elevation is 25". (100' * .25")

What im looking for is a way to make this "flat" polyline actually look 3d and go downhill (like a spring) at the 1/4"=1'-0" slope or whatever slope I choose.  Then I can view it in 3d space and see if it interferes with other items in a building etc.

In the sample drawing I placed an exaggerated slope example of what I want the finished pline to look like.  

So Basically I want a command or routine that I can pick that flat pline at el. 17'-0" and make it run downhill all the way to el. 14'-11"

[john.uhden]

Attached is one of my favorites originated in 1999... 3DEDIT.lsp

It allows you to add/remove vertices and transition slopes/grades from any 3DPolyline vertex to another, or just edit each vertex elevation individually, or combinations thereof.

I use it for grading lots and sites.  I hope you are okay with using % grades instead of inches per foot, e.g.

0.25"/ft = 2%±

[devitg]

Hi John,  have a good day . Please upload 

Use M3D to convert it to 3D

[Anonymous]

Yes I can see where this is useful for civil grading but for what I need (arcs, etc) it doesnt work. 😞

I dont know lisp anymore but I think I need a routine that will explode my polyline into regular lines and arcs.  It will prompt me for the slope (i.e. 1/4"/ft).  Then it will step through the lines and arcs starting from the end I pick, (save the line length in feet) and lower the other endpoint by the slope  (1/4* (saved line length in feet)) then onto the next endpoint and lower that one by the last amount plus the slope distance of this line.  Then when it gets to an arc, (save that arcs radius), drop the lines end points and fillet them back together again etc

Anyone know how to do this or can help me?

[Kent1Cooper]

---

@Anonymous wrote:

.....  Then when it gets to an arc, (save that arcs radius), drop the lines end points and fillet them back together again etc ....

---

That particular part strikes me as probably geometrically impossible.  The Lines on either side of an Arc in that situation, running in different directions, will virtually never end up co-planar [they might in some very rare relationship], so it won't be possible to Fillet them.

Besides, even when [if] they're Filletable, a tilted Arc does not have the same slope at one end as at the other, so your concept of "consistent" slope along the whole things is out the window.

Geometrically speaking, I think what you need for what was originally in 2D an Arc would be a Helix.

[john.uhden]

Good catch.

BTW, if he converts his arcs into polylines, then he's good to go.

Hmm, where did the 'add file' button go?  Oh, well, copy 'n paste.

(defun C:M3D ( / *error* @reset |acdb |e0 |i |e |ent |etyp |flag |str |layer |ans
                 |filter |ss |ssl$ |closed |end |bulge |sign |delta |bc |ec |chord
                 |chang |r |rp |arc |ang |inc |n |delete @nxtvrt @m3d |cmd |layers
                 |space |active |layout)
   ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
   ;*                                                                           *
   ;*         M3D.LSP    by     John F. Uhden                                   *
   ;*                           2 Village Road                                  *
   ;*                           Sea Girt, NJ  08750                             *
   ;*                                                                           *
   ;* * * * * * * * * * * *  Do not delete this heading!  * * * * * * * * * * * *

   ; Routine converts a 2D polyline into a 3D polyline.

   ; v3.0 (10-18-97) added R14 LWPOLYLINE conversion; plus
   ;      took WEED'EM filter code to alow multiple section, and
   ;      added @cv_check_lock function.
   ; v4.0 (8-14-99) added capability to add vertices along curved segments
   ;      for R13 and higher only, plus included ARCS and choice to delete
   ;      or retain existing objects.  Since given the choice, R12 can be
   ;      treated the same way as R13+.
   ;      Also had to do a lot of fixing of |flag values (code 70) since
   ;      R14 gacks on (entmake)ing 3D polylines with the 128-bit set.
   ; v15.00 (04-07-00) for R15
   ;        (12-17-00) added removal of entity name and handle
   ;        (12-17-00) added multiple picks for Picklayer option
   ;        (12-18-00) corrected |filter to use of |active and |layout
   ; v15.01 (09-13-02) simplified dxf removal; added removal of owner;
   ;        added check to avoid "divide by zero" error

   (gc)
   (prompt "\nM3D v15.01 (c)1994-2002, John F. Uhden, Cadlantic")

   (defun *error* (|err)
      (@reset)
      (if (wcmatch (strcase |err) "*CANCEL*,*QUIT*")
         (vl-exit-with-error "\r                                              ")
         (vl-exit-with-error (strcat "\r*ERROR*: " |err))
      )
   )
   (defun @reset ()
      (if (= (type |cmd) 'INT)(setvar "cmdecho" |cmd))
      (@cv_undo_end)
       (princ)
   )
   ;;-------------------------------------------
   ;; Initialize drawing and program variables:
   ;;
   (if (> (getvar "cvport") 1)
      (setq |space 0)
      (setq |space 1)
   )
   (setq |cmd (getvar "cmdecho")
         |active (@cv_get_activelayout)  ; added 12-18-00
         |layout (if (= |space 0) "Model" |active)
         |filter (list (cons 0 "ARC,POLYLINE,LWPOLYLINE")(cons 410 |layout)(cons -4 "<NOT")(cons -4 "&")(cons 70 (+ 8 16 32 64))(cons -4 "NOT>"))
   )

   (defun @entmake (|ent / |tmp)
      (setq |tmp (entmake |ent))
      (if (null |tmp)
         (progn
            (textscr)
            (prompt "\nUnable to make the following entity:\n")
            (prin1 |ent)(terpri)
            (exit)
         )
      )
   )
   (defun @nxtvrt (|en / |el |typ |gotit)
      (setq |gotit nil |en (entnext |en))
      (while (not |gotit)
         (setq |el (entget |en) |typ (cdr (assoc 0 |el)))
         (if (= |typ "VERTEX")
            (if (= (logand 16 (cdr (assoc 70 |el))) 16) ; spline control point
               (setq |en (entnext |en))
               (setq |gotit 1)
            )
            (progn
               (if |closed
                  (setq |en (entnext (cdr (assoc -2 |el))))
                  (setq |gotit 1 |en nil)
               )
               (setq |end 1)
            )
         )
      )
      |en
   )
   ;;---------------------------------------------------------
   ;; Function boiled down to process each 2D polyline entity:
   ;;
   (defun @m3d (|e / |e0 |ent |etyp |flag |layer |acdb |bulge |bc |ec |next
                     |sign |delta |chord |chang |r |rp |ang |inc |n |p)
      (if (not |delete)
         (progn
            (command "_.copy" |e "" "0,0,0" "@")
            (setq |e (entlast))
         )
      )
      (setq |e0 |e
           |ent (entget |e)
          |etyp (cdr (assoc 0 |ent))
         |layer (cdr (assoc 8 |ent))
      )
      (if (= |etyp "ARC")
         (progn
            (command "._PEDIT" |e0 "_Y" "")
            (setq |e0 (entlast)
                  |e |e0
                  |ent (entget |e)
                  |etyp (cdr (assoc 0 |ent))
            )
         )
      )
      (if (= |etyp "LWPOLYLINE")
         (command "_.CONVERTPOLY" "_H" |e0 "")
      )
      (setq |ent (entget |e)
            |flag (cdr (assoc 70 |ent))
            |closed (= (logand 1 |flag) 1)
            |end nil
      )
      ;; Simplified dxf removal (09-13-02)
      ;; Remove the entity name (-1), handle (5), and owner (330)
      (setq |ent (vl-remove-if (function (lambda (x)(vl-position (car x)'(-1 5 330)))) |ent))
      ;; Add the 8-bit for a 3D Polyline entity
      (setq |flag (boole 7 8 |flag))
      ;; Remove the 128-bit (plinegen) for a 3D Polyline entity
      (setq |flag (boole 4 128 |flag))
      (setq |ent (subst (cons 70 |flag)(assoc 70 |ent) |ent))
      ;; The following added for R13 (6-29-96)...
      (if (vl-position (setq |acdb '(100 . "AcDb2dPolyline")) |ent)
         (setq |ent (subst '(100 . "AcDb3dPolyline") |acdb |ent))
      )
      (entmake)
      (@entmake |ent)
      (while (and (not |end)(setq |e (@nxtvrt |e)))
         (setq |ent (entget |e)
               ;; Simplified dxf removal (09-13-02)
               ;; Remove the entity name (-1), handle (5), and owner (330)
               |ent (vl-remove-if (function (lambda (x)(vl-position (car x)'(-1 5 330)))) |ent)
               |flag (cdr (assoc 70 |ent))
               ;; Add the 32-bit for a 3D Polyline Vertex entity
               |flag (boole 7 32 |flag)
               |ent (subst (cons 70 |flag)(assoc 70 |ent) |ent)
               |bulge (cdr (assoc 42 |ent))
               ;; v3.0 "must change the bulge to zero:"
               |ent (subst (cons 42 0.0)(assoc 42 |ent) |ent)
         )
         ; The following added for R13 (6-29-96)...
         (if (vl-position (setq |acdb '(100 . "AcDb2dVertex")) |ent)
            (setq |ent (subst '(100 . "AcDb3dPolylineVertex") |acdb |ent))
         )
         (foreach n '(71 72 73 74)
            (if (null (assoc n |ent))
               (setq |ent (append |ent (list (cons n 0))))
            )
         )
         (cond
            ((and
               (/= |bulge 0.0)
               (setq |next (@nxtvrt |e))
               (setq |bc    (cdr (assoc 10 |ent))
                     |ec    (cdr (assoc 10 (entget |next)))
                     |sign  (/ |bulge (abs |bulge))
                     |delta (* 4.0 (atan |bulge))
                     |chord (distance |bc |ec)
                     |chang (angle |bc |ec)
                     |r     (abs (/ |chord 2.0 (sin (/ (abs |delta) 2.0))))
                     |arc   (* |r (abs |delta))
                     |rp    (polar |bc (+ |chang (* (- pi (abs |delta)) |sign 0.5)) |r)
                     |ang   (angle |rp |bc)
                     |n     (fix (/ |arc $cv_maxd))
               )
               (> |n 1) ;; added check to avoid "divide by zero" error
               (setq |inc (/ |delta |n))
             ) ; and
               (repeat |n
                  (@entmake |ent)
                  (setq |ang (+ |ang |inc)
                        |p   (polar |rp |ang |r)
                        |ent (subst (cons 10 |p)(assoc 10 |ent) |ent)
                  )
               )
            )
            (1 (@entmake |ent))
         )
      )
      (entdel |e0)
      (@entmake (list '(0 . "SEQEND")(cons 8 |layer)))
   )

   (@cv_undo_group)
   (initget "All Layers Manually Picklayer")
   (setq |ans (getkword "\nSelection method, All/Layers/Picklayer/<Manually>: "))
   (cond
      ((= |ans "All")
         (prompt "\nGetting ALL 2D ARCS and POLYLINES... ")
         (setq |ss (ssget "X" |filter))
      )
      ((= |ans "Layers")
         (setq |ans (getstring "\nLayer names <*>: "))
         (if (= |ans "")(setq |layer "*")(setq |layer |ans))
         (prompt "\nGetting all 2D ARCS and POLYLINES on selected layer(s)... ")
         (setq |ss (ssget "X" (append (list (cons 8 |layer)) |filter)))
      )
      ((= |ans "Picklayer")
         (while (setq |e (car (entsel "\nSelect object on desired layer:")))
            (setq |layer (cdr (assoc 8 (entget |e)))
                  |layers (@cv_add_list |layer |layers)
            )
            (princ (strcat "\nLayers: " (@cv_list2str |layers)))
         )
         (if |layers
            (progn
               (setq |layers (@cv_list2str |layers))
               (prompt (strcat "\nGetting all 2D ARCS and POLYLINES on layer(s) " |layers "... "))
               (setq |ss (ssget "X" (append (list (cons 8 |layers)) |filter)))
            )
         )
      )
      (1 (prompt "\nDon't worry about selecting objects that are not 2D ARCS or POLYLINES.")
         (prompt "\nThey will be filtered out of selection set.")
         (setq |ss (ssget |filter))
      )
   )
   (if (and |ss (setq |ss (@cv_check_lock |ss nil)))
      (progn
         (initget "Yes No")
         (setq |delete (/= (getkword "\nDelete existing objects?  <Yes>/No: ") "No"))
         (if (or (/= (type $cv_maxd) 'REAL)(<= $cv_maxd 0.0))
            (if (< (getvar "LUNITS") 3)
               (setq $cv_maxd 0.5)
               (setq $cv_maxd 6.0)
            )
         )
         (initget 6)
         (if (setq |ans (getdist (strcat "\nDistance to add vertices along curved segments <" (rtos $cv_maxd) ">: ")))
            (setq $cv_maxd |ans)
         )
         (setvar "cmdecho" 0)
         (prompt (strcat "\n" (itoa (sslength |ss)) " selected\n."))
         (setq |i 0 |ssl$ (itoa (sslength |ss)))
         (repeat (sslength |ss)
            (setq |e (ssname |ss |i)
                  |i (1+ |i)
            )
            (prompt (strcat "\rProcessing # " (itoa |i) "/" |ssl$))
            (@m3d |e)
         )
      )
   )
   (@reset)
)

[Anonymous]

In my example I attached, I was able to fillet them but I see that it cut the arcs down from 90 degrees to like 89 or 88 degrees to make them work.  It still looks like 90 degrees in world view though which is good.  And realistically its close enough for what we do here. 

I know what I want but I just dont know how to explain it any better I guess. (than the example I already attached).  You would think that a plumber would have come up with this by now for his/her piping runs for drains. 

[devitg]

Could it be so 

;; Design by Gabo CALOS DE VIT from CORDOBA ARGENTINA
;;;    Copyleft 1995-2020 by Gabriel Calos De Vit ; DEVITG@GMAIL.COM    
;;

 ; Hecho por  Gabo CALOS DE VIT de CORDOBA ARGENTINA
;;;    Copyleft 1995-2020 por Gabriel Calos De Vit 
;; DEVITG@GMAIL.COM 


;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*


(DEFUN &-3DPOLY/LISTXYZ  (LISTA)

  (DEFUN DT:LIST-FLATTEN  (LISTE /) ; not mine 
    (COND
      ((NULL LISTE) NIL)
      ((ATOM LISTE) (LIST LISTE))
      (1
       (APPEND (DT:LIST-FLATTEN (CAR LISTE))
               (DT:LIST-FLATTEN (CDR LISTE))))
      )
    ) ;_ DT:LIST-FLATTEN
  (DEFUN I:POINTS  (PTLIST) ; not mine 
    (VL-LOAD-COM)
    (VLAX-SAFEARRAY-FILL
      (VLAX-MAKE-SAFEARRAY
        VLAX-VBDOUBLE
        (CONS 0 (1- (LENGTH PTLIST)))
        )
      PTLIST
      )
    ) ;_end defun i:Points
  ;;/------------------------------------------------------------------

  (SETQ FLAT-LIST (DT:LIST-FLATTEN LISTA))
  (SETQ SAF (I:POINTS FLAT-LIST))
  (VLA-ADD3DPOLY MODEL SAF)
  )



 ; initionn  
(DEFUN 2D-TO-SLOPED-3D  (/
                         2D-POLY-OBJ
                         2D-POLY-OBJ-SS
                         2D-POLY-SS
                         ACAD-OBJ
                         ADOC
                         ALL-STEP
                         END-PARAM
                         END-POINT
                         LAP
                         MODEL
                         N
                         NEW-Z-PT
                         NEW-Z-PT-LIST
                         NEW3DPOLY
                         PARAM-STEP
                         POLY-LENGTH
                         PT-DIST
                         PT@PARAM
                         SELECTIONSETS
                         SLOPE
                         SLOPE-STEP
                         START-PARAM
                         START-POINT
                         STEP)
  (VL-LOAD-COM)
  (SETQ ACAD-OBJ (VLAX-GET-ACAD-OBJECT)) ;_ el programa ACAD 
  (SETQ ADOC (VLA-GET-ACTIVEDOCUMENT ACAD-OBJ)) ;_ el DWG que esta abierto-
  (SETQ MODEL (VLA-GET-MODELSPACE ADOC))
  (SETQ SELECTIONSETS (VLA-GET-SELECTIONSETS ADOC))
;;;  (get-it)


  (SETQ STEP 0.250) ; fix to need 
  (SETQ LAP 12) ; fix to need 

  (SETQ SLOPE (- (/ STEP LAP)))
 ;-0.0208333 

  (SETQ 2D-POLY-SS (SSGET ":s" '((0 . "POLYLINE"))))
  (COMMAND "ucs" "World")

  (SETQ 2D-POLY-OBJ-SS (VLA-GET-ACTIVESELECTIONSET ADOC))

  (SETQ 2D-POLY-OBJ (VLA-ITEM 2D-POLY-OBJ-SS 0))
  (SETQ POLY-LENGTH (VLA-GET-LENGTH 2D-POLY-OBJ))
  (SETQ START-POINT (VLAX-CURVE-GETSTARTPOINT 2D-POLY-OBJ))
  (SETQ END-POINT (VLAX-CURVE-GETENDPOINT 2D-POLY-OBJ))
  (SETQ START-PARAM (VLAX-CURVE-GETSTARTPARAM 2D-POLY-OBJ))
  (SETQ END-PARAM (VLAX-CURVE-GETENDPARAM 2D-POLY-OBJ))

  (SETQ N START-PARAM)
  (SETQ PARAM-STEP 0.01)
  (SETQ ALL-STEP (/ END-PARAM PARAM-STEP))
  (SETQ NEW-Z-PT-LIST ())
  (REPEAT (FIX ALL-STEP)

    (SETQ N (+ N PARAM-STEP))


    ) ; end repeat
  ;; teh last point 
  (SETQ PT@PARAM (VLAX-CURVE-GETPOINTATPARAM 2D-POLY-OBJ N))
  (SETQ PT-DIST (VLAX-CURVE-GETDISTATPARAM 2D-POLY-OBJ N))
  (SETQ SLOPE-STEP (* PT-DIST SLOPE))
  (SETQ NEW-Z-PT (MAPCAR '+ PT@PARAM (LIST 0 0 SLOPE-STEP)))
  (SETQ NEW-Z-PT-LIST (CONS NEW-Z-PT NEW-Z-PT-LIST))


  (SETQ NEW3DPOLY (&-3DPOLY/LISTXYZ NEW-Z-PT-LIST))
  ) ; end 2D-TO-SLOPED-3D

(DEFUN 2D-SLOPE  ()
  (2D-TO-SLOPED-3D)
  )


;|«Visual LISP© Format Options»
(180 2 1 0 nil "end of " 100 20 2 2 nil nil T nil T)
;*** DO NOT add text below the comment! ***|;

[Anonymous]

YES! Thats what I want.  Now forgive my noobiness but how do you start this routine?  I loaded it with AP but whats the command to start it?

[john.uhden]

The 3DEDIT program uses the command 3DE.
The M3D program uses the command M3D.
They are actually not AutoCAD commands, so don't try to use (command "3DE").

[Sea-Haven]

Back to me if you just want to view it in 3d then you can make it with very short 3dpoly segments. Say 3" this will handle arc and should be with in the tolerance of objects intersecting. 

As I said earlier even for a zig zag this is a pipe solution so grade is constant no matter which bit so doing getpointatdist is very easy and make a 3dpoly. 100' = 400 segments. A version2 could increase the arc -> chords calcs to increase accuracy.

Have to go right now will try later today to put something together.

[devitg]

Please forgive MY NOOBNESS. I made a last time change and I made a MISTAKE 

Find attached . 

[Sea-Haven]

This is as simple as it gets, as I work in metric a bit easier, 

(setq obj (vlax-ename->vla-object (car (entsel "pick object "))))
(setq end (vlax-curve-getendpoint  Obj))
(setq start (vlax-curve-getstartpoint  Obj))
(setq len (vla-get-length obj))
(setq diff 3.0) ; ht diff
(setq spc (getreal "enter spacing "))
(setq num(fix  (/ len spc)))
(setq dist 0 )
(command "3dpoly" start)
(repeat num
(setq dist (+ dist spc))
(setq newpt (vlax-curve-getpointatdist obj dist))
(setq z (* (/ dist len) diff) )
(command (list (car newpt)(cadr newpt) z))
)
(command (list (car end)(cadr end) endz) "")

I will add the check bottom end or top user choice, if the pline is drawn L->R or R->L also the rise/run factor as well as start elevation. If it has a "elev" use that. I have to think a bit more for feet slopes. 

Point A is start. But still check has not drawn pline backwards.

[Sea-Haven]

Please note this is not finished code but a simpler alternative.

[Sea-Haven]

Mr Autodesk about time to update forum so can update previous code every body elses support this.

Any way have a look at this probably more improvements can be added. A bit tricky working feet and inches.

(defun c:slopepl ( /  (D1 D2 DIFF DIST ELEV END ENT LEN NUM OBJ OLDSNAP PT SLP SPC START TEMP Z)
; draw 3d poly using existing 2d pline using short 3d line segemnts
; By Alan H Jan 2020

(setq oldsnap (getvar 'osmode))

(defun cvfrac (str / pos dec1 dec2)
(setq pos (vl-string-search "/" str))
(if (not pos)
(princ (atof str))
(progn
(setq dec1 (atof (substr str 1 pos)))
(setq dec2 (atof (substr str (+ pos 2))))
(princ (/ dec1 dec2))
)
)
)

(setq ent (entsel "\npick object "))
(setq pt (cadr ent))
(setq obj (vlax-ename->vla-object (car ent)))
(setq end (vlax-curve-getendpoint  Obj))
(setq start (vlax-curve-getstartpoint  Obj))
(setq len (vla-get-length obj))
(setq d1 (distance pt end))
(setq d2 (distance pt start))
(if (< d1 d2)
(progn
(setq temp end)
(setq end start)
(setq start temp)
(reverse ent)
)
)
(setq elev (Getreal "\nEnter top elevation"))
(setq slp (cvfrac (getstring "\nEnter slope as fraction of inch per foot ")))
(setvar 'osmode 0)
(setq diff (/ (* (/ len 12.0) slp) 12.0))
(setq spc (getreal "\nEnter spacing in inches") )
(setq num (fix  (/ len spc)))
(setq dist 0.0 )
(command "_3dpoly" )
(command start)
(repeat  (- num 1)
(setq dist (+ dist spc))
(setq pt (vlax-curve-getpointatdist obj dist))
(setq z (- elev (* (/ dist len) diff) ))
(command (list (car pt)(cadr pt) z))
)
(setq pt (list (car end)(cadr end) (- elev diff)))
(command pt)
(command "")

(alert "finished")

(setvar 'osmode oldsnap)

(princ)
)
(c:slopepl)

[Anonymous]

Im getting "a malformed list on input" when I load this.  Something missing?

E