; ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
; ³    C U R V E D A T  v1.4     ³± 
; ³   Copyright (c) 1991, 1992   ³±
; ³     by Kurtis J. Jones /     ³± 
; ³        -Mate Software        ³±
; ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ±
;  ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
;
;
; DISCLAIMER OF WARRANTY:
; -----------------------
;
; THIS SOFTWARE AND MANUAL ARE PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND,
; EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
; WARRANTIES OF MERCHANTABILITY AND FITNESS OF PURPOSE.  THE USER OF THIS
; SOFTWARE AND MANUAL ASSUMES ALL RISKS.
;
;
; INSTRUCTIONS/USE:
; -----------------
;
; Unmodified copies of this program and the accompanying documentation may be
; made and distributed freely without charge.  Under no circumstances shall
; this program or the accompanying documentation be distributed as part of any
; for-profit venture, without expressed written permission from the author.
;
; This simple LISP program will allow you to select an arc entity, such as
; The center line of a highway curve, and display a "standard" highway curve
; data table for the curve on your AutoCAD drawing.  In order for the program
; to function properly, you must have the drawing block file "CURVEDAT.DWG"
; located in the AutoCAD sub-directory, or else make the necessary changes to
; this AutoLISP file in the block insertion line.
;
; CURVEDAT will only work on 2-D arc entities, and will not work on
; polylines.
;
; If you have any questions are comments about CURVEDAT, I can be reached
; via THE SPECTRUM BBS, (501) 521-5639.
;
;------------------------------------------------------------------------------
; * Error trapping *
;------------------------------------------------------------------------------
;
(defun *ERROR* (ERR_MSG)
   (if (/= ERR_MSG "Function cancelled")
      (if (/= ERR_MSG "quit / exit abort")
         (prompt (strcat "\nE_R_R_O_R_!: " ERR_MSG "\n "))
      )
   )
   (curvend)
)
;
;------------------------------------------------------------------------------
; * This routine converts the stations to "+" format *
;------------------------------------------------------------------------------
;
(defun STAPLUS (STA)
   (setq STA1 (rtos (fix (/ STA 100)) 2 0))
   (setq LSTA1 (+ (strlen STA1) (if (=  STA1 "0") 0 1)))
   (setq STA2 (substr (rtos STA 2 2) LSTA1))
   (setq STA (strcat STA1 "+" STA2))
)
;
;------------------------------------------------------------------------------
; * This routine converts angle labels "d" to "%%d" *
;------------------------------------------------------------------------------
;
(defun DX (ANGL)
   (setq DC 2)
   (while (/= (substr ANGL DC 1) "d")
      (setq DC (1+ DC))
   )
   (setq ANGL (strcat (substr ANGL 1 (- DC 1)) "%%" (substr ANGL DC)))
)
;
;------------------------------------------------------------------------------
; * End of program *
;------------------------------------------------------------------------------
;
(defun CURVEND()
   (setvar "ATTDIA" CRV_AD)
   (setvar "CMDECHO" CRV_CE)
   (princ)
)
;
;------------------------------------------------------------------------------
; * This is the main program routine *
;------------------------------------------------------------------------------
;
(defun C:CURVEDAT ()
   (setq CRV_AD (getvar "ATTDIA"))
   (setq CRV_CE (getvar "CMDECHO"))
   (setvar "ATTDIA" 0)
   (setvar "CMDECHO" 0)
   (prompt "\n ")
   (prompt "\nC U R V E D A T  v1.4 -- Copyright (c) 1991, 1992 by Kurtis J. Jones /")
   (prompt "\n                                                     -Mate Software ")
   (setq CURVE (entget (car (entsel "\nSelect Curve... "))))
   (while (/= (cdr (assoc 0 CURVE)) "ARC")
      (prompt "\nSelected curve MUST be an ARC SEGMENT!")
      (setq CURVE (entget (car (entsel "\nSelect Curve... "))))
   )
   (setq R (cdr (assoc 40 CURVE)))
   (setq DELTA (abs (- (cdr (assoc 51 CURVE)) (cdr (assoc 50 CURVE)))))
   (if (> DELTA pi) (setq DELTA (- (* 2 pi) DELTA)))
   (setq L (* DELTA  R))
   (setq D (/ 100 R))
   (setq T (* R (/ (sin (/ DELTA 2))(cos (/ DELTA 2)))))
   (setq E (* T (/ (sin (/ DELTA 4))(cos (/ DELTA 4)))))
   (setq cno (getstring "\nEnter Curve Number: "))
   (setq PC (getreal "\nEnter PC Station: "))
   (setq P (+ PC T))
   (setq PT (+ PC L))
   (setq PT (STAPLUS PT))
   (setq PC (STAPLUS PC))
   (setq P (STAPLUS P))
   (setq E (rtos E 2 4))
   (setq T (rtos T 2 4))
   (setq L (rtos L 2 4))
   (setq R (rtos R 2 4))
   (setq D (dx (angtos D 1 4)))
   (setq DELTA (dx (angtos DELTA 1 4)))
   (setq LTS (getvar "LTSCALE"))
   (prompt "\nInsert Point: ")
   (command "insert" "curvedat" pause LTS "" "" CNO PT PC P E T L R D DELTA)
   (curvend)
)
;
;------------------------------------------------------------------------------
; * End of file *
;------------------------------------------------------------------------------
;