Bearing and Distance Label Orientation

[Anonymous]

Hello everyone! I found this AutoLisp on one of the forums to label lines with a bearing and distance callout... created by: Bruno Valsecchi. 

This is attached as (Original Lisp)... This uses the (plab) command to use any line you choose and bring up the units pop up and label each line with the bearing and distance callout, which works amazing. 

I updated some things and changed the command to (label). This is also attached. 

I was wondering if anyone could adjust my updated lisp to fit with a better orientation to fit within smaller lines? As shown below:

[dlanorh]

      (mapcar
        '(lambda (pr val)
          (vlax-put nw_obj pr val)
        )
        (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation 'width)
        (list 5 (getvar "TEXTSIZE") 5 pt "ELEV_ARIAL_1" "DIMENSIONS" rtx seg_len)
      )

If you make the additions shown above where the MText properties are set, it will set the mtext box width to the length of the segment. It is an inelegant solution however as the shorter the segment gets, the more fragmented the text will appear as it adjusts to the reduced width. It might be worth calculating the minimum width for the "angle" text and testing the seg_len against this, or reducing the text height. You will probably need to change the insertion point to the middle of the segment and adjust the text position using the alignmentpoint property.

[dlanorh]

Ignore my last. I've trimmed the fat. The attached now ensures the correct units are set when the lisp starts and restores on error or exit. It contains a local error routine and undo start and end marks. I haven't implimented the text rotation check or the mtext width->segment length check as i'm tired and making too many error. I'll sort it in the morning.  

[CADaSchtroumpf]

Similar at dlanorh

(vl-load-com)
(defun c:label ( / l_var js htx AcDoc Space nw_style n obj ename pr dist_start dist_end pt_start pt_end seg_len alpha val_txt dim_txt nw_obj)
  (setq l_var (mapcar 'getvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS")))
  (mapcar 'setvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS") '(4 3 2 2))
  (princ "\nSelect polylines.")
  (while (null (setq js (ssget '((0 . "LWPOLYLINE")))))
    (princ "\nSelection is empty or not are LWPOLYLINE!")
  )
  (initget 6)
  (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpecify text height <" (rtos (getvar "TEXTSIZE")) ">: ")))
  (if htx (setvar "TEXTSIZE" htx))
  (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 "LAYER" "DIMENSIONS"))
      (vlax-put (vla-add (vla-get-layers AcDoc) "DIMENSIONS") 'color 7)
    )
  )
  (cond
    ((null (tblsearch "STYLE" "ELEV_ARIAL_1"))
      (setq nw_style (vla-add (vla-get-textstyles AcDoc) "ELEV_ARIAL_1"))
      (mapcar
        '(lambda (pr val)
          (vlax-put nw_style pr val)
        )
        (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
        (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 0.0 1.0 0.0)
      )
    )
  )
  (repeat (setq n (sslength js))
    (setq
      obj (ssname js (setq n (1- n)))
      ename (vlax-ename->vla-object obj)
      pr -1
    )
    (repeat (fix (vlax-curve-getEndParam ename))
      (setq
        dist_start (vlax-curve-GetDistAtParam ename (setq pr (1+ pr)))
        dist_end (vlax-curve-GetDistAtParam ename (1+ pr))
        pt_start (vlax-curve-GetPointAtParam ename pr)
        pt_end (vlax-curve-GetPointAtParam ename (1+ pr))
        seg_len (- dist_end dist_start)
        alpha (angle (trans pt_start 0 1) (trans pt_end 0 1))
        val_txt (vl-string-subst "%%d" "d"(strcat (angtos alpha) " " (rtos seg_len)))
        dim_txt (textbox (list (cons 1 val_txt)))
      )
      (if (> (distance (car dim_txt) (cadr dim_txt)) seg_len)
        (setq val_txt (vl-string-subst "E \\P" "E " val_txt))
      )
      (setq nw_obj
        (vla-addMtext Space
          (vlax-3d-point (setq pt (polar (vlax-curve-GetPointAtParam ename (+ 0.5 pr)) (+ alpha (* pi 0.5)) (getvar "TEXTSIZE"))))
          0.0
          val_txt
        )
      )
      (mapcar
        '(lambda (pr val)
          (vlax-put nw_obj pr val)
        )
        (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
        (list 8 (getvar "TEXTSIZE") 5 pt "ELEV_ARIAL_1" "DIMENSIONS" alpha)
      )
    )
  )
  (vla-endundomark AcDoc)
  (mapcar 'setvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS") l_var)
  (prin1)
)

NB: If you want use .ttf in (vlax-put nw_style pr val) you must use  (strcat (getenv "windir") "\\fonts\\arial.ttf") otherwise autocad don't find the font and an error occure

[dani-perez]

Hello CADaStroumph

Interesting code. I have found a little mistake: if you create the pl to south and west, the texts appears upsidedown, as shown in dwg.

instead of degress, could it display utm coordinates?

thanks.

[Anonymous]

Hi dlanorh,

The lisp that you updated so far is looking pretty good. The bearing is coming in great, but the distance seems to be different. Is there any way you could change the unit type to decimal?

[CADaSchtroumpf]

---

@dani-perez  a écrit :

Hello CADaStroumph

Interesting code. I have found a little mistake: if you create the pl to south and west, the texts appears upsidedown, as shown in dwg.

instead of degress, could it display utm coordinates?

thanks.

---

For upsidedown, you can resolve it with add this line before (if (> (distance (car dim_txt) (cadr dim_txt)) seg_len) ; line 55

(if (and (> alpha (* pi 0.5)) (< alpha (* pi 1.5))) (setq alpha (+ alpha pi)))

For UTM I have no solution, Autocad Map?

[dlanorh]

That isn't a problem, I just need to change an integer in a list. Would that be decimal feet, inches, mm or metres?

The lisp is complete, but there is a small problem with setting the text style font if the text style doesn't exist. This always causes an error on my system (2010). I have had this problem before but can't remember how I resolved it.  

[dlanorh]

An afterthought, this lisp, like the original, labels any arcs within the polyline.

1. Do you want to retain this capability and if yes what information do you want displayed (currently radius and arc length)

2. Do you foresee any need to label lines, 3dpolylines or arcs?

Font issue is solved and awaiting the insunits and length precision.

[Anonymous]

Hi dlanorh, 

First off, thank you for all of the help, I appreciate it. 

• Decimal Feet would be great for the line distance.

To your second thought...

1.This capability for arcs would be great with the radius, arc length, and possibly the central angle. 

2. I do definitely foresee the need to label arcs. 

[dani-perez]

Hello CADaStroumph,

Thanks for your time!

[dlanorh · Accepted solution]

Attached is updated Lisp. You can select multiple polylines and/or arcs. Any tweaks, let me know.

[Anonymous]

Hello dlanorh, 

Thank you so much for your help! This works great!

[dlanorh]

No problem. Please check that everything reports correctly.

[Anonymous]

Hi dlanorh,

Everything seems to be working correctly except for one distance I have circled below. The line is actually 954.17' not -3439.864. Could you take a look at this?

[dlanorh]

The bearings look wrong as well. Is clockwise switched on in this drawing?

[dlanorh · Accepted solution]

Attach is the updated lisp.

I've accounted for clockwise angles and base direction. These are saved, changed to get the correct label and reset on exit/error.

The distance problem was something I should have accounted for, but I forgot to consider closed polylines. The routine was calculating the segment length from the distance at the end point - the distance at the start point. On closed polylines, on the last segment the end point is the polyline start point and would return a distance of 0.0. I have switched to using distance at parameter instead of distance at point for the end of segment. This seems to have cured the glitch.

[Anonymous]

I can't get the correct bearings.  I'm using Surveyors units, Clockwise is UNchecked, and base angle is S.  I did this to make north oriented vertically in my model.

I use LABEL3.lsp, and when I should have N62d19'6"W,  I get N27d40'54"E instead.

Also, the text is oriented perpendicular to the line I have drawn.

What am I doing wrong?

[dlanorh]

I don't think you are doing anything wrong, although to have North up the page base angle should be set to North. The lisp is supposed to save all relevant system variables, set all relevant system variables, run and reset.

I cannot reproduce your problem on my vanilla system (AutoCAD 2012).  I have tried using the settings you show, and the polyline is always labelled correctly.

Are you using a vertical (Civil or Map) or Bricscad? There is also the possibility that some other (probably a dim sysvar) is interfering with the running. I've accounted for dimzin, but perhaps i've missed something. I will have a dig around.

[mid-awe]

I'm loving this Label3.lsp, it really works well. I only have one question; is it possible to have it take into consideration the "NORTHDIRECTION" system var instead of the base "ANGBASE" var?

I ask because I only work on one plat at a time and we set the project for viewing horizontally in modelspace but I also hope to make use of "Label3.lsp" which is equal effort as I have to put the project in a real world orientation before running Label3, and then reorient everything afterwards.

Thank you in advance for any help.