PLINE Segment Length Labels

[cherrygate]

I'm looking for a simple LSP to label all segment lengths of a PLINE I select  similar to my screenshot below with labels in the middle of the PLINE segment and slightly above the line itself. 

Thank you!

[CADaSchtroumpf]

My propostion

(vl-load-com)
(defun c:label_dist-vertex_po ( / js htx AcDoc Space nw_style n obj ename pr dist_start dist_end pt_start pt_end seg_len alpha nw_obj)
  (princ "\nSelect polylines.")
  (while
    (null
      (setq js
        (ssget
          '(
            (0 . "*POLYLINE")
            (-4 . "<NOT")
              (-4 . "&") (70 . 112)
            (-4 . "NOT>")
          )
        )
      )
    )
    (princ "\nSelect is empty, or isn't POLYLINE!")
  )
  (initget 6)
  (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpecify height text <" (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)
    )
  )
  (cond
    ((null (tblsearch "LAYER" "Label"))
      (vlax-put (vla-add (vla-get-layers AcDoc) "Label") 'color 96)
    )
  )
  (cond
    ((null (tblsearch "STYLE" "Romand-Label"))
      (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Label"))
      (mapcar
        '(lambda (pr val)
          (vlax-put nw_style pr val)
        )
        (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
        (list "romand.shx" 0.0 (/ (* 15.0 pi) 180) 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))
      )
      (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
          (rtos seg_len 2 2)
        )
      )
      (mapcar
        '(lambda (pr val)
          (vlax-put nw_obj pr val)
        )
        (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
        (list 8 (getvar "TEXTSIZE") 5 pt "Romand-Label" "Label" alpha)
      )
    )
  )
  (prin1)
)

[cherrygate]

Thank you so much for the fast response, this is almost perfect! Would you know a way to make it so the text is always rightside up? I tired it on this pline and some stuff was upside down

Also, if it could round up to the next whole number that would be great.

Thank you!

[CADaSchtroumpf · Accepted solution]

With minor modifications

(vl-load-com)
(defun c:label_dist-vertex_po ( / js htx AcDoc Space nw_style n obj ename pr dist_start dist_end pt_start pt_end seg_len alpha nw_obj)
  (princ "\nSelect polylines.")
  (while
    (null
      (setq js
        (ssget
          '(
            (0 . "*POLYLINE")
            (-4 . "<NOT")
              (-4 . "&") (70 . 112)
            (-4 . "NOT>")
          )
        )
      )
    )
    (princ "\nSelect is empty, or isn't POLYLINE!")
  )
  (initget 6)
  (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpecify height text <" (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)
    )
  )
  (cond
    ((null (tblsearch "LAYER" "Label"))
      (vlax-put (vla-add (vla-get-layers AcDoc) "Label") 'color 96)
    )
  )
  (cond
    ((null (tblsearch "STYLE" "Romand-Label"))
      (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Label"))
      (mapcar
        '(lambda (pr val)
          (vlax-put nw_style pr val)
        )
        (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
        (list "romand.shx" 0.0 (/ (* 15.0 pi) 180) 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))
      )
      (if (and (> alpha (* pi 0.5)) (< alpha (* pi 1.5))) (setq alpha (+ alpha pi)))
      (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
          (rtos seg_len (getvar "LUNITS") 0)
        )
      )
      (mapcar
        '(lambda (pr val)
          (vlax-put nw_obj pr val)
        )
        (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
        (list 8 (getvar "TEXTSIZE") 5 pt "Romand-Label" "Label" alpha)
      )
    )
  )
  (prin1)
)

[john.uhden]

Legibility requires just a little extra code.

Do you use Dview;Twist?

Is any of your polyline segments bulged (arced)?

Do you need to add not only distances, but also bearings and curve data?

[Sea-Haven]

Like John if you want more properties look at Lee-mac.com polyinfo.

[cherrygate]

That is perfect thank you so much for your help.

One last thing, is there anyway to append a single apostrophe(') to the end of the length it outputs? 

[john.uhden]

Alan,
I was going to suggest my LABEL_IT program, but I really don't want to give
it away just yet, and we can't do any solicitation here.
I just can't stomach the limitations of using C3D labeling, so at work I
use my own. The bosses don't care and don't want to know anything about
CAD, so I just get my work done.
The only improvement I have to make is creating real tables, not just an
anonymous block of lines and text. But thanks mainly to @Anonymous_ding I am
learning to master tables.

[CADaSchtroumpf]

---

@cherrygate  a écrit :

That is perfect thank you so much for your help.

One last thing, is there anyway to append a single apostrophe(') to the end of the length it outputs? 

---

Simply change the line (towards the end of the code):

(rtos seg_len (getvar "LUNITS") 0) to (strcat (rtos seg_len (getvar "LUNITS") 0) "'")

[Kent1Cooper]

I suggest DimPoly.lsp with its DPI and DPO [the one that will do it as in your image] commands, >>here<<.  See instructions on how to get the look you want, and some of its advantages, described >here<.

[cherrygate]

That feature of changing the distance as the PLINE moves seems very nice however it also seems to do some odd things? It places a new PLINE along the middle of my current one? Is there anyway to stop this behavior while retaining the ability to move the PLINE and have the length update?

[Kent1Cooper]

Is it really another Polyline?  Or is it a dimension line?  The comments at one of the links explain that for the look you're after, you need to make current a Dimension Style with both dimension lines and both extension lines suppressed.  [It should also have the text vertically centered on, and its rotation aligned with, the suppressed dimension lines.]

If it really is another Polyline, the routine Offsets a temporary one to compare to, for deciding which is the inside and which the outside of the original.  It removes it, but if that isn't happening, could it be that you used it on a Polyline of a convoluted-enough shape that Offsetting has more than one Polyline result?  [It removes only the (single) last object after it has made the comparison.]  It could also be thrown off if the dimension text height is large compared to the size of the Polyline, because the Offset that makes the temporary-comparison Polyline uses the text height for the Offset distance.

Also, it's not clear to me what "along the middle of my current one" means.  Can you post a small sample drawing?

[Anonymous]

Could an error capturing feature where segments under, lets say a length of 8, are ignored from the labeling process?

[john.uhden]

It would't be an error.
The programmer need only test if a segment were < 8 units and not label if
true.
In fact the programmer could ask for the minimum length to label.

[peter_pan_y_vino]

This lisp routine inserts a zero at the start point of the polyline. Can you modify it so that it does not?. Thanks.

[Kent1Cooper]

I would bet that you have two vertices at the same place at that location ["coincident" vertices], for a zero-length segment.  You can tell by selecting the Polyline, and in Properties, picking in the "Current vertex" slot.  Pick on the little up arrow, and if the current vertex number increases to 2 but the X marker on the Polyline doesn't move, that's the cause.

To fix it, you can't just select the Polyline and use the Remove vertex option at the grip, because it won't offer that where there are coincident vertices.  Do this if that's at the starting end of the Polyline:

Command: PEDIT

Select polyline or [Multiple]: {pick the Polyline}
Enter an option [Close/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype gen/Reverse/Undo]: E

Enter a vertex editing option
[Next/Previous/Break/Insert/Move/Regen/Straighten/Tangent/Width/eXit] <N>: B

Enter an option [Next/Previous/Go/eXit] <N>: {Enter to go to 2nd vertex at same location}

Enter an option [Next/Previous/Go/eXit] <N>: G

Enter a vertex editing option
[Next/Previous/Break/Insert/Move/Regen/Straighten/Tangent/Width/eXit] <N>: X

Enter an option [Close/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype gen/Reverse/Undo]: {Enter to complete PEDIT command}

If it's at the downstream end, the procedure is similar with a series of Next moves until you arrive at the end -- you'll figure it out.

[Anonymous]

(cond
((> htx (*8)) (setq htx (* 8)))
)

[hiraram_prajapati]

Dear Sir,

this lisp is working fine but , I want to insert Angle @ each vertex location, shown in Attached image in RED color. i want angle in DD.MM.SS format through polyline.

snap is attached.

Please help