;;; ---------------------------------------------------------------------
;;;  CRVDTL-bgol.lsp
;;;  Command:  CVDT
;;;
;;;  PURPOSE
;;;  Scans a selected alignment polyline (LWPOLYLINE) for arc segments
;;;  (vertices with a non-zero bulge) and, for every curve found in
;;;  alignment order, computes and reports the deflection angle,
;;;  circular radius, curve length, and starting/ending chainage.
;;;  A default design Speed is prompted once and stamped on every curve.
;;;  Results are written as text blocks next to each curve, and echoed
;;;  to the command line / text screen.
;;;
;;;  USAGE
;;;    1. Load this file (APPLOAD or drag-drop onto the drawing window).
;;;    2. Type   CVDT   at the command line and press Enter.
;;;    3. Select the alignment polyline containing one or more curves.
;;;    4. Enter a default design speed when prompted.
;;;    5. For every curve (bulge segment) found, a small design-details
;;;       table (Curve Name, Deflection Angle, Radius, Transition Length,
;;;       Start/End Chainage, Curve Length, Speed) is written as text
;;;       entities near the curve's midpoint, on layer "BGOL-CVDT".
;;;
;;;  NOTES
;;;    - Transition Length defaults to 0; edit per-curve manually if a
;;;      real transition length is known.
;;;    - This is an original, independently written implementation.
;;;      It is INSPIRED by the general idea of curve-data-extraction
;;;      utilities common in road/rail/channel alignment design
;;;      workflows, but the code, command name and file name here are
;;;      new and are NOT copied from, nor identical to, any specific
;;;      third-party product.
;;;
;;;  ---------------------------------------------------------------------
;;;  Developed and shared for the CAD community by:  BGol Community
;;;  Community website:                              https://bgol.in/
;;;  License:  Open-source & free to use, modify, and share for all.
;;;            Provided "as is", without warranty of any kind.
;;;  ---------------------------------------------------------------------

(vl-load-com)

(defun BGOL:CVDT-EnsureLayer (lname / )
  (if (not (tblsearch "LAYER" lname))
    (entmake (list '(0 . "LAYER")
                   '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbLayerTableRecord")
                   (cons 2 lname)
                   '(70 . 0)
                   '(62 . 3)          ; green
                   '(6 . "Continuous")))
  )
)

(defun BGOL:CVDT-MakeText (pt ht str lname / )
  (entmake (list '(0 . "TEXT")
                  '(100 . "AcDbEntity")
                  (cons 8 lname)
                  '(100 . "AcDbText")
                  (cons 10 pt)
                  (cons 40 ht)
                  (cons 1 str)
                  (cons 50 0.0)))
)

;; Write one curve's design-detail block as stacked text lines near pt
(defun BGOL:CVDT-WriteBlock (pt curveNo defl radius translen
                              chStart chEnd curveLen spd lname / ht i lines ln)
  (setq ht 0.85)
  (setq lines (list
    (strcat "Curve Name: Curve " (itoa curveNo))
    (strcat "Deflection Angle: " (rtos defl 2 3))
    (strcat "Circular Radius: " (rtos radius 2 3))
    (strcat "Transition Length: " (rtos translen 2 0))
    (strcat "Starting Chainage: " (rtos chStart 2 3))
    (strcat "Ending Chainage: " (rtos chEnd 2 3))
    (strcat "Circular Curve Length: " (rtos curveLen 2 3))
    (strcat "Speed: " (rtos spd 2 0))
  ))
  (setq i 0)
  (foreach ln lines
    (BGOL:CVDT-MakeText (list (car pt) (- (cadr pt) (* i (* ht 1.4))) 0.0) ht ln lname)
    (setq i (1+ i))
  )
)

(defun C:CVDT ( / ent edata obj vlist n i vtx bulge pt1 pt2 chord ang radius
                  curveLen chStart chEnd midPt spd curveNo lname)
  (setq lname "BGOL-CVDT")
  (BGOL:CVDT-EnsureLayer lname)
  (setq ent (car (entsel "\nSelect alignment polyline: ")))
  (if (and ent (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE"))
    (progn
      (setq edata (entget ent))
      (setq obj (vlax-ename->vla-object ent))
      (setq spd (getreal "\nEnter default design speed: "))
      (if (null spd) (setq spd 0.0))

      ;; collect vertex + bulge pairs from DXF data (10 = point, 42 = bulge)
      (setq vlist '())
      (foreach pair edata
        (cond
          ((= (car pair) 10) (setq vlist (append vlist (list (list (cdr pair) 0.0)))))
          ((= (car pair) 42)
           (if vlist
             (setq vlist (append (reverse (cdr (reverse vlist)))
                                  (list (list (caar (reverse vlist)) (cdr pair)))))
           )
          )
        )
      )

      (setq n (length vlist))
      (setq curveNo 0)
      (setq i 0)
      (while (< i (1- n))
        (setq vtx   (nth i vlist))
        (setq pt1   (car vtx))
        (setq bulge (cadr vtx))
        (setq pt2   (car (nth (1+ i) vlist)))
        (if (and bulge (/= bulge 0.0))
          (progn
            (setq curveNo (1+ curveNo))
            (setq chord  (distance pt1 pt2))
            (setq ang    (* 4.0 (atan bulge)))          ; deflection angle (radians)
            (setq radius (/ chord (* 2.0 (sin (/ (abs ang) 2.0)))))
            (setq curveLen (* radius (abs ang)))
            (setq chStart (vlax-curve-getDistAtParam obj (vlax-curve-getParamAtPoint obj pt1)))
            (setq chEnd   (vlax-curve-getDistAtParam obj (vlax-curve-getParamAtPoint obj pt2)))
            (setq midPt   (list (/ (+ (car pt1) (car pt2)) 2.0)
                                 (+ (/ (+ (cadr pt1) (cadr pt2)) 2.0) 3.0)
                                 0.0))
            (BGOL:CVDT-WriteBlock midPt curveNo (/ (abs ang) (/ pi 180.0)) radius 0.0
                                   chStart chEnd curveLen spd lname)
            (princ (strcat "\nCurve " (itoa curveNo)
                            "  Defl=" (rtos (/ (abs ang) (/ pi 180.0)) 2 3)
                            "  R="    (rtos radius 2 3)
                            "  L="    (rtos curveLen 2 3)))
          )
        )
        (setq i (1+ i))
      )
      (if (= curveNo 0)
        (princ "\nNo curve (bulge) segments found on selected polyline.")
        (princ (strcat "\n" (itoa curveNo) " curve(s) processed. Details on layer " lname "."))
      )
    )
    (princ "\nNo LWPOLYLINE alignment selected. Nothing processed.")
  )
  (princ)
)

(princ "\nCRVDTL-bgol.lsp loaded. Type CVDT to extract curve design details from an alignment.")
(princ "\n  -- Free & open-source, courtesy of BGol Community (https://bgol.in/) --")
(princ)