Topic: Engineering Site Grading question

[MSTG007]

Gotta a good question!

When designers on a site design a site and need to calc spot elevations at top of curb bottom of curb, side walks, building Finish floors... They usually need to carry the Fin Floor elev through out of the rest of the site.

would it make it sense to have a lsp or something which can calc the grade for you?

ex.

input fin floor elev. = 800.00

asks what slope. = -2%

then asks the starting point and a ending point for a distance

then places a spot elevation at the second point of where you got the distance to show you what the spot elevation is


does this make sense? or is there another easier idea?

thanks!!!!!!!!!!

[CarlB]

Yes a routine like that might be helpful in setting elevations in a uniformly graded area.  But when using automation be careful not to abandon critical thinking.  Such as - what is drop from FF to adjacent grade (different at doorways and landscaped areas), drop at edge sidewalk (6" approx), the slope away from building different than slope along building so a constant grade applies only in one direction, etc......

[MSTG007]

is this possible?

[CAB]

is this possible?

Yes it is very easy.
But as Carl pointed out the user has to be careful how it is applied.

[CADaver]

I have a little slope calculator I wrote a long time ago that will calc elevations based on a starting elevation and the percent slope and multiple selection points.  I use it for underground pipe calcs, but it'll work on uniformly sloped grades as well.

Code: [Select]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Slope calculator  V2.3, 1987, '88, '90, '92, '94
;; by RBCulp - Falcon Design Services, Inc.
;;
;; NO RIGHTS RESERVED; Any and all content may reproduced by any method on any medium for any reason.
;; Please, feel free to use any part found useful, interesting, enlightening or entertaining.
;; If by some chance, someone wishes to be credited for this, go right ahead.
;;
;; Falcon Design Services (FDS) provides this program "as is" and with all faults.
;; FDS specifically disclaims any implied warranty of merchantability or fitness for a particular use.  
;; FDS does not warrant that the operation of the program will be uninterrupted or error free.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:slcalc ()
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;Set defaults on first use
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (= stelev nil)  (setq stelev 1200.00))
(if (= endelev nil) (setq endelev 1188.00))
(if (= slope nil)   (setq slope -0.002))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;Slope Calculator based on Percent Slope
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun slcalcs ( / nstelev nslope distm dist1 nxtelev firstpt PT1 PT2)
     (if (setq nstelev (getdist (strcat "Enter Starting Elevation <" (RTOS stelev) ">: ")))
(setq stelev nstelev)
     )
     (if (setq nslope (getreal (strcat "Enter Slope Factor (Negative For Down) <" (RTOS slope 2 8) ">: ")))
(setq slope nslope)
     )
      (setq FIRSTPT (getpoint "Pick point ")
   PT2 (getpoint FIRSTPT "\nNext point ")
   distm (distance firstpt pt2)
   nxtelev (+ (* distm slope) stelev)
      )
    (princ (strcat "\n                        Distance is  " (rtos (distance firstpt pt2))))
    (princ (strcat "\n                           Slope is  " (rtos (* distm slope))))
    (princ (strcat "\n                       Elevation is  " (rtos nxtelev)))
    (princ (strcat "\n                       Elevation is  " (rtos (/ nxtelev 12.0) 2 2)"'"))
      (while (/= PT2 nil)
(setq PT1 PT2)
(setq PT2 (getpoint PT1 "\n\nNext point "))
(if (/= PT2 nil)
 (progn
   (setq dist1 (distance pt1 pt2)
 distm (+ distm dist1)
 nxtelev (+ (* dist1 slope) nxtelev)
   )
   (princ (strcat "\n                        Distance is  " (rtos dist1)))
   (princ (strcat "\n                           Slope is  " (rtos (* dist1 slope))))
   (princ (strcat "\n                       Elevation is  " (rtos nxtelev)))
          (princ (strcat "\n                       Elevation is  " (rtos (/ nxtelev 12.0) 2 2)"'"))
   (princ (strcat "\n                     Running Total Distance is  " (rtos distm)))
 )
)
      )
    (princ (strcat "\n                       Final Total Distance is  " (rtos distm)))
    (princ (strcat "\n                   Final Total Slope Change is  " (rtos (* distm slope))))
    (princ (strcat "\n                            Final Elevation is  " (rtos nxtelev)))
    (princ (strcat "\n                            Final Elevation is  " (rtos (/ nxtelev 12.0) 2 2)"'"))
    (princ)
    )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;Slope Calculator based on Start and End Elevations
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (defun slcalce ( / nstelev nendelev distm dist1 nxtelev firstpt PT1 PT2)
      (if (setq nstelev (getdist (strcat "Enter Starting Elevation <" (RTOS stelev) ">: ")))
 (setq stelev nstelev)
      )
      (if (setq nendelev (getdist (strcat "  Enter Ending Elevation <" (RTOS endelev) ">: ")))
 (setq endelev nendelev)
      )
      (setq slope (- 0.0 (- stelev endelev))
   FIRSTPT (getpoint "Pick point ")
   PT2 (getpoint FIRSTPT "\nNext point ")
   distm (distance firstpt pt2)
      )
   (princ (strcat "\n                         Distance is  " (rtos (distance firstpt pt2))))
      (while (/= PT2 nil)
(setq PT1 PT2)
(setq PT2 (getpoint PT1 "\n\nNext point "))
(if (/= PT2 nil)
 (progn
   (setq dist1 (distance pt1 pt2)
 distm (+ distm dist1)
   )
   (princ (strcat "\n                         Distance is  " (rtos dist1)))
   (princ (strcat "\n           Running Total Distance is  " (rtos distm)))
 )
)
      )
    (princ (strcat "\n           Total Elevation Change is  " (rtos slope 2 6)))
    (princ (strcat "\n             Final Total Distance is  " (rtos distm)))
    (princ (strcat "\n                    Percent Slope is  " (rtos (/ slope distm) 2 8) "     Neg.=Down  Pos.=Up"))
      (setq slope (/ slope distm))
    (princ)
    )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;Kick-off routine
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(initget "Slope Elevation")
(setq ans (getkword "\nKnown (S)lope or (E)levations  < S/E >"))
(If (= ans "Slope")(slcalcs)(slcalce))
(princ)
)

I'm sure the guys here can clean it up considerably.  Somewhere I have a modified version that inserts an Elevation block at each point along the way.

[MSTG007]

wow... that would be great! if you can find that.

thanks!!!!

[CADaver]

wow... that would be great! if you can find that.

thanks!!!!

If I were you, I'd probably wait on some of the real gurus around here to post some truly elegant code.  (CAB that'd include you dood).  But here is what I have.  
For this to work you need to go HERE , look in directory CADAVER, and download IELEV.DWG into <SOMEDIRECTORY> on your system,
Then, you need to edit the routine to change "E:/CLIENT/MATRIX/TABS/str/" to  <SOMEDIRECTORY>

NOTICE: This thang has NO error trapping.  Should you choose to use it, you are on yer own, Bubba.

Code: [Select]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Slope Tag  V1.2, 1989, '92
;; by RBCulp - Falcon Design Services, Inc.
;;
;; NO RIGHTS RESERVED; Any and all content may reproduced by any method on any medium for any reason.
;; Please, feel free to use any part found useful, interesting, enlightening or entertaining.
;; If by some chance, someone wishes to be credited for this, go right ahead.
;;
;; Falcon Design Services (FDS) provides this program "as is" and with all faults.
;; FDS specifically disclaims any implied warranty of merchantability or fitness for a particular use.  
;; FDS does not warrant that the operation of the program will be uninterrupted or error free.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:sltag ( / scft nstelev nslope FIRSTPT PT1 PT2 distm dist1 nxtelev)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;Set defaults on first use
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (= stelev nil)  (setq stelev 1200.00))
(if (= slope nil)   (setq slope -0.002))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command ".undo" "begin")
(setvar "attdia" 0)
(setvar "texteval" 1)
(setq scft (getvar "dimscale"))
 (if (= 2 (getvar "lunits")) (setq tunit 2 tprec 3) )
 (if (= 4 (getvar "lunits")) (setq tunit 4 tprec 4) )
   (if (setq nstelev (getdist (strcat "Enter Starting Elevation <" (RTOS stelev) ">: ")))
       (setq stelev nstelev)
   )
   (if (setq nslope (getreal (strcat "Enter Slope Factor (Negative For Down) <" (RTOS slope 2 8) ">: ")))
       (setq slope nslope)
   )
  (setq FIRSTPT (getpoint "Select Starting point ")
PT2 (getpoint FIRSTPT "\nNext point ")
distm (distance firstpt pt2)
nxtelev (+ (* distm slope) stelev)
  )
(princ (strcat "\n                        Distance is  " (rtos (distance firstpt pt2))))
(princ (strcat "\n                           Slope is  " (rtos (* distm slope))))
(princ (strcat "\n                       Elevation is  " (rtos nxtelev tunit tprec)))
;;;; (txstla)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "-insert" "E:/CLIENT/MATRIX/TABS/str/Ielev" "s" scft "r" "45" pt2 (strcat (rtos (/ nxtelev 12.0) 2 2)"'"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (while (/= PT2 nil)
    (setq PT1 PT2)
    (setq PT2 (getpoint PT1 "\n\nNext point "))
    (if (/= PT2 nil)
      (progn
(setq dist1 (distance pt1 pt2)
     distm (+ distm dist1)
     nxtelev (+ (* dist1 slope) nxtelev)
)
(princ (strcat "\n                        Distance is  " (rtos dist1)))
(princ (strcat "\n                           Slope is  " (rtos (* dist1 slope))))
(princ (strcat "\n                       Elevation is  " (rtos nxtelev tunit tprec)))
(princ (strcat "\n          Running Total Distance is  " (rtos distm)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "-insert" "E:/CLIENT/MATRIX/TABS/str/Ielev" "s" scft "r" "45" pt2 (strcat (rtos (/ nxtelev 12.0) 2 2)"'"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      )
    )
  )
(princ (strcat "\n\n          Final Total Distance is  " (rtos distm)))
(setvar "attdia" 1)
(command ".undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

[MSTG007]

Code: [Select]



Command:  SLTAG .undo Enter the number of operations to undo or
[Auto/Control/BEgin/End/Mark/Back] <1>: begin
Command: Enter Starting Elevation <78.0000>:
Enter Slope Factor (Negative For Down) <-0.00200000>:
Select Starting point
Next point 100

                        Distance is  100.0000
                           Slope is  -0.2000
                       Elevation is  77.800-insert Enter block name or [?]
<ielev>: C:ielev Specify insertion point or
[Scale/X/Y/Z/Rotate/PScale/PX/PY/PZ/PRotate]: s Specify scale factor for XYZ
axes: 1.000000000000000 Specify insertion point or
[Scale/X/Y/Z/Rotate/PScale/PX/PY/PZ/PRotate]: r Specify rotation angle: 45
Specify insertion point or [Scale/X/Y/Z/Rotate/PScale/PX/PY/PZ/PRotate]:
Enter attribute values
ELEV....: 6.48'



hey. i set it up like you said... but the 6.48' is suppose to be a 64.89'

I started at a 78 elevation and carried it...

other than that the block comes in ok!

[CADaver]

Oops, sorry.  Mine is set up for working in ft-in drawings (LUPREC=4).  You must be working in ft-dec drawings (LUPREC=2).  So you have to remove the division by 12 part of the attribute fill-in

change this line (both of them)

Code: [Select]

(command "-insert" "E:/CLIENT/MATRIX/TABS/str/Ielev" "s" scft "r" "45" pt2 (strcat (rtos (/ nxtelev 12.0) 2 2)"'"))

to

Code: [Select]

(command "-insert" "E:/CLIENT/MATRIX/TABS/str/Ielev" "s" scft "r" "45" pt2 (strcat (rtos nxtelev 2 2)"'"))

and try it again.

BTW, you can also add a

Code: [Select]

(setvar "cmdecho" 0)at the top after the "UNDO" line to cleanup the echoing.

[CAB]

CADaver,
Nice routine.
I tweaked it a bit, added the Make Block so you don't have to have the ielev.DWG
Need to revise the way the feet mark is added to the elev tag. May have to prompt the use during start up
to see what unit of measure he/she is using. To little time to much code.
Anyway give it a spin.

Code: [Select]


;;=========================================================================================
;; Slope Tag  V1.2, 1989, '92
;;   Revised 03/19/2005 - CAB
;; by RBCulp - Falcon Design Services, Inc.
;;
;; NO RIGHTS RESERVED; Any and all content may reproduced by any method on any medium for any reason.
;; Please, feel free to use any part found useful, interesting, enlightening or entertaining.
;; If by some chance, someone wishes to be credited for this, go right ahead.
;;
;; Falcon Design Services (FDS) provides this program "as is" and with all faults.
;; FDS specifically disclaims any implied warranty of merchantability or fitness for a particular use.  
;; FDS does not warrant that the operation of the program will be uninterrupted or error free.
;;=========================================================================================
(defun c:sltag (/ scft nstelev nslope FIRSTPT PT1 PT2 distm dist1 nxtelev
                *error* save_sys_vars restore_sys_vars make_block $elev)
  ;;===============================================
  ;;         L o c a l   F u n c t i o n s        
  ;;===============================================
  ;; error function & Routine Exit
  (defun *error* (msg)
    (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    )   ; endif
    (restore_sys_vars); reset vars
  )


 
  ;; Function to save system variables in global variable
  (defun save_sys_vars (lst)
    (setq *sysvarlist* '())
    (repeat (length lst)
      (setq *sysvarlist* (append *sysvarlist* (list (list (car lst) (getvar (car lst))))))
      (setq lst (cdr lst))
    )
  )

  ;; Function to reset system variables
  (defun restore_sys_vars ()
    (repeat (length *sysvarlist*)
      (setvar (caar *sysvarlist*) (cadar *sysvarlist*))
      (setq *sysvarlist* (cdr *sysvarlist*))
    )
  )

  ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
  ;;           Make the elevation tag block        
  ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
  (defun make_block(blockname)
    ;;==============================================
    ;;       Start of Block definition              
    ;;==============================================
    (entmake
      (list '(0 . "BLOCK")            ; required
            '(100 . "AcDbEntity")     ; recommended
            '(100 . "AcDbBlockBegin") ; recommended
            (cons 2 blockname)        ; required
            '(8 . "0")                ; recommended
            '(70 . 2)                 ; required [NOTE 0 if no attributes]
            '(10 0.0 0.0 0.0)         ; required
      )
    )
   
    ;;==============================================
    ;;            Block objects                    
    ;;==============================================
    ;; NOTE: Wipeouts must be created first for other objects to be visable
    (entmake '((0 . "WIPEOUT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
              (100 . "AcDbWipeout") (90 . 0) (10 0.0078125 -0.0859375 0.0) (11 0.625 0.0 0.0)
              (12 0.0 0.625 0.0) (13 1.0 1.0 0.0) (70 . 7) (280 . 1)
              (281 . 50) (282 . 50) (283 . 0) (71 . 2) (91 . 9) (14 -0.5 0.4625 0.0)
              (14 -0.225 0.4625 0.0) (14 -0.225 0.5 0.0) (14 0.5 0.5 0.0) (14 0.5 0.225 0.0)
              (14 -0.225 0.225 0.0) (14 -0.225 0.2625 0.0) (14 -0.5 0.2625 0.0) (14 -0.5 0.4625 0.0)))
    (entmake '((0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbText")
              (10 0.279583 -0.05 0.0) (40 . 0.1) (1 . "") (50 . 0.0) (41 . 0.7) (51 . 0.0)
              (7 . "Standard") (71 . 0) (72 . 1) (11 0.40625 0.0 0.0) (210 0.0 0.0 1.0)
              (100 . "AcDbAttributeDefinition") (3 . "ELEV....") (2 . "ELEV") (70 . 0)
              (73 . 0) (74 . 2)))
    (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
              (100 . "AcDbPolyline") (90 . 4) (70 . 1) (43 . 0.0) (38 . 0.0) (39 . 0.0)
              (10 0.183594 -0.0789062) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 0.628906 -0.0789062)
              (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 0.628906 0.0789062) (40 . 0.0) (41 . 0.0)
              (42 . 0.0) (10 0.183594 0.0789062) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0)))
    (entmake '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
              (100 . "AcDbText") (10 0.00806548 -0.05 0.0) (40 . 0.1) (1 . "I.E.") (50 . 0.0)
              (41 . 0.8) (51 . 0.0) (7 . "Standard") (71 . 0) (72 . 2) (11 0.171875 0.0 0.0)
              (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 2)))
 
    ;;==============================================
    ;;     This is the end of block marker          
    ;;==============================================
    (entmake (list '(0 . "ENDBLK")         ; required
                   '(100 . "AcDbBlockEnd") ; recommended
                   '(8 . "0")              ; recommended
                   ))
    ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
  ) ;                 end defun make_block            
    ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_

 
  ;;************************************************************************
  ;;************************************************************************
  ;;                    S T A R T   O F   R O U T I N E                    
  ;;************************************************************************
  ;;************************************************************************

  ;;------------------------------------------------------------------------
  ;;    Set defaults on first use
  ;;------------------------------------------------------------------------
  (or *stelev* (setq *stelev* 1200.00))
  (or *slope*  (setq *slope*  -0.002))
  (if (not (setq *units*
              (car(member *units* '("Inch" "Foot" "Meter" "Centimeter")))))
    (progn
      (initget "Inch Foot Meter Centimeter")
      (setq *units*
             (getkword
               "\nOne Unit in this drawing = [Inch/Foot/Meter/Centimeter] <Inch>:"))
      (or *units* (setq *units* "Inch"))
    )
  )
  ;;------------------------------------------------------------------------
 
  (command ".undo" "begin")
 
  (save_sys_vars '("CMDECHO" "attdia" "attreq" "texteval"))
  (setvar "cmdecho"  0)
  (setvar "attdia"   0)
  (setvar "attreq"   1)
  (setvar "texteval" 1)
 
  (setq scft  (getvar "dimscale")
        tunit (getvar "lunits")
        distm 0)
    ;;  ????????????????????
  (cond
    ((= 2 tunit)
      (setq tprec 3)
    )
    ((= 4 tunit)
      (setq tprec 4)
    )
    (T
      (setq tprec 3)
    )
  ) ; ?????????????????????
 
  ;;------------------------------------------------------------------------
  (if (and (not (tblsearch "Block" "Ielev"))
           (not (make_block "Ielev")))
    (progn
      (alert "Make Block Failed, can not continue.")
      (exit)
    )
  )
 
 (if (and
        (or (not (setq nstelev
             (getdist (strcat "Enter Starting Elevation <" (RTOS *stelev*) ">: "))))
           (setq *stelev* nstelev))
        (or (not (setq nslope (getreal (strcat "Enter Slope Factor (Negative For Down) <"
                                    (RTOS *slope* 2 8)  ">: " ))))
            (setq *slope* nslope))
        (setq FIRSTPT (getpoint "Select Starting point "))
        (setq pt1     firstpt
              nxtelev *stelev*)
      ) ; and

  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    (while (setq PT2 (getpoint PT1 "\n\nNext point "))
     
      (setq dist1   (distance pt1 pt2)
            distm   (+ distm dist1)
            nxtelev (+ (* dist1 *slope*) nxtelev)
            PT1 PT2
      )
      (princ (strcat "\n                        Distance is  " (rtos dist1)))
      (princ (strcat "\n                           Slope is  "
                     (rtos (* dist1 *slope*))))
      (princ (strcat "\n                       Elevation is  "
                     (rtos nxtelev tunit tprec)))
      (princ (strcat "\n          Running Total Distance is  " (rtos distm)))
      ;;------------------------------------------------------------------------
      (if (= *units* "Inch") ; convert to feet
        (setq $elev (rtos (/ nxtelev 12.0) 2 2))
        (setq $elev (rtos nxtelev 2 2))
      )
      (if (or (eq *units* "Inch") (eq *units* "Foot"))
        (setq $elev (strcat $elev "'"))
      )
       
      (command "-insert" "Ielev" "s" scft "r" "45" pt2 $elev)
      ;;------------------------------------------------------------------------
    ) ; end while
    ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  ); endif

  (princ (strcat "\n\n          Final Total Distance is  " (rtos distm)))

  (command ".undo" "end")
                 
  (*error* "") ; restore variables
 
  (princ)
)
(prompt "\n***   Slope Tag Loaded, Enter sltag to run.  ***")
(princ)
;;=========================================================================================
;;  eof

[CAB]

Had it working last night but.
Got an error, the make block doesn't work yet.
I'll see if I can fix it this afternoon.

[MSTG007]

Code: [Select]


stupid question.

how hard would it be to add a leader with text above the leader telling the slope with the direction?

And then possibly have the block look like a grading spot elevation?

 _______
|XXX.XX|
----------
               \
                \
                 X    < ---  location of spot



[CAB]

Updated the code above. Got the block create code working.
Added the prompt for units.

[MSTG007]

hey cab
I am using CIVIL 3D 2k5

I am getting a

"Make Block Failed, can not continue"


***   Slope Tag Loaded, Enter sltag to run.  ***
Command: sltag
.undo Enter the number of operations to undo or
[Auto/Control/BEgin/End/Mark/Back] <1>: begin
Command:
Command:
SLTAG .undo Enter the number of operations to undo or
[Auto/Control/BEgin/End/Mark/Back] <1>: begin
Command:

any ideas?

thanks!

[CAB]

Did you copy the code again?
I updated it 40 minutes ago.

[MSTG007]

cab,
Yup it still does it... I am on another machine at work. Still geting the same error as above

[CADaver]

I knew somebody (read that as CAB) would be able to tweak* it some.

Thanks, that's sweet.  

(*Tweak = Sow's Ear to Silk Purse)

[CAB]

Try this, comment out the WIPEOUT entity & see if the block can be created. It is a function of
express tools and may not be supported in your setup. Do you have Express tools?

Code: [Select]

;    (entmake '((0 . "WIPEOUT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
;              (100 . "AcDbWipeout") (90 . 0) (10 0.0078125 -0.0859375 0.0) (11 0.625 0.0 0.0)
;              (12 0.0 0.625 0.0) (13 1.0 1.0 0.0) (70 . 7) (280 . 1)
;              (281 . 50) (282 . 50) (283 . 0) (71 . 2) (91 . 9) (14 -0.5 0.4625 0.0)
;              (14 -0.225 0.4625 0.0) (14 -0.225 0.5 0.0) (14 0.5 0.5 0.0) (14 0.5 0.225 0.0)
;              (14 -0.225 0.225 0.0) (14 -0.225 0.2625 0.0) (14 -0.5 0.2625 0.0) (14 -0.5 0.4625 0.0)))

Let me know what you find out.

[MSTG007]

do you think you can make the block look similar to this

http://www.theswamp.org/lilly_pond/mstg007/SPOTgrade.dwg?nossi=1

I know the lisp actually draws the block opposed to the block already defined.

Thanks cab!

it works great now!

[CAB]

Glad you like it.

it works great now!

Did you have to remove the WIPEOUT to get it to work??

do you think you can make the block look similar to this

Short answer is Yes, but you can use the previous routine that CADaver posted & replace
"ielev" with your block name, put it in the ACAD search path, remove the path string
and update the attributes strings to match your block.

[CAB]

Here is another update:
Added code to detect Expresstools and ignore the WIPEOUT if ET is not be loaded.

Code: [Select]

;;=========================================================================================
;; Slope Tag  V1.2, 1989, '92
;;   Revised 03/19/2005 - CAB Version 2.1
;; by RBCulp - Falcon Design Services, Inc.
;;
;; NO RIGHTS RESERVED; Any and all content may reproduced by any method on any medium for any reason.
;; Please, feel free to use any part found useful, interesting, enlightening or entertaining.
;; If by some chance, someone wishes to be credited for this, go right ahead.
;;
;; Falcon Design Services (FDS) provides this program "as is" and with all faults.
;; FDS specifically disclaims any implied warranty of merchantability or fitness for a particular use.  
;; FDS does not warrant that the operation of the program will be uninterrupted or error free.
;;=========================================================================================
(defun c:sltag (/ scft nstelev nslope FIRSTPT PT1 PT2 distm dist1 nxtelev
                *error* save_sys_vars restore_sys_vars make_block $elev)
  ;;===============================================
  ;;         L o c a l   F u n c t i o n s        
  ;;===============================================
  ;; error function & Routine Exit
  (defun *error* (msg)
    (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    )   ; endif
    (restore_sys_vars); reset vars
  )


 
  ;; Function to save system variables in global variable
  (defun save_sys_vars (lst)
    (setq *sysvarlist* '())
    (repeat (length lst)
      (setq *sysvarlist* (append *sysvarlist* (list (list (car lst) (getvar (car lst))))))
      (setq lst (cdr lst))
    )
  )

  ;; Function to reset system variables
  (defun restore_sys_vars ()
    (repeat (length *sysvarlist*)
      (setvar (caar *sysvarlist*) (cadar *sysvarlist*))
      (setq *sysvarlist* (cdr *sysvarlist*))
    )
  )


  ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
  ;;           Make the elevation tag block        
  ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
  (defun make_block(blockname / et)
    ;;  Check for ExpressTools
    (if (member "acetutil.arx" (arx))
(if (wcmatch (getvar "ACADVER") "*16*")
           (or (not (arxload "acwipeout")) (setq et T))
           (or (not(member "wipeout.arx" (arx)))(setq et T))
)
    )

    (if (not et)
       (alert "Express Tools are not Loaded \n Tag will be 'See Through'")
    )

    ;;==============================================
    ;;       Start of Block definition              
    ;;==============================================
    (entmake
      (list '(0 . "BLOCK")            ; required
            '(100 . "AcDbEntity")     ; recommended
            '(100 . "AcDbBlockBegin") ; recommended
            (cons 2 blockname)        ; required
            '(8 . "0")                ; recommended
            '(70 . 2)                 ; required [NOTE 0 if no attributes]
            '(10 0.0 0.0 0.0)         ; required
      )
    )
   
    ;;==============================================
    ;;            Block objects                    
    ;;==============================================
    ;; NOTE: Wipeouts must be created first for other objects to be visable
    (if et
    (entmake '((0 . "WIPEOUT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
              (100 . "AcDbWipeout") (90 . 0) (10 0.0078125 -0.0859375 0.0) (11 0.625 0.0 0.0)
              (12 0.0 0.625 0.0) (13 1.0 1.0 0.0) (70 . 7) (280 . 1)
              (281 . 50) (282 . 50) (283 . 0) (71 . 2) (91 . 9) (14 -0.5 0.4625 0.0)
              (14 -0.225 0.4625 0.0) (14 -0.225 0.5 0.0) (14 0.5 0.5 0.0) (14 0.5 0.225 0.0)
              (14 -0.225 0.225 0.0) (14 -0.225 0.2625 0.0) (14 -0.5 0.2625 0.0) (14 -0.5 0.4625 0.0)))
    )
    (entmake '((0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbText")
              (10 0.279583 -0.05 0.0) (40 . 0.1) (1 . "") (50 . 0.0) (41 . 0.7) (51 . 0.0)
              (7 . "Standard") (71 . 0) (72 . 1) (11 0.40625 0.0 0.0) (210 0.0 0.0 1.0)
              (100 . "AcDbAttributeDefinition") (3 . "ELEV....") (2 . "ELEV") (70 . 0)
              (73 . 0) (74 . 2)))
    (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
              (100 . "AcDbPolyline") (90 . 4) (70 . 1) (43 . 0.0) (38 . 0.0) (39 . 0.0)
              (10 0.183594 -0.0789062) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 0.628906 -0.0789062)
              (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 0.628906 0.0789062) (40 . 0.0) (41 . 0.0)
              (42 . 0.0) (10 0.183594 0.0789062) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0)))
    (entmake '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
              (100 . "AcDbText") (10 0.00806548 -0.05 0.0) (40 . 0.1) (1 . "I.E.") (50 . 0.0)
              (41 . 0.8) (51 . 0.0) (7 . "Standard") (71 . 0) (72 . 2) (11 0.171875 0.0 0.0)
              (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 2)))
 
    ;;==============================================
    ;;     This is the end of block marker          
    ;;==============================================
    (entmake (list '(0 . "ENDBLK")         ; required
                   '(100 . "AcDbBlockEnd") ; recommended
                   '(8 . "0")              ; recommended
                   ))
    ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
  ) ;                 end defun make_block            
    ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_

 
  ;;************************************************************************
  ;;************************************************************************
  ;;                    S T A R T   O F   R O U T I N E                    
  ;;************************************************************************
  ;;************************************************************************

  ;;------------------------------------------------------------------------
  ;;    Set defaults on first use
  ;;------------------------------------------------------------------------
  (or *stelev* (setq *stelev* 1200.00))
  (or *slope*  (setq *slope*  -0.002))
  (if (not (setq *units*
              (car(member *units* '("Inch" "Foot" "Meter" "Centimeter")))))
    (progn
      (initget "Inch Foot Meter Centimeter")
      (setq *units*
             (getkword
               "\nOne Unit in this drawing = [Inch/Foot/Meter/Centimeter] <Inch>:"))
      (or *units* (setq *units* "Inch"))
    )
  )
  ;;------------------------------------------------------------------------
 
  (save_sys_vars '("CMDECHO" "attdia" "attreq" "texteval"))
  (command ".undo" "begin")
 
  (setvar "cmdecho"  0)
  (setvar "attdia"   0)
  (setvar "attreq"   1)
  (setvar "texteval" 1)
 
  (setq scft  (getvar "dimscale")
        tunit (getvar "lunits")
        distm 0)
    ;;  ????????????????????
  (cond
    ((= 2 tunit)
      (setq tprec 3)
    )
    ((= 4 tunit)
      (setq tprec 4)
    )
    (T
      (setq tprec 3)
    )
  ) ; ?????????????????????
 
  ;;------------------------------------------------------------------------
  (if (and (not (tblsearch "Block" "Ielev"))
           (not (make_block "Ielev")))
    (progn
      (alert "Make Block Failed, can not continue.")
      (exit)
    )
  )
 
 (if (and
        (or (not (setq nstelev
             (getdist (strcat "Enter Starting Elevation <" (RTOS *stelev*) ">: "))))
           (setq *stelev* nstelev))
        (or (not (setq nslope (getreal (strcat "Enter Slope Factor (Negative For Down) <"
                                    (RTOS *slope* 2 8)  ">: " ))))
            (setq *slope* nslope))
        (setq FIRSTPT (getpoint "Select Starting point "))
        (setq pt1     firstpt
              nxtelev *stelev*)
      ) ; and

  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    (while (setq PT2 (getpoint PT1 "\n\nNext point "))
     
      (setq dist1   (distance pt1 pt2)
            distm   (+ distm dist1)
            nxtelev (+ (* dist1 *slope*) nxtelev)
            PT1 PT2
      )
      (princ (strcat "\n                        Distance is  " (rtos dist1)))
      (princ (strcat "\n                           Slope is  "
                     (rtos (* dist1 *slope*))))
      (princ (strcat "\n                       Elevation is  "
                     (rtos nxtelev tunit tprec)))
      (princ (strcat "\n          Running Total Distance is  " (rtos distm)))
      ;;------------------------------------------------------------------------
      (if (= *units* "Inch") ; convert to feet
        (setq $elev (rtos (/ nxtelev 12.0) 2 2))
        (setq $elev (rtos nxtelev 2 2))
      )
      (if (or (eq *units* "Inch") (eq *units* "Foot"))
        (setq $elev (strcat $elev "'"))
      )
       
      (command "-insert" "Ielev" "s" scft "r" "45" pt2 $elev)
      ;;------------------------------------------------------------------------
    ) ; end while
    ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  ); endif

  (princ (strcat "\n\n          Final Total Distance is  " (rtos distm)))

  (command ".undo" "end")
                 
  (*error* "") ; restore variables
 
  (princ)
)
(prompt "\n***   Slope Tag Loaded, Enter sltag to run.  ***")
(princ)
;;=========================================================================================
;;  eof

[CAB]

Here is yet another version based on the scenario CarlB posted.
See the picture below to illustrate.
ST PT 1 is the very first point chosen and elevation set at 100'
points were the chosen along the RED arrow to show slope along the
house foundation.
ST PT 2 is chosen using the NEW option. The new start point elevation is
99.97' based on distance Stpt1 to stpt2. Then points are added along the
green arrow showing slope in that direction.
ST PT 3 is chosen using the NEW option. The new start point elevation is
99.94' based on distance Stpt2 to stpt3. Then points are added along the
cyan arrow showing slope in that direction.

Code: [Select]

;;=========================================================================================
;; Slope Tag  V1.2, 1989, '92
;;   Revised 03/19/2005 - CAB
;;   Revised 03/21/2005 - CAB Version 2.1
;;     all elev are calc for start point, you may reset the start point
;;     new start point elev is based on the previous start point elevation
;; by RBCulp - Falcon Design Services, Inc.
;;
;; NO RIGHTS RESERVED; Any and all content may reproduced by any method on any medium for any reason.
;; Please, feel free to use any part found useful, interesting, enlightening or entertaining.
;; If by some chance, someone wishes to be credited for this, go right ahead.
;;
;; Falcon Design Services (FDS) provides this program "as is" and with all faults.
;; FDS specifically disclaims any implied warranty of merchantability or fitness for a particular use.  
;; FDS does not warrant that the operation of the program will be uninterrupted or error free.
;;=========================================================================================
(defun c:sltag2 (/ scft stelev nstelev nslope FIRSTPT PT1 PT2 distm dist1 nxtelev
                *error* save_sys_vars restore_sys_vars make_block $elev)
  ;;===============================================
  ;;         L o c a l   F u n c t i o n s        
  ;;===============================================
  ;; error function & Routine Exit
  (defun *error* (msg)
    (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    )   ; endif
    (restore_sys_vars); reset vars
  )


 
  ;; Function to save system variables in global variable
  (defun save_sys_vars (lst)
    (setq *sysvarlist* '())
    (repeat (length lst)
      (setq *sysvarlist* (append *sysvarlist* (list (list (car lst) (getvar (car lst))))))
      (setq lst (cdr lst))
    )
  )

  ;; Function to reset system variables
  (defun restore_sys_vars ()
    (repeat (length *sysvarlist*)
      (setvar (caar *sysvarlist*) (cadar *sysvarlist*))
      (setq *sysvarlist* (cdr *sysvarlist*))
    )
  )


  ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
  ;;           Make the elevation tag block        
  ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
  (defun make_block(blockname / et)
    ;;  Check for ExpressTools
    (if (member "acetutil.arx" (arx))
(if (wcmatch (getvar "ACADVER") "*16*")
           (or (NOT (arxload "acwipeout")) (setq et T))
           (or (not(member "wipeout.arx" (arx)))(setq et T))
)
    )

    (if (not et)
       (alert "Express Tools are not Loaded \n Tag will be 'See Through'")
    )
    ;;==============================================
    ;;       Start of Block definition              
    ;;==============================================
    (entmake
      (list '(0 . "BLOCK")            ; required
            '(100 . "AcDbEntity")     ; recommended
            '(100 . "AcDbBlockBegin") ; recommended
            (cons 2 blockname)        ; required
            '(8 . "0")                ; recommended
            '(70 . 2)                 ; required [NOTE 0 if no attributes]
            '(10 0.0 0.0 0.0)         ; required
      )
    )
   
    ;;==============================================
    ;;            Block objects                    
    ;;==============================================
    ;; NOTE: Wipeouts must be created first for other objects to be visable
    (if et
    (entmake '((0 . "WIPEOUT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
              (100 . "AcDbWipeout") (90 . 0) (10 0.0078125 -0.0859375 0.0) (11 0.625 0.0 0.0)
              (12 0.0 0.625 0.0) (13 1.0 1.0 0.0) (70 . 7) (280 . 1)
              (281 . 50) (282 . 50) (283 . 0) (71 . 2) (91 . 9) (14 -0.5 0.4625 0.0)
              (14 -0.225 0.4625 0.0) (14 -0.225 0.5 0.0) (14 0.5 0.5 0.0) (14 0.5 0.225 0.0)
              (14 -0.225 0.225 0.0) (14 -0.225 0.2625 0.0) (14 -0.5 0.2625 0.0) (14 -0.5 0.4625 0.0)))
    )
    (entmake '((0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbText")
              (10 0.279583 -0.05 0.0) (40 . 0.1) (1 . "") (50 . 0.0) (41 . 0.7) (51 . 0.0)
              (7 . "Standard") (71 . 0) (72 . 1) (11 0.40625 0.0 0.0) (210 0.0 0.0 1.0)
              (100 . "AcDbAttributeDefinition") (3 . "ELEV....") (2 . "ELEV") (70 . 0)
              (73 . 0) (74 . 2)))
    (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
              (100 . "AcDbPolyline") (90 . 4) (70 . 1) (43 . 0.0) (38 . 0.0) (39 . 0.0)
              (10 0.183594 -0.0789062) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 0.628906 -0.0789062)
              (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 0.628906 0.0789062) (40 . 0.0) (41 . 0.0)
              (42 . 0.0) (10 0.183594 0.0789062) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0)))
    (entmake '((0 . "TEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")
              (100 . "AcDbText") (10 0.00806548 -0.05 0.0) (40 . 0.1) (1 . "I.E.") (50 . 0.0)
              (41 . 0.8) (51 . 0.0) (7 . "Standard") (71 . 0) (72 . 2) (11 0.171875 0.0 0.0)
              (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 2)))
 
    ;;==============================================
    ;;     This is the end of block marker          
    ;;==============================================
    (entmake (list '(0 . "ENDBLK")         ; required
                   '(100 . "AcDbBlockEnd") ; recommended
                   '(8 . "0")              ; recommended
                   ))
    ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
  ) ;                 end defun make_block            
    ;;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_

 
  ;;************************************************************************
  ;;************************************************************************
  ;;                    S T A R T   O F   R O U T I N E                    
  ;;************************************************************************
  ;;************************************************************************

  ;;------------------------------------------------------------------------
  ;;    Set defaults on first use
  ;;------------------------------------------------------------------------
  (or *stelev* (setq *stelev* 1200.00))
  (or *slope*  (setq *slope*  -0.002))
  (if (not (setq *units*
              (car(member *units* '("Inch" "Foot" "Meter" "Centimeter")))))
    (progn
      (initget "Inch Foot Meter Centimeter")
      (setq *units*
             (getkword
               "\nOne Unit in this drawing = [Inch/Foot/Meter/Centimeter] <Inch>:"))
      (or *units* (setq *units* "Inch"))
    )
  )
  ;;------------------------------------------------------------------------
 
  (save_sys_vars '("CMDECHO" "attdia" "attreq" "texteval"))
  (command ".undo" "begin")
 
  (setvar "cmdecho"  0)
  (setvar "attdia"   0)
  (setvar "attreq"   1)
  (setvar "texteval" 1)
 
  (setq scft  (getvar "dimscale")
        tunit (getvar "lunits")
        distm 0)
    ;;  ????????????????????
  (cond
    ((= 2 tunit)
      (setq tprec 3)
    )
    ((= 4 tunit)
      (setq tprec 4)
    )
    (T
      (setq tprec 3)
    )
  ) ; ?????????????????????
 
  ;;------------------------------------------------------------------------
  (if (and (not (tblsearch "Block" "Ielev"))
           (not (make_block "Ielev")))
    (progn
      (alert "Make Block Failed, can not continue.")
      (exit)
    )
  )
 
 (if (and
        (or (not (setq nstelev
             (getdist (strcat "Enter Starting Elevation <" (RTOS *stelev*) ">: "))))
           (setq *stelev* nstelev))
        (or (not (setq nslope (getreal (strcat "Enter Slope Factor (Negative For Down) <"
                                    (RTOS *slope* 2 8)  ">: " ))))
            (setq *slope* nslope))
        (setq pt1 (getpoint "Select Starting point "))
        (setq stelev *stelev*)
      ) ; and

  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
    (while (or
              (initget "New")
              (setq PT2 (getpoint PT1 "\n\nNext point or New point "))
           ) ;end or

    (cond
      ((listp PT2); Is PT a point list?
      (setq dist1   (distance pt1 pt2)
            nxtelev (+ (* dist1 *slope*) stelev)
      )
      (princ (strcat "\n                        Distance is  " (rtos dist1)))
      (princ (strcat "\n                           Slope is  "
                     (rtos (* dist1 *slope*))))
      (princ (strcat "\n                       Elevation is  "
                     (rtos nxtelev tunit tprec)))
      ;;------------------------------------------------------------------------
      (if (= *units* "Inch") ; convert to feet
        (setq $elev (rtos (/ nxtelev 12.0) 2 2))
        (setq $elev (rtos nxtelev 2 2))
      )
      (if (or (eq *units* "Inch") (eq *units* "Foot"))
        (setq $elev (strcat $elev "'"))
      )
       
      (command "-insert" "Ielev" "s" scft "r" "45" pt2 $elev)
       )
      (T ; new start point based on base elevation
        (while
          (not (setq pt2 (getpoint pt1 "\n>>--> Select New Starting point: ")))
          (princ "\nPlease try again..."))
        (setq dist1   (distance pt1 pt2)
              stelev  (+ (* dist1 *slope*) stelev)
              pt1     pt2
        )

      )
     ) ; end cond stmt
      ;;------------------------------------------------------------------------
    ) ; end while
    ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  ); endif

  (command ".undo" "end")
                 
  (*error* "") ; restore variables
 
  (princ)
)
(prompt "\n***   Slope Tag Loaded, Enter sltag2 to run.  ***")
(princ)
;;=========================================================================================
;;  eof

[danny]

CAB,
I get an error message

Code: [Select]

make block failed, cannot continue

[CADaver]

Just so you know, I just noticed the ?? in your tweaked code.  

Code: [Select]

(setq scft  (getvar "dimscale")
        tunit (getvar "lunits")
        distm 0)
    ;;  ????????????????????
  (cond
    ((= 2 tunit)
      (setq tprec 3)
    )
    ((= 4 tunit)
      (setq tprec 4)
    )
    (T
      (setq tprec 3)
    )
  ) ; ????????????????????? I was in the process of tweaking the code a couple years ago, and I was gonna read LUNITS to determine whether we were in a FT-IN file or a FT-DEC.  Then I was gonna do the calcs and set the attribute value precision based on that.

Code: [Select]

(rtos nxtelev tunit tprec))) Since then, we changed our standard such that ALL site elevations are FT-DEC to 2 places.

[CADaver]

BTW, why don't you go ahead and fix the rest of the code and take my header (such as it is) off all together.    That's pretty sweet coding, dood.  Do you have a real job???

[CAB]

CAB,
I get an error message
** make block failed, cannot continue

Sorry about that.
What version of Autocad are you running and do you have Expresstools loaded?

[danny]

no need to be sorry.....
the version I tested it in was ACAD2004, and express tools was loaded.

[CAB]

danny,
recopy the routines above, I updated both of them.
It is the WIPEOUT that is giving me a problem and detecting express tools.
In ACAD2000 when acetutil.arx is loaded the wipeout.arx is also loaded so
all is well, but in ACAD2004 acetutil.arx may be loaded and acwipeout.arx
is not always loaded and the name of the routine is changed.
Therefore a more elaborate detection algorithm was needed. I don't have
ACAD R14 or 2002 or 2005 so I can't test these.

[CAB]

Do you have a real job???

No , if i did they would fire me or take away my IE connection.

[CADaver]

Do you have a real job???

No , if i did they would fire me or take away my IE connection.

Do you want one?

...

no, wait a minute...

...

they find out they really don't need me...

...

nevermind.

[MSTG007]

Hey.. question I am getting an error

; error: bad argument type: numberp: #<SUBR @05b7f768 ->

any ideas?

acad 2005

it was working fine

[MP]

An expression that is expecting a number is getting something else.

Define this --

(defun *error* (x) (vl-bt))

-- and run your proggy again.

What does it dump now? (It should indicate where the error is happening).

[MSTG007]

Command: sltag
.undo Enter the number of operations to undo or
[Auto/Control/BEgin/End/Mark/Back] <1>: begin
Command: Enter Starting Elevation <1200.0000>:
Backtrace:
[0.49] (VL-BT)
[1.45] (*ERROR* "bad argument type: numberp: #<SUBR @05b2f768 ->")
[2.40] (_call-err-hook #<SUBR @0ab4f3e8 *ERROR*> "bad argument type: numberp:
#<SUBR @05b2f768 ->")
[3.34] (sys-error "bad argument type: numberp: #<SUBR @05b2f768 ->")
:ERROR-BREAK.29 nil
[4.26] (RTOS #<SUBR @05b2f768 -> 2
[5.19] (C:SLTAG)
[6.15] (#<SUBR @0ab4f514 -rts_top->)
[7.12] (#<SUBR @05a72334 veval-str-body> "(C:SLTAG)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)

[MP]

There ya go --

In function (defun C:SLTAG ...) there is a call to (rtos ...) that is bombing because it is being passed a non numerical value.

[CAB]

It isn't obvious to me which one if the three variabales is causing the error.
Try this & see if we can determine which one.

Code: [Select]

;;; DESCRIPTION
;;;
;;; This lisp is design to calculate elevation or slope percentage.
;;;
;;; **Slvl**
;;; Calculates the elevation after user input of the highest
;;; level and slope percentage.
;;; The distance has to be specified by picking two endpoints
(defun C:Slvl (/ *Error* useros usercmd userlun slp elev dist p1 p2 chg)
  ;; error function & Routine Exit
  (defun *error* (msg)
    (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    ) ; endif

    ;;reset all variables here
    (if useros (setvar "osmode" useros))
    (if usercmd (setvar "CMDECHO" usercmd))
    (if userlun (setvar "lunits" userlun))
    (setq useros  nil
          usercmd nil
          userlun nil
    )
  ) ;end error function  (defun *Error* (msg) ; embedded defun


  (setq useros  (getvar "osmode")
        usercmd (getvar "CMDECHO")
        userlun (getvar "lunits")
  )

  (setvar "osmode" 1) ; = endpoint
  (setvar "Lunits" 4) ; Feet & Inches

  (setq elev (Getdist "\nReference level (Eg : 100'-0'') : "))
  (setq slp
         (getreal
           "\nDesired Slope in Percentage, - for slope down (Eg : 3 for .03 or 3%) : "
         )
  )
  (initget 128) ; get point OR number OR string
  (setq p1 (getpoint "\nPick 1st point or enter DISTANCE: "))
  (cond
    ((listp p1) ; got a point
     (if (setq p2 (getpoint p1 "\nPick 2nd point of DISTANCE: "))
       (setq dist (distance p1 p2))
     )
    )
    ((numberp p1) ; got a number
     (setq dist p1)
    )
    ((setq dist (distof p1)) ; got a string, convert to number
    )
  )
  (cond
    ((not (numberp elev))
     (prompt "\n***  Error in Elevation  ***")
    )
    ((not (numberp slp))
     (prompt "\n***  Error in Slope  ***")
    )
    ((not (numberp dist))
     (prompt "\n***  Error in Distance  ***")
    )
    (t
     (setq slp  (/ slp 100.0)
           elev (/ elev 12.0)
           chg  (rtos (+ elev (* (/ dist 12.0) slp)) 2 2)
     )
     (prompt
       (strcat "\n[Start Elev="
               (rtos elev 2 2)
               "'] [Distance="
               (rtos dist 4 2)
               "] "
       )
     )
     (if (minusp slp)
       ;;-----slope calculation
       (prompt (strcat "[Level below is : " chg "']"))
       (prompt (strcat "[Level above is : " chg "']"))
     )
    )
  )
  (*error* "")
  (princ)
)
(prompt "\nSlope Calc Loaded, Enter slvl to run.")
(princ)

[MSTG007]

Slope Calc Loaded, Enter slvl to run.

Command: slvl

Reference level (Eg : 100'-0'') :

Desired Slope in Percentage, - for slope down (Eg : 3 for .03 or 3%) :

Pick 1st point or enter DISTANCE:
Pick 2nd point of DISTANCE:
***  Error in Elevation  ***
Command:

[MSTG007]

this is on the old one:

"AutoCAD menu utilities loaded.
Command: sltag .undo Enter the number of operations to undo or
[Auto/Control/BEgin/End/Mark/Back] <1>: begin
Command: Enter Starting Elevation <1200.0000>:  ; error: bad argument type:
numberp: #<SUBR @058bf768 ->"


the following lisp code

Code: [Select]


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Slope Tag  V1.2, 1989, '92
;; by RBCulp - Falcon Design Services, Inc.
;;
;; NO RIGHTS RESERVED; Any and all content may reproduced by any method on any medium for any reason.
;; Please, feel free to use any part found useful, interesting, enlightening or entertaining.
;; If by some chance, someone wishes to be credited for this, go right ahead.
;;
;; Falcon Design Services (FDS) provides this program "as is" and with all faults.
;; FDS specifically disclaims any implied warranty of merchantability or fitness for a particular use.  
;; FDS does not warrant that the operation of the program will be uninterrupted or error free.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:sltag ( / scft nstelev nslope FIRSTPT PT1 PT2 distm dist1 nxtelev)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;Set defaults on first use
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (= stelev nil)  (setq stelev 1200.00))
(if (= slope nil)   (setq slope -.002))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command ".undo" "begin")
(setvar "attdia" 0)
(setvar "texteval" 1)
(setq scft (getvar "dimscale"))
 (if (= 2 (getvar "lunits")) (setq tunit 2 tprec 3) )
 (if (= 4 (getvar "lunits")) (setq tunit 4 tprec 4) )
   (if (setq nstelev (getdist (strcat "Enter Starting Elevation <" (RTOS stelev) ">: ")))
       (setq stelev nstelev)
   )
   (if (setq nslope (getreal (strcat "Enter Slope Factor (Negative For Down) <" (RTOS slope 2 8) ">: ")))
       (setq slope nslope)
   )
  (setq FIRSTPT (getpoint "Select Starting point ")
   PT2 (getpoint FIRSTPT "\nNext point ")
   distm (distance firstpt pt2)
   nxtelev (+ (* distm slope) stelev)
  )
(princ (strcat "\n                        Distance is  " (rtos (distance firstpt pt2))))
(princ (strcat "\n                           Slope is  " (rtos (* distm slope))))
(princ (strcat "\n                       Elevation is  " (rtos nxtelev tunit tprec)))
;;;; (txstla)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "-insert" "E:/CAD/Ielev" "s" scft "r" "0" pt2 (strcat (rtos nxtelev 2 2)" "))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (while (/= PT2 nil)
    (setq PT1 PT2)
    (setq PT2 (getpoint PT1 "\n\nNext point "))
    (if (/= PT2 nil)
      (progn
   (setq dist1 (distance pt1 pt2)
         distm (+ distm dist1)
         nxtelev (+ (* dist1 slope) nxtelev)
   )
   (princ (strcat "\n                        Distance is  " (rtos dist1)))
   (princ (strcat "\n                           Slope is  " (rtos (* dist1 slope))))
   (princ (strcat "\n                       Elevation is  " (rtos nxtelev tunit tprec)))
   (princ (strcat "\n          Running Total Distance is  " (rtos distm)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "-insert" "E:/CAD/Ielev" "s" scft "r" "0" pt2 (strcat (rtos nxtelev 2 2)" "))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      )
    )
  )
   (princ (strcat "\n\n          Final Total Distance is  " (rtos distm)))
(setvar "attdia" 1)
(command ".undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


[CAB]

Well you see you are pressing enter as if the 100' is a default.
If it was a default it should be displayed as <100'-0"> to indicate default.
If you want to force the user to enter something. Use this.

Code: [Select]

(initget 1)
(setq elev (Getdist "\nReference level (Eg : 100'-0'') : "))

If you want 100, to be a default use this

Code: [Select]

(setq elev (Getdist "\nReference level (Eg : 100'-0'') : "))
(if (null elev) (setq elev (distof "100'")))

Another way to handle it is to have the routine remember the current setting while
the user is in one drawing. You would make a global variable like *elev*

Code: [Select]

;;  Load a global variable if null
(setq *elev* (cond (*elev*) (distof "100'")))
(setq elev (Getdist "\nReference level (Eg : 100'-0'') : "))
(if (null elev)
   (setq elev *elev*) ; use global
   (setq *elev* elev) ; reset global
)

[CAB]

Like this:

Code: [Select]

;;; DESCRIPTION
;;;
;;; This lisp is design to calculate elevation or slope percentage.
;;;
;;; **Slvl**
;;; Calculates the elevation after user input of the highest
;;; level and slope percentage.
;;; The distance has to be specified by picking two endpoints
(defun C:Slvl (/ *Error* useros usercmd userlun slp elev dist p1 p2 chg)
  ;; error function & Routine Exit
  (defun *error* (msg)
    (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    ) ; endif

    ;;reset all variables here
    (if useros (setvar "osmode" useros))
    (if usercmd (setvar "CMDECHO" usercmd))
    (if userlun (setvar "lunits" userlun))
    (setq useros  nil
          usercmd nil
          userlun nil
    )
  ) ;end error function  (defun *Error* (msg) ; embedded defun


  (setq useros  (getvar "osmode")
        usercmd (getvar "CMDECHO")
        userlun (getvar "lunits")
  )

  (setvar "osmode" 1) ; = endpoint
  (setvar "Lunits" 4) ; Feet & Inches
  ;;  Load a global variable if null
  (setq *elev* (cond (*elev*) (t (distof "100'"))))
  (setq elev (Getdist (strcat "\nReference level (100'-6\"or 100.5') <" (rtos *elev* 4 2) ">: ")))
  (if (null elev)
     (setq elev *elev*) ; use global
     (setq *elev* elev) ; reset global
  )
 
  (setq *slp* (cond (*slp*) (0.01)))
  (setq slp
         (getreal
           (strcat "\nEnter Slope Percentage, - for slope down ( 3 = .03 or 3%) <"
                   (rtos (* 100 *slp*) 2 2) ">: ")
         )
  )
  (if (null slp)
     (setq slp *slp*) ; use global
     (setq *slp* (/ slp 100)) ; reset global
  )

  (initget 128) ; get point OR number OR string
  (setq p1 (getpoint "\nPick 1st point or enter DISTANCE: "))
  (cond
    ((listp p1) ; got a point
     (if (setq p2 (getpoint p1 "\nPick 2nd point of DISTANCE: "))
       (setq dist (distance p1 p2))
     )
    )
    ((numberp p1) ; got a number
     (setq dist p1)
    )
    ((setq dist (distof p1)) ; got a string, convert to number
    )
  )
  (cond
    ((not (numberp elev))
     (prompt "\n***  Error in Elevation  ***")
    )
    ((not (numberp slp))
     (prompt "\n***  Error in Slope  ***")
    )
    ((not (numberp dist))
     (prompt "\n***  Error in Distance  ***")
    )
    (t
     (setq slp  (/ slp 100.0)
           elev (/ elev 12.0)
           chg  (rtos (+ elev (* (/ dist 12.0) slp)) 2 2)
     )
     (prompt (strcat "\n[Start Elev=" (rtos elev 2 2) "'] [Distance="
               (rtos dist 4 2) "] ")
     )
     (if (minusp slp)
       ;;-----slope calculation
       (prompt (strcat "[Level below is : " chg "']"))
       (prompt (strcat "[Level above is : " chg "']"))
     )
    )
  )
  (*error* "")
  (princ)
)
(prompt "\nSlope Calc Loaded, Enter slvl to run.")
(princ)

[MSTG007]

Thank you CAB. that works:)

The above last lisp that i posted. The same code you applied to this one, Can i apply to the one which i am getting this wierd error too.

"Command: sltag
.undo Enter the number of operations to undo or
[Auto/Control/BEgin/End/Mark/Back] <1>: begin
Command: Enter Starting Elevation <1200.0000>:
Backtrace:
[0.49] (VL-BT)
[1.45] (*ERROR* "bad argument type: numberp: #<SUBR @05b2f768 ->")
[2.40] (_call-err-hook #<SUBR @0ab4f3e8 *ERROR*> "bad argument type: numberp:
#<SUBR @05b2f768 ->")
[3.34] (sys-error "bad argument type: numberp: #<SUBR @05b2f768 ->")
:ERROR-BREAK.29 nil
[4.26] (RTOS #<SUBR @05b2f768 -> 2  
[5.19] (C:SLTAG)
[6.15] (#<SUBR @0ab4f514 -rts_top->)
[7.12] (#<SUBR @05a72334 veval-str-body> "(C:SLTAG)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)"

Is MP right about the call of RTOS?

[CAB]

Is MP right about the call of RTOS?

MP is always right.
 

[CAB]

Thank you CAB. that works:)

The above last lisp that i posted. The same code you applied to this one, Can i apply to the one which i am getting this wierd error too.

You are welcome.
And Yes you can.

[MSTG007]

grrh still no luck

Code: [Select]


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Slope Tag  V1.2, 1989, '92
;; by RBCulp - Falcon Design Services, Inc.
;;
;; NO RIGHTS RESERVED; Any and all content may reproduced by any method on any medium for any reason.
;; Please, feel free to use any part found useful, interesting, enlightening or entertaining.
;; If by some chance, someone wishes to be credited for this, go right ahead.
;;
;; Falcon Design Services (FDS) provides this program "as is" and with all faults.
;; FDS specifically disclaims any implied warranty of merchantability or fitness for a particular use.  
;; FDS does not warrant that the operation of the program will be uninterrupted or error free.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:sltag ( / scft nstelev nslope FIRSTPT PT1 PT2 distm dist1 nxtelev)
(defun *error* (msg)
    (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    ) ; endif
    ;;reset all variables here
    (if useros (setvar "osmode" useros))
    (if usercmd (setvar "CMDECHO" usercmd))
    (if userlun (setvar "lunits" userlun))
    (setq useros  nil
          usercmd nil
          userlun nil
    )
  ) ;end error function  (defun *Error* (msg) ; embedded defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;Set defaults on first use
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (= stelev nil)  (setq stelev 1200.00))
(if (= slope nil)   (setq slope -0.002))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command ".undo" "begin")
(setvar "attdia" 0)
(setvar "texteval" 1)
(setq scft (getvar "dimscale"))
 (if (= 2 (getvar "lunits")) (setq tunit 2 tprec 3) )
 (if (= 4 (getvar "lunits")) (setq tunit 4 tprec 4) )
   (if (setq nstelev (getdist (strcat "Enter Starting Elevation <" (RTOS stelev) ">: ")))
       (setq stelev nstelev)
   )
   (if (setq nslope (getreal (strcat "Enter Slope Factor (Negative For Down) <" (RTOS slope 2 8) ">: ")))
       (setq slope nslope)
   )
  (setq FIRSTPT (getpoint "Select Starting point ")
   PT2 (getpoint FIRSTPT "\nNext point ")
   distm (distance firstpt pt2)
   nxtelev (+ (* distm slope) stelev)
  )
(princ (strcat "\n                        Distance is  " (rtos (distance firstpt pt2))))
(princ (strcat "\n                           Slope is  " (rtos (* distm slope))))
(princ (strcat "\n                       Elevation is  " (rtos nxtelev tunit tprec)))
;;;; (txstla)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "-insert" "E:/CAD/Ielev" "s" scft "r" "0" pt2 (strcat (rtos nxtelev 2 2)" "))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (while (/= PT2 nil)
    (setq PT1 PT2)
    (setq PT2 (getpoint PT1 "\n\nNext point "))
    (if (/= PT2 nil)
      (progn
   (setq dist1 (distance pt1 pt2)
         distm (+ distm dist1)
         nxtelev (+ (* dist1 slope) nxtelev)
   )
   (princ (strcat "\n                        Distance is  " (rtos dist1)))
   (princ (strcat "\n                           Slope is  " (rtos (* dist1 slope))))
   (princ (strcat "\n                       Elevation is  " (rtos nxtelev tunit tprec)))
   (princ (strcat "\n          Running Total Distance is  " (rtos distm)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "-insert" "E:/CAD/Ielev" "s" scft "r" "0" pt2 (strcat (rtos nxtelev 2 2)" "))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      )
    )
  )
   (princ (strcat "\n\n          Final Total Distance is  " (rtos distm)))
(setvar "attdia" 1)
(command ".undo" "end")
(*error* "")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


[CADaver]

The program uses GETDIST when asking for the input, how are you entering that distance?

3% is text not a distance .03 is a distance.

[MSTG007]

as .03 = 3%

[CADaver]

as .03 = 3%

Exactly, if you answer the prompt with .03 eveything should work, but if you entered 3% it'd blow up.

[MP]

MP is always right.

The only time I was ever right was the time I stated that I am frequently wrong.

[Jeff_M]

The problem with the code is that "slope" is a defined function, and it is this line that is cfreating the problem:
(if (= slope nil)   (setq slope -.002))

-.002 is NOT a real number so lisp is interpreting it as a new subroutine. Change it to be -0.002 and all will be well.