Need a routine lisp for bearing & azimuth in realtime.

2026-01-12T03:33:25Z

Good day once again..and Happy new year..

tired of doing manual and change the units everytime check the direction..

here is the photo.

Thanks in advanced.

Edited yesterday at 03:35 AM by oliver

2026-01-12T13:31:22Z

going to use grread and mouse pointer. maybe edit Demo2?

Edited yesterday at 02:37 PM by mhupp
Demo2 url

2026-01-12T14:30:10Z

A start with this?

(vl-load-com)
(defun c:label_bearing ( / l_var AcDoc Space nw_style nw_obj dxf_text pt1 pt2 dxf_line key pt alpha len_l m_pt val_txt)
  (setq l_var (mapcar 'getvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS" "TEXTSIZE")))
  (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
      ""
    )
    dxf_text (entget (entlast))
  )
  (initget 1)
  (setq
    pt1 (getpoint "\nPick base point: ")
    pt2 pt1
  )
  (entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt2)))
  (setq dxf_line (entget (entlast)))
  (while (equal pt2 pt1)
    (setq pt2
      ((lambda ( / key pt 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)
              (setq
                pt (cadr key)
                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 alpha) "\\P " (rtos len_l) " m"))
                dxf_line
                (entmod
                  (subst
                    (cons 11 pt)
                    (assoc 11 dxf_line)
                    dxf_line
                  )
                )
              )
              (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)
              )
              (entmod
                (subst
                  (cons 50 alpha)
                  (assoc 50 dxf_text)
                  (subst (cons 10 (polar m_pt (+ alpha (* pi 0.5)) (getvar "TEXTSIZE"))) (assoc 10 dxf_text) dxf_txt)
                )
              )
            )
          )
        )
        (cadr key)
      ))
    )
  )
  (vla-endundomark AcDoc)
  (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS" "TEXTSIZE") l_var)
  (prin1)
)

2026-01-13T01:34:51Z

11 hours ago, Tsuky said:

A start with this?

(vl-load-com)
(defun c:label_bearing ( / l_var AcDoc Space nw_style nw_obj dxf_text pt1 pt2 dxf_line key pt alpha len_l m_pt val_txt)
  (setq l_var (mapcar 'getvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS" "TEXTSIZE")))
  (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
      ""
    )
    dxf_text (entget (entlast))
  )
  (initget 1)
  (setq
    pt1 (getpoint "\nPick base point: ")
    pt2 pt1
  )
  (entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt2)))
  (setq dxf_line (entget (entlast)))
  (while (equal pt2 pt1)
    (setq pt2
      ((lambda ( / key pt 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)
              (setq
                pt (cadr key)
                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 alpha) "\\P " (rtos len_l) " m"))
                dxf_line
                (entmod
                  (subst
                    (cons 11 pt)
                    (assoc 11 dxf_line)
                    dxf_line
                  )
                )
              )
              (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)
              )
              (entmod
                (subst
                  (cons 50 alpha)
                  (assoc 50 dxf_text)
                  (subst (cons 10 (polar m_pt (+ alpha (* pi 0.5)) (getvar "TEXTSIZE"))) (assoc 10 dxf_text) dxf_txt)
                )
              )
            )
          )
        )
        (cadr key)
      ))
    )
  )
  (vla-endundomark AcDoc)
  (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS" "TEXTSIZE") l_var)
  (prin1)
)

Thank you the code is perfectly fine and work..but some a little adjustment

here some photos and hope the osnap works this time..

Edited 20 hours ago by oliver

2026-01-13T04:45:04Z

Nice Tsuky tho i use this when setting multiple variables. less likely to get the order mixed up if their is only one list.

  (setq vars '(DIMZIN ANGDIR ANGBASE AUNITS AUPREC LUPREC LUNITS TEXTSIZE)  ;list of variables
        vals (mapcar 'getvar vars)      ;store old values
  )
  (mapcar 'setvar vars (list 0 1 (* pi 0.5) 4 3 2 2))  ;set new values
  ...
  (mapcar 'setvar vars vals)  ;restore old values

@oliver i think you want North to be 0 instead of East? so you have to subtract that from the angle in angtos. updating this line should give you what your looking for.

val_txt (vl-string-subst "%%d" "d" (strcat (angtos (- (/ pi 2) alpha) 4 3) "\\P " (rtos len_l) " m"))

2026-01-13T08:31:50Z

this code..work perfectly...

val_txt (vl-string-subst "%%d" "d" (strcat (angtos (- (/ pi 2) alpha) 4 3) "\\P " (rtos len_l) " m"))

but some little adjustment the osnap was not working..

much better if we have an option to select..BEARING OR DEGREES from my previous post.

Have a good day..

thanks.

2026-01-13T13:00:28Z

Must have deleted from my other post, But how grread works I don't know if you can use snaps. every time you move the mouse it updates the point and calculation. maybe Tsuky knows of a way.

2026-01-13T14:17:34Z

I don't really see the point of the dynamic mode in your function, especially if you want to snap to objects. This would seem to me to be sufficient and would resolve the osnap.

(vl-load-com)
(defun c:label_bearing ( / l_var AcDoc Space nw_style nw_obj pt1 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
      ""
    )
  )
  (initget 1)
  (setq pt1 (getpoint "\nPick base point: "))
  (initget 1)
  (setq pt (getpoint pt1 "\nPick other point: "))
  (entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt)))
  (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 alpha) "\\P " (rtos len_l) " m"))
  )
  (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)
  )
  (vla-endundomark AcDoc)
  (mapcar 'setvar '("DIMZIN" "ANGDIR" "ANGBASE" "AUNITS" "AUPREC" "LUPREC" "LUNITS" "TEXTSIZE") l_var)
  (prin1)
)

However, if you absolutely want the dynamic mode with the possibility of osnap, here is the redesigned function attached. ("osmode" must be defined beforehand, no possibility to force it when using the function)
My management is succinct: only: "_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea"

For a more elaborate management see perhaps the LeeMac function

label_bearing.lsp

2026-01-13T20:05:33Z

7 hours ago, mhupp said:

Must have deleted from my other post, But how grread works I don't know if you can use snaps. every time you move the mouse it updates the point and calculation. maybe Tsuky knows of a way.

See the links in this post for information on using snaps with grread. (The entire thread is a good read)

2026-01-13T20:17:45Z

FYI... You can call osnap menu while using (grread) in (while) loop... Read this message : https://www.theswamp.org/index.php?topic=12813.msg580708#msg580708

And further more, I'd read complete topic - there are many examples, but you need to be logged to download routines posted with messages...

Sign In

Need a routine lisp for bearing & azimuth in realtime.

Recommended Posts

oliver

mhupp

Tsuky

oliver

mhupp

oliver

mhupp

Tsuky

SLW210

marko_ribar

Join the conversation

Tutorials

Forums

Activity