Friday, February 14, 2025

AutoLISP Program that iterates through selected lines, calculates their angles and lengths, and then annotates them

 In other words, the autoLISP program will select a line, get its bearing and distance and write the values on beside the line. The distance is in meters and the bearing format is in Whole Circle Bearing and DD°MM'SS


(defun c:BRGDIST (/ ss i entData ptStart ptEnd dx dy angleRad angleDeg wcb bearingStr dist midpoint)
  ; Function to convert decimal degrees to DMS (degrees, minutes, seconds)
  (defun DEGtoDMS (deg / d m s)
    (setq d (fix deg)) ; Degrees
    (setq m (fix (* (- deg d) 60))) ; Minutes
    (setq s (* (- (* (- deg d) 60) m) 60)) ; Seconds
    (strcat (itoa d) "°" (itoa m) "'" (rtos s 2 2) "\"") ; Format as DD°MM'SS"
  )

  ; Select lines
  (setq ss (ssget '((0 . "LINE"))))
  (if ss
    (progn
      (setq i 0)
      (repeat (sslength ss)
        ; Extract line data
        (setq entData (entget (ssname ss i)))
        (setq ptStart (cdr (assoc 10 entData))) ; Start point
        (setq ptEnd (cdr (assoc 11 entData)))   ; End point
        
        ; Calculate bearing
        (setq angleRad (angle ptStart ptEnd)) ; Angle in radians (from X-axis, counterclockwise)
        (setq angleDeg (/ (* angleRad 180.0) pi)) ; Convert to degrees
        
        ; Convert to Whole Circle Bearing (clockwise from north, 0°-360°)
        (setq wcb (rem (+ (- 90 angleDeg) 360) 360)) ; Adjust for WCB
        (setq bearingStr (DEGtoDMS wcb)) ; Convert WCB to DMS format
        
        ; Calculate distance
        (setq dist (rtos (distance ptStart ptEnd) 2 2)) ; Distance with 2 decimal places
        
        ; Calculate midpoint
        (setq midpoint (list
          (/ (+ (car ptStart) (car ptEnd)) 2.0)
          (/ (+ (cadr ptStart) (cadr ptEnd)) 2.0)
        ))
        
        ; Create text at midpoint
        (entmake
          (list
            '(0 . "TEXT")
            (cons 10 midpoint)          ; Insertion point
            (cons 40 5)               ; Text height
            (cons 1 (strcat bearingStr "      " dist"m")) ; Bearing (DMS) + distance
            (cons 50 angleRad)          ; Rotation angle (aligned with line)
            (cons 7 "Standard")         ; Text style
          )
        )
        (setq i (1+ i))
      )
    )
  )
  (princ)
)


This will create a new layer for the annotation

(defun c:BRGDIST (/ ss i entData ptStart ptEnd dx dy angleRad angleDeg wcb bearingStr dist midpoint)
  ; Function to convert decimal degrees to DMS (degrees, minutes, seconds)
  (defun DEGtoDMS (deg / d m s)
    (setq d (fix deg)) ; Degrees
    (setq m (fix (* (- deg d) 60))) ; Minutes
    (strcat (itoa d) "°" (itoa m) "'") ; Format as DD° MM'
    ;; (setq s (* (- (* (- deg d) 60) m) 60)) ; Seconds
    ;; (strcat (itoa d) "°" (itoa m) "'" (rtos s 2 2) "\"") ; Format as DD° MM' SS"
  )

  ; Create or use the annotation layer
  (if (not (tblsearch "LAYER" "BRG_DIST"))
    (command "._LAYER" "_M" "BRG_DIST" "_C" "1" "" "") ; Create layer and set color to red
  )
  (setvar "CLAYER" "BRG_DIST") ; Set current layer to BRG_DIST

  ; Select lines
  (setq ss (ssget '((0 . "LINE"))))
  (if ss
    (progn
      (setq i 0)
      (repeat (sslength ss)
        ; Extract line data
        (setq entData (entget (ssname ss i)))
        (setq ptStart (cdr (assoc 10 entData))) ; Start point
        (setq ptEnd (cdr (assoc 11 entData)))   ; End point
        
        ; Calculate bearing
        (setq angleRad (angle ptStart ptEnd)) ; Angle in radians (from X-axis, counterclockwise)
        (setq angleDeg (/ (* angleRad 180.0) pi)) ; Convert to degrees
        
        ; Convert to Whole Circle Bearing (clockwise from north, 0°-360°)
        (setq wcb (rem (+ (- 90 angleDeg) 360) 360)) ; Adjust for WCB
        (setq bearingStr (DEGtoDMS wcb)) ; Convert WCB to DMS format
        
        ; Calculate distance
        (setq dist (rtos (distance ptStart ptEnd) 2 2)) ; Distance with 2 decimal places
        
        ; Calculate midpoint
        (setq midpoint (list
          (/ (+ (car ptStart) (car ptEnd)) 2.0)
          (/ (+ (cadr ptStart) (cadr ptEnd)) 2.0)
        ))
        
        ; Create text at midpoint
        (entmake
          (list
            '(0 . "TEXT")
            (cons 10 midpoint)          ; Insertion point
            (cons 40 5)               ; Text height
            (cons 1 (strcat bearingStr "   " dist "m")) ; Bearing (DMS) + distance
            (cons 50 angleRad)          ; Rotation angle (aligned with line)
            (cons 7 "Standard")         ; Text style
            (cons 8 "BRG_DIST")         ; Layer
          )
        )
        (setq i (1+ i))
      )
    )
  )
  (princ)
)

Happy Coding!

No comments:

Post a Comment