Second piece of text not annotative
I found a program that will label a distance and azimuth of a line. I modified it to better suit my needs.
I need both text to be annotative.
For some reason only annotative is yes for the first piece of text placed.
Hopefully someone can help me out getting the second piece of text to place with annotation being set to yes.
Here is the code:
;;Bearing and Distance © 2020 Ronald Harman (dlanorh)
;;Released under MIT Licence https://opensource.org/licenses/MIT
;;Modified by JDB for our use
(vl-load-com)
(defun rh:R2D (r) (* 180.0 (/ r pi)))
(defun gc:round (num prec)
(if (zerop (setq prec (abs prec)))
num
(* prec (fix ((if (minusp num) - +) (/ num prec) 0.5)))))
(defun rh:midpoint (pt1 pt2 / pt3)
(setq pt3 (mapcar '(lambda (x y) (/ (+ x y) 2)) pt1 pt2)))
(defun rh:em_txt (pt txt lyr cwa d72 d73)
(entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
(cons 8 "SRVYPLN-BearingDistance-Label") (cons 50 cwa) (cons 7 "Leroy80") (cons 1 txt)
(cons 10 pt) (cons 40 tht) (cons 72 d72) (cons 11 pt) (cons 73 d73)))
;; Change entity to annotative
(command "_chprop" (entlast) "" "Annotative" "Yes")
)
(defun C:qwe ( / error sel ent1 sv_lst sv_vals tht d_rnd a_rnd)
(defun error (msg)
(mapcar 'setvar sv_lst sv_vals)
(if (not (wcmatch (strcase msg) "BREAK,CANCEL,EXIT")) (princ (strcat "\nOops an Error : " msg " occurred.")))
(princ)
) ;enderror_defun
;; Initialize rounding variables
(setq d_rnd 2 ; Default decimal places for distance
a_rnd 5.0) ; Default rounding value for angle seconds
;; Function to prompt user for rounding values
(defun setup-rounding-values ()
(setq d_rnd (getint (strcat "\nEnter decimal places for distance (e.g. 2 = 0.00, 3 = 0.000): ")))
(setq a_rnd (getreal (strcat "\nEnter rounding value for angle seconds (e.g. 5, 10): ")))
)
;; Call setup function to prompt user for rounding values initially
(setup-rounding-values)
;; Loop to allow user to change rounding values until 'Enter' is pressed
(setq exitFlag nil) ; Initialize exit flag(while (not exitFlag) ; Continue until exitFlag is true
(setq sel_result (entsel "\rSelect Line Entity to Label (or press Enter to quit) : "))
(if sel_result ;If an entity is selected
(progn
(setq sel sel_result) ; Assigns the full selection result (ename and details)
(setq ent1 (car sel_result)) ; Assigns the entity name (ename)
(setq sv_lst (list 'cmdecho 'osmode 'dynmode 'dynprompt)
sv_vals (mapcar 'getvar sv_lst)
; tht (getvar 'textsize)
) ;end_setq
(setq csfdim (getvar "dimlfac"))
(setq csf (/ 1.0 csfdim))
;; Extract endpoint coordinates
(setq p1 (cdr (assoc 10 (entget ent1))))
(setq p2 (cdr (assoc 11 (entget ent1))))
;; Calculate scaled distance applying the reciprocal value of dimlfac
(setq scaledDistance (* (distance p1 p2) csfdim))
(setq impdi (/ scaledDistance 0.3048)) ; Convert to imperial distance (feet)
(setq deltaX (- (car p2) (car p1)))
(setq deltaY (- (cadr p2) (cadr p1)))
(setq deltaZ (- (caddr p2) (caddr p1)))
;; Calculate flat horizontal distance
(setq flatHorizontalDistance (sqrt (+ (* deltaX deltaX) (* deltaY deltaY))))
(setq ScaHDist (* flatHorizontalDistance csfdim))
(setq imhdi (/ ScaHDist 0.3048))
(setq angleRad (atan deltaX deltaY)) ; Calculate angle in radians
;; Determine quadrant
(cond
((and (< angleRad 0) (>= angleRad -1.5707963267948966192313216916398)) (setq quadrant "NW"))
((and (< angleRad -1.5707963267948966192313216916398) (> angleRad -3.1415926535897932384626433832795)) (setq quadrant "SW"))
((and (>= angleRad 0) (<= angleRad 1.5707963267948966192313216916398)) (setq quadrant "NE"))
((and (> angleRad 1.5707963267948966192313216916398) (<= angleRad pi)) (setq quadrant "SE"))
)
;; Calculate bearing (CWA) based on quadrant
(setq angr
(cond
((equal quadrant "NW") (abs angleRad))
((equal quadrant "SW") (- 3.1415926535897932384626433832795 (abs angleRad)))
((equal quadrant "NE") angleRad)
((equal quadrant "SE") (- 3.1415926535897932384626433832795 angleRad))
(t 0.0))) ; Default value (you can adjust this)
;; Convert radians to degrees
(setq cwa (* angr (/ 180.0 pi)))
;; Convert decimal degrees to degrees, minutes, seconds
(setq deg (fix cwa))
(setq minu (fix (* (- cwa deg) 60)))
(setq rsec (gc:round (* 3600 (- cwa (+ deg (/ minu 60.0)))) a_rnd)) ; Round seconds
;; Adjust if seconds equals 60
(if (= rsec 60)
(progn
(setq rsec 0)
(setq minu (1+ minu)))) ; Increment minutes by 1
;; Ensure minutes and seconds are always two digits
(setq minu (if (< minu 10)
(strcat "0" (itoa minu)) ; Add leading zero for single-digit minutes
(itoa minu))) ; Convert to string if already two digits
(setq rsec (fix rsec))
(setq rsec (if (< rsec 10)
(strcat "0" (itoa rsec)) ; Add leading zero for single-digit seconds
(itoa rsec))) ; Convert to string if already two digits
;; Format the output string
(setq result_str (strcat
(rtos deg 2 0) "" "%%d" ; Degree symbol
minu "" "'" ; Minute symbol
rsec "" "\"")) ; Second symbol
;; Determine N/S and E/W based on quadrant
(setq northSouth (if (member quadrant '("NE" "NW" "SW")) "N" "S"))
(setq eastWest (if (member quadrant '("NE" "SE" "SW")) "E" "W"))
(setq b_str (strcat northSouth result_str eastWest))
;; User Variables
(setq b_lyr_lst (list "SRVYPLN-BearingDistance-Label") ;; Bearing Layer list (first item is always default)
d_lyr_lst (list "SRVYPLN-BearingDistance-Label") ;; Distance Layer list (first item is always default)
lyr_idx 0 ;; Index for the above lists PLEASE DON'T CHANGE
csfdim (getvar "dimlfac")
csf (/ 1.0 csfdim)
) ;end_setq
(CheckTextStyle (GETVAR "TEXTSTYLE")) ; Check TEXTSTYLE HEIGHTS
(setq tht (* (/ (getvar "userr4") 1000) (getvar "TEXTSIZE"))) ; Set text height
(setq l_obj (vlax-ename->vla-object (car sel)))
(setq l_ang (vlax-get-property l_obj 'angle)
a_txt (strcat northSouth result_str eastWest)
l_txt (strcat (rtos ScaHDist 2 d_rnd))
m_pt (rh:midpoint (vlax-get l_obj 'startpoint) (vlax-get l_obj 'endpoint))
) ;_end_setq
;; Calculate 1/4 and 3/4 points
(setq oneQuarterPt (list (+ (car p1) (* 0.25 deltaX)) (+ (cadr p1) (* 0.25 deltaY)) (+ (caddr p1) (* 0.25 deltaZ))))
(setq threeQuarterPt (list (+ (car p1) (* 0.75 deltaX)) (+ (cadr p1) (* 0.75 deltaY)) (+ (caddr p1) (* 0.75 deltaZ))))
;; Calculate offset points for text insertion
(setq i_ang l_ang)
(if (and (>= l_ang (* pi 0.5)) (< l_ang (* pi 1.5)))
(progn
(setq i_ang (- l_ang pi))
(setq a_pt (polar oneQuarterPt (+ i_ang (* pi 0.5)) (* tht 0.1666666)))
(setq d_pt (polar threeQuarterPt (+ i_ang (* pi 0.5)) (* tht 0.1666666))))
(progn
(setq a_pt (polar oneQuarterPt (+ i_ang (* pi 0.5)) (* tht 0.1666666)))
(setq d_pt (polar threeQuarterPt (+ i_ang (* pi 0.5)) (* tht 0.1666666)))))
; (setq offset_dist (* tht 0.15))
;; ;; Offset direction from 1/4 point
; (setq a_pt (polar oneQuarterPt l_ang offset_dist))
;; ;; Offset direction from 3/4 point
; (setq d_pt (polar threeQuarterPt l_ang offset_dist))
;; Insert texts
(rh:em_txt a_pt a_txt b_lyr i_ang 1 1)
(rh:em_txt d_pt l_txt d_lyr i_ang 1 1)
)
(setq exitFlag t) ; Set exit flag if p1 is nil (Enter was pressed without a point)
)
) ;_end_defun
(princ)
)
Comments
-
Hello.
The (CheckTextStyle) function is missing, I am not sure what it should do.
I tested with a very basic file - no texts were created, so the test might not be conclusive.However, something that could help would be to add an extra pair of double quotes when calling the "_CHPROP" command - they are needed to end the command.
(command "_chprop" (entlast) "" "Annotative" "Yes" "")0