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