place labels of length for multiple polylines at middle of full polylines and ask for distance from polylines to place labels.

[kkr028]

hi sir/mam

I have lisp for place labels of length for multiple polylines (vertex to vertex) at once.

but I want "length of full polylines (not vertex to vertex) and after selection of polylines it will ask for distance to place labels from middle of full polylines.

here lisp in text format or download lisp file below.

(defun c:plla (/ _Text s)
(defun _Text (p a d)
(entmakex (list '(0 . "TEXT")
(cons 10 (trans p 1 0))
(cons 11 (trans p 1 0))
(cons 1 (rtos d 2))
(cons 50 a)
'(40 . 2.)
(cons 7 (getvar 'textstyle))
'(71 . 0)
'(72 . 1)
)
)
)
(if (setq s (ssget '((0 . "LINE,LWPOLYLINE"))))
((lambda (i / e sn pt p p1 p2 st nd ang)
(while (setq sn (ssname s (setq i (1+ i))))
(setq e (entget sn))
(if (eq (cdr (assoc 0 e)) "LWPOLYLINE")
(progn (setq pt 0)
(repeat (- (fix (vlax-curve-getendparam sn)) (fix (vlax-curve-getstartparam sn)))
(setq p (mapcar (function (lambda (j k) (/ (+ j k) 2.)))
(setq p1 (vlax-curve-getpointatparam sn pt))
(setq p2 (vlax-curve-getpointatparam sn (setq pt (1+ pt))))
)
)
(_Text p (angle p1 p2) (distance p1 p2))
)
)
(progn (setq ang (angle (setq st (cdr (assoc 10 e))) (setq nd (cdr (assoc 11 e)))))
(_Text (mapcar (function (lambda (j k) (/ (+ j k) 2.))) st nd) ang (distance st nd))
)
)
)
)
-1
)
)
(princ)
)

[marko_ribar]

http://www.lee-mac.com/curvealignedtext.html 

All kudos to author...

M.R.

[devitg]

erased

[calderg1000]

Regards @kkr028 

Try this code, I made some changes to the one you attached

(defun c:pmt (/ s o i sn e d prs pm prp pr1 pr2 ang pmo)
  (if (and (setq s (ssget '((0 . "LINE,LWPOLYLINE"))))
           (setq o (getreal "\nEnter Offset distance: "))
      )
    (progn
      (setq i -1)
      (while
        (setq sn (ssname s (setq i (1+ i)))
              e  (entget sn)
        )
         (setq sn  (vlax-ename->vla-object sn)
               d   (vlax-get sn 'length)
               prs (vlax-curve-getstartparam sn)
               pm  (vlax-curve-getpointatdist sn (/ d 2))
               prp (vlax-curve-getparamatpoint sn pm)
               pr1 (fix prp)
               pr2 (1+ pr1)
               ang (angle (vlax-curve-getpointatparam sn pr1)
                          (vlax-curve-getpointatparam sn pr2)
                   )
               pmo (polar pm (+ ang (/ pi 2)) o)
         )
         (_Text pmo ang d)
      )
    )
  )
  (princ)
)

(defun _Text (p a d)
  (entmakex (list '(0 . "TEXT")
                  (cons 10 (trans p 1 0))
                  (cons 11 (trans p 1 0))
                  (cons 1 (rtos d 2))             
                  (cons 50 a)                     
                  '(40 . 2.)                      
                  (cons 7 (getvar 'textstyle))
                  '(71 . 0)
                  '(72 . 1)
            )
  )
)

[kkr028]

awesome sir.

small request.

will you please add for "line and arc" attribute also.

[calderg1000]

Dear @kkr028 , sorry I did not realize that it also required for lines. I made a quick modification to the above code, so that it accepts Lines. For mixed polylines (lines + arcs) you only need to set the angle of the text. For arcs it is also possible but I have to code a bit more. With some time I will gladly give you an answer. I am now trying to answer another of your interesting queries.

[calderg1000 · Accepted solution]

Regards @kkr028 

Try this modified code for Line, Polyline and Spline.

(defun c:pmt (/ s o i sn e d prs pre pm prp pr1 pr2 ang pmo)
  (if (and (setq s (ssget '((0 . "LINE,LWPOLYLINE,ARC,SPLINE"))))
           (setq o (getreal "\nEnter Offset distance: "))
      )
    (progn
      (setq i -1)
      (while
        (setq sn (ssname s (setq i (1+ i)))
              e  (entget sn)
        )
         (setq sn  (vlax-ename->vla-object sn)
               prs (vlax-curve-getstartparam sn)
               pre (vlax-curve-getendparam sn)
               d   (vlax-curve-getdistatparam sn pre)
               pm  (vlax-curve-getpointatdist sn (/ d 2))
               prp (vlax-curve-getparamatpoint sn pm)
               pr1 (fix prp)
               pr2 (1+ pr1)
               ang (angle '(0. 0. 0.)
                          (vlax-curve-getfirstderiv sn prp)
                   )
               pmo (polar pm (+ ang (/ pi 2)) o)
         )
         (_Text pmo ang d)
      )
    )
  )
  (princ)
)


(defun _Text (p a d)
  (entmakex (list '(0 . "TEXT")
                  (cons 10 (trans p 1 0))
                  (cons 11 (trans p 1 0))
                  (cons 1 (rtos d 2))
                  (cons 50 a)
                  '(40 . 2.)
                  (cons 7 (getvar 'textstyle))
                  '(71 . 0)
                  '(72 . 1)
            )
  )
)

[kkr028]

it is working awesome.

Thank you so much Sir @calderg1000