« previous next »
Pages: [1] |   Go Down

Author Topic: Slope Routine  (Read 4318 times)

0 Members and 1 Guest are viewing this topic.

bman

  • Guest
Slope Routine
« on: August 05, 2004, 02:23:24 PM »
I'm trying to make some mods to this handy routine created by Keith. Here's a rundown on what the routine does:
INL = calcs lower invert calc
INU = calcs upper invert calc
SLO = calcs slope of line
In regards to the INU, INU & SLO functions, how can i modify to do the following:
    1. prompt user to draw pline in lieu of selecting a single line for calculations
    2. prompt user to pick text insertion point & rotation angle for slope label in
      lieu of defaulting to midpoint of selected line & 0 rotation
Code: [Select]
(defun INV( Pos1 Pos2 / a b c d e f a10 a11 slopeins result insp slop oce)
  (setq oce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq a (entsel (strcat "\nSelect " Pos1 " elevation: ")))
  (setq b (cdr (assoc 1 (entget (car a)))))
  (setq c (distof b))
  (setq d (entsel "\nSelect line: "))
  (setq slop (getreal "\nEnter slope percentage: "))
  (setq e (entget (car d)))
  (setq a10 (cdr (assoc 10 e)))
  (setq a11 (cdr (assoc 11 e)))
  (setq f (distance a10 a11))
  (setq slopeins (list (/(+(car a10)(car a11))2)
             (+(/(+(cadr a10)(cadr a11))2)(* (getvar "textsize")2))
             0.0))
  (if (>(cdr(assoc 40 (tblsearch "style" (getvar "textstyle"))))0)
    (command "_text" "j" "mc" slopeins "" (strcat(rtos slop 2 2)"%"))
    (command "_text" "j" "mc" slopeins "" "" (strcat(rtos slop 2 2)"%"))
  )
  (if (= Pos1 "Upper")
    (setq result (rtos (- c (/(* f slop)100))2))
    (setq result (rtos (+ c (/(* f slop)100))2))
  )
  (setq insp (getpoint (strcat "\nSelect " Pos2 " elevation insertion point: ")))
  (if (>(cdr(assoc 40 (tblsearch "style" (getvar "textstyle"))))0)
    (command "_text" "j" "mc" insp "" result)
    (command "_text" "j" "mc" insp "" "" result)
  )
  (setvar "cmdecho" oce)
  (princ)
)

(defun C:SLO( / a aa b bb c cc d e f a10 a11 slopeins result oce)
  (setq oce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq a (entsel "\nSelect Upper elevation: "))
  (setq b (cdr (assoc 1 (entget (car a)))))
  (setq c (distof b))
  (setq aa (entsel "\nSelect Lower elevation: "))
  (setq bb (cdr (assoc 1 (entget (car aa)))))
  (setq cc (distof bb))
  (setq d (entsel "\nSelect line: "))
  (setq e (entget (car d)))
  (setq a10 (cdr (assoc 10 e)))
  (setq a11 (cdr (assoc 11 e)))
  (setq f (distance a10 a11))
  (setq slopeins (list (/(+(car a10)(car a11))2)
             (+(/(+(cadr a10)(cadr a11))2)(* (getvar "textsize")2))
             0.0))
  (setq result (/(- c cc)(/ f 100)))
  (if (>(cdr(assoc 40 (tblsearch "style" (getvar "textstyle"))))0)
    (command "_text" "j" "mc" slopeins "" (strcat(rtos result 2 2)"%"))
    (command "_text" "j" "mc" slopeins "" "" (strcat(rtos result 2 2)"%"))
  )
  (setvar "cmdecho" oce)
  (princ)
)

(defun C:INL()
  (INV "Upper" "Lower")
)
(defun C:INU()
  (INV "Lower" "Upper")
)
(defun C:INV()
  (INV "Upper" "Lower")
)
(princ)
(princ "\n-----> INL to run lower invert calc")
(princ "\n-----> INU to run upper invert calc")
(princ "\n-----> SLO to run slope calc")
Logged

MSTG007

  • Gator
  • Posts: 2601
  • I can't remeber what I already asked! I need help!
Slope Routine
« Reply #1 on: August 05, 2004, 02:38:56 PM »
NICE routine!
Logged
Civil3D 2020

bman

  • Guest
Slope Routine
« Reply #2 on: August 05, 2004, 04:56:22 PM »
Yep, i use it for storm, sanitary & grading for smaller sites that don't require LDD.

Credit goes to Keith
Logged

t-bear

  • Guest
Slope Routine
« Reply #3 on: August 05, 2004, 10:52:36 PM »
Keith who?   LOLOL
Logged

MSTG007

  • Gator
  • Posts: 2601
  • I can't remeber what I already asked! I need help!
Slope Routine
« Reply #4 on: August 06, 2004, 07:37:41 AM »
does this work for calcing grades on a site grading plan???? when you have one good known elevation and a direction with a slope.... or something...?
Logged
Civil3D 2020

bman

  • Guest
Slope Routine
« Reply #5 on: August 06, 2004, 07:50:20 AM »
It calcs either the upper or lower elevation based on user slope & line...
also calcs the slope if upper & lower elevation are known
Logged

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Slope Routine
« Reply #6 on: August 06, 2004, 09:13:26 AM »
This will get you started.
I will be away for a week so someone else may be will to answer questions.
CAB

Code: [Select]
(defun INV( Pos1 Pos2 / a b c d e f a10 a11 slopeins result insp slop oce)
  (setq oce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq a (entsel (strcat "\nSelect " Pos1 " elevation: ")))
  (setq b (cdr (assoc 1 (entget (car a)))))
  (setq c (distof b))
 
  ;;(setq d (entsel "\nSelect line: "))
  (setq p1 (getpoint "\nDraw the line, Enter starting point: "))
  (setq p2 (getpoint p1 "\nEnter end point: "))
  (if (and p1 p2)
    (command "._line" p1 p2 "")
    (quit)
  )
  (setq e (entget(entlast)))
  ;(setq e (entget (car d)))
 
  (setq slop (getreal "\nEnter slope percentage: "))
  (setq a10 (cdr (assoc 10 e)))
  (setq a11 (cdr (assoc 11 e)))
  (setq f (distance a10 a11))
  ;(setq slopeins (list (/(+(car a10)(car a11))2)
  ;           (+(/(+(cadr a10)(cadr a11))2)(* (getvar "textsize")2))
  ;           0.0))
  (prompt "\nSelect location and angle for slope.")
  (if (>(cdr(assoc 40 (tblsearch "style" (getvar "textstyle"))))0)
    (command "_text" "j" "mc" pause pause (strcat(rtos slop 2 2)"%"))
    (command "_text" "j" "mc" pause "" pause (strcat(rtos slop 2 2)"%"))
  )
 
  (if (= Pos1 "Upper")
    (setq result (rtos (- c (/(* f slop)100))2))
    (setq result (rtos (+ c (/(* f slop)100))2))
  )
  (setq insp (getpoint (strcat "\nSelect " Pos2 " elevation insertion point: ")))
 
  (if (>(cdr(assoc 40 (tblsearch "style" (getvar "textstyle"))))0)
    (command "_text" "j" "mc" insp "" result)
    (command "_text" "j" "mc" insp "" "" result)
  )
  (setvar "cmdecho" oce)
  (princ)
)

(defun C:SLO( / a aa b bb c cc d e f a10 a11 slopeins result oce)
  (setq oce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq a (entsel "\nSelect Upper elevation: "))
  (setq b (cdr (assoc 1 (entget (car a)))))
  (setq c (distof b))
  (setq aa (entsel "\nSelect Lower elevation: "))
  (setq bb (cdr (assoc 1 (entget (car aa)))))
  (setq cc (distof bb))
  ;(setq d (entsel "\nSelect line: "))
  ;(setq e (entget (car d)))
  (setq p1 (getpoint "\nDraw the line, Enter starting point: "))
  (setq p2 (getpoint p1 "\nEnter end point: "))
  (if (and p1 p2)
    (command "._line" p1 p2 "")
    (quit)
  )
  (setq e (entget(entlast)))

 
  (setq a10 (cdr (assoc 10 e)))
  (setq a11 (cdr (assoc 11 e)))
  (setq f (distance a10 a11))
  ;;(setq slopeins (list (/(+(car a10)(car a11))2)
  ;;           (+(/(+(cadr a10)(cadr a11))2)(* (getvar "textsize")2))
  ;;           0.0))
  (setq result (/(- c cc)(/ f 100)))
 
  (prompt "\nSelect location and angle for slope.")

  (if (>(cdr(assoc 40 (tblsearch "style" (getvar "textstyle"))))0)
    (command "_text" "j" "mc" pause pause (strcat(rtos result 2 2)"%"))
    (command "_text" "j" "mc" pause "" pause (strcat(rtos result 2 2)"%"))
  )
  (setvar "cmdecho" oce)
  (princ)
)

(defun C:INL()
  (INV "Upper" "Lower")
)
(defun C:INU()
  (INV "Lower" "Upper")
)
(defun C:INV()
  (INV "Upper" "Lower")
)
(princ)
(princ "\n-----> INL to run lower invert calc")
(princ "\n-----> INU to run upper invert calc")
(princ "\n-----> SLO to run slope calc")
Logged
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

bman

  • Guest
Slope Routine
« Reply #7 on: August 06, 2004, 11:15:43 AM »
thanks cab... i'll try to modify but it may be too complex for a lisp newbie like myself
Logged

JohnK

  • Administrator
  • Seagull
  • Posts: 10637
Slope Routine
« Reply #8 on: August 06, 2004, 02:05:10 PM »
Yove _GOT_ to be kidding me?! At lunch i was thinking about writing a small tutorial on line slope and other basic calc's you can preform on a line...basicly, creating an intro for beginer lispers. (It's not the same as Keiths progy, but still!!) That is freekin' weird that you brought up "slope"!

...I swear i didnt see this thread and i was really thinking about writing a tutorial for the "teach me" forum. lol
Logged
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Slope Routine
« Reply #9 on: August 06, 2004, 02:43:26 PM »
I wrote this one some time ago, and I haven't had the time update it.
Logged
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie
Pages: [1] |   Go Up
« previous next »