place text along polyline at specified intervals and text readable

[pyou]

Hi

 

Could someone help me to tweak this lisp code so text appear outside the polyline and become readable, please?

 

Thank you!

 

(defun c:TextPline (/ obj vert lay du interval total-length current-dist txt pt ang)
  (setq du (getstring t "Text above the line: ")
        interval (getdist "Specify the interval between text placements: "))

  ;; Select polyline and get its layer
  (setq obj (car (entsel "\nSelect polyline to lock active layer >")))
  (setq lay (cdr (assoc 8 (entget obj))))

  ;; Ensure the selected object is a polyline
  (if (and obj (= (cdr (assoc 0 (entget obj))) "LWPOLYLINE"))
    (progn
      ;; Get total length of the polyline
      (setq total-length (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
            current-dist 0)

      ;; Set the text to display
      (setq txt du)

      ;; Place text at specified intervals
      (while (< current-dist total-length)
        (setq pt (vlax-curve-getPointAtDist obj current-dist)
              ang (angle (vlax-curve-getPointAtDist obj current-dist)
                         (vlax-curve-getPointAtDist obj (+ current-dist 1))))
        ;; Adjust angle if necessary
        (if (or (> ang (* pi 1.5)) (< ang (* pi 0.5)))
          (setq ang (+ ang pi)))

        ;; Calculate the point above the polyline for text placement
        (setq pt (polar pt (+ ang (/ pi 2)) 0.4))

        (entmakex
          (list
            (cons 0 "MTEXT")
            (cons 100 "AcDbEntity")
            (cons 100 "AcDbMText")
            (cons 1 txt)
            (cons 7 "Arial")
            (cons 8 lay)
            (cons 10 pt)
            (cons 40 0.4)
            (cons 50 ang)
            (cons 62 256)
            (cons 71 5)
            (cons 72 5)
            (cons 44 1.3)))

        ;; Increment the distance
        (setq current-dist (+ current-dist interval)))))
  (princ))

 

[BIGAL]

What your missing maybe, "is pline CW or CCW, can reverse pline then text will always go out.

 

(defun Chkcwccw (ent / obj obj2 area1 area2)
(setq ent (entsel "\nPick closed pline "))
(setq obj (vlax-ename->vla-object ent))
(setq area1  (vlax-get obj 'Area))
(vla-offset obj 10)
(setq obj2 (vlax-ename->vla-object (entlast)))
(setq area2 (vlax-get obj2 'Area))
(vla-delete obj2)
(if (> area1 area2)
  (command "reverse" ent "")
  ; (command "pedit" ent "R" "") ; Bricscad has no reverse
)

(setq ent (entsel "\nPick closed pline "))
(Chkcwccw ent)

 

Thanks to Lee-mac for readable.

  ;; Make Readable  -  Lee Mac
  ;; Returns a given angle corrected for text readability
  (defun lm:makereadable (a)
    ((lambda (a)
       (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
	 (+ a pi)
	 a
       )
     )
      (rem (+ a pi pi) (+ pi pi))
    )
  )