Need a routine lisp for bearing & azimuth in realtime.

[oliver]

On 1/16/2026 at 12:11 AM, Tsuky said:

@oliver Try to reload the code at this answer

Good day..

(vl-load-com)
(defun gr-osmode (pt-i str-md / n pt md rap pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt56 pt67 pt78 pt85 one_o)
	(setq n (/ (cadr (getvar "screensize")) 5.0))
	(setq pt (osnap pt-i str-md))
	(while (and (eq (strlen (setq md (substr str-md 1 4))) 4) (not one_o))
		(repeat 2
			(setq
				rap (/ (getvar "viewsize") n)
				pt1 (list (- (car pt) rap) (- (cadr pt) rap) (caddr pt))
				pt2 (list (+ (car pt) rap) (- (cadr pt) rap) (caddr pt))
				pt3 (list (+ (car pt) rap) (+ (cadr pt) rap) (caddr pt))
				pt4 (list (- (car pt) rap) (+ (cadr pt) rap) (caddr pt))
				pt5 (list (car pt) (- (cadr pt) rap) (caddr pt))
				pt6 (list (+ (car pt) rap) (cadr pt) (caddr pt))
				pt7 (list (car pt) (+ (cadr pt) rap) (caddr pt))
				pt8 (list (- (car pt) rap) (cadr pt) (caddr pt))
				pt56 (polar pt (- (/ pi 4.0)) rap)
				pt67 (polar pt (/ pi 4.0) rap)
				pt78 (polar pt (- pi (/ pi 4.0)) rap)
				pt85 (polar pt (+ pi (/ pi 4.0)) rap)
				n (- n 16)
			)
			(if (equal (osnap pt-i md) pt) (setq one_o T))
			(cond
				((and (eq "_end" md) one_o)
					(grdraw pt1 pt2 1) (grdraw pt2 pt3 1) (grdraw pt3 pt4 1) (grdraw pt4 pt1 1)
				)
				((and (eq "_mid" md) one_o)
					(grdraw pt1 pt2 1) (grdraw pt2 pt7 1) (grdraw pt7 pt1 1)
				)
				((and (eq "_cen" md) one_o)
					(grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
					(grdraw pt5 pt7 7) (grdraw pt6 pt8 7)
				)
				((and (eq "_nod" md) one_o)
					(grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
					(grdraw pt1 pt3 1) (grdraw pt2 pt4 1)
				)
				((and (eq "_qua" md) one_o)
					(grdraw pt5 pt6 1) (grdraw pt6 pt7 1) (grdraw pt7 pt8 1) (grdraw pt8 pt5 1)
				)
				((and (eq "_int" md) one_o)
					(grdraw pt1 pt3 1) (grdraw pt2 pt4 1)
				)
				((and (eq "_ins" md) one_o)
					(grdraw pt5 pt2 1) (grdraw pt2 pt6 1) (grdraw pt6 pt8 1) (grdraw pt8 pt4 1) (grdraw pt4 pt7 1) (grdraw pt7 pt5 1)
				)
				((and (eq "_per" md) one_o)
					(grdraw pt1 pt2 1) (grdraw pt1 pt4 1) (grdraw pt8 pt 1) (grdraw pt pt5 1)
				)
				((and (eq "_tan" md) one_o)
					(grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
					(grdraw pt3 pt4 1)
				)
				((and (eq "_nea" md) one_o)
					(grdraw pt1 pt2 1) (grdraw pt2 pt4 1) (grdraw pt4 pt3 1) (grdraw pt3 pt1 1)
				)
			)
		)
		(setq str-md (substr str-md 6) n (/ (cadr (getvar "screensize")) 5.0))
	)
)
(defun c:LBB ( / l_var AcDoc Space nw_style nw_obj o mod pt1 pt2 pt key pt alpha len_l m_pt val_txt)
	(setq l_var (mapcar 'getvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS" "TEXTSIZE")))
	(initget "Bearing Degrees")
	(if (eq (getkword "\nResult in [Bearing/Degrees]?<Bearing>: ") "Degrees")
		(mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS") (list 0 1 (* pi 1.5) 1 3 2 2))
		(mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS") (list 0 1 (* pi 0.5) 4 3 2 2))
	)
	(setvar "TEXTSIZE" (* (getvar "VIEWSIZE") 0.015))
	(setq
		AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
		Space
		(if (= 1 (getvar "CVPORT"))
			(vla-get-PaperSpace AcDoc)
			(vla-get-ModelSpace AcDoc)
		)
	)
	(vla-startundomark AcDoc)
	(cond
		((null (tblsearch "STYLE" "BEARING"))
			(setq nw_style (vla-add (vla-get-textstyles AcDoc) "BEARING"))
			(mapcar
				'(lambda (pr val)
					(vlax-put nw_style pr val)
				)
				(list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
				(list "romand.shx" 0.0 0.0 1.0 0.0)
			)
		)
	)
	(setq
		nw_obj
		(vla-addMtext Space
			(vlax-3d-point '(0.0 0.0 0.0))
			0.0
			""
		)
	)
	(setq o (getvar "osmode"))
	(if (or (zerop o) (eq (boole 1 o 16384) 16384))
		(setq mod "_none")
		(progn
			(setq mod "")
			(mapcar
				'(lambda (xi xs)
					(if (not (zerop (boole 1 o xi)))
						(if (zerop (strlen mod))
							(setq mod (strcat mod xs))
							(setq mod (strcat mod "," xs))
						)
					)
				)
				'(1 2 4 8 16 32 64 128 256 512)
				'("_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea")
			)
		)
	)
	(initget 1)
	(setq
		pt1 (getpoint "\nPick base point: ")
		pt2 pt1
	)
	(while (equal pt2 pt1)
		(setq pt2
			((lambda ( / key alpha len_l m_pt)
				(princ "\nPick other point: ")
				(while (and (setq key (grread T 4 0)) (/= (car key) 3))
					(cond
						((eq (car key) 5)
							(redraw)
							(if (and (/= mod "_none") (osnap (cadr key) mod))
								(progn
									(gr-osmode (cadr key) mod)
									(setq pt (osnap (cadr key) mod))
								)
								(setq pt (cadr key))
							)
							(setq
								alpha (angle pt1 pt)
								len_l (distance pt1 pt)
								m_pt (mapcar '* (mapcar '+ pt1 pt) '(0.5 0.5 0.5))
								val_txt (vl-string-subst "%%d" "d" (strcat (angtos (- (/ pi 2) alpha) 4 3) "\\P " (rtos len_l) " m"))
							)
							(grdraw pt1 pt 7)
							(if (and (> alpha (* pi 0.5)) (<= alpha (* pi 1.5)))
								(setq alpha (+ alpha pi))
							)
							(mapcar
								'(lambda (pr val)
									(vlax-put nw_obj pr val)
								)
								(list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation 'TextString 'Color)
								(list 5 (getvar "TEXTSIZE") 5 m_pt "BEARING" (getvar "CLAYER") alpha val_txt 2)
							)
						)
					)
				)
				(redraw)
				(cadr key)
			))
		)
	)
	(entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt)))
	(vla-endundomark AcDoc)
	(mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS" "TEXTSIZE") l_var)
	(prin1)
)

can you change the two decimal digit into three decimal digits of a distance.

thanks.