Leaderboard

Updated code here

Also this as mentioned. (setq ent (entget (car (entsel "\nPick an object for layer name ")))) (setq MyLayerName (cdr (assoc 8 ent))) (setq allPolylines (ssget "_X" (list (0 . "*POLYLINE")(cons 8 MyLayerName))))

The result looks geometrically perfect I also started writing something on Friday with a similar approach. I'll post it when I finish it.

A version also for closed polylines. Minimally tested... centerPline_v2.LSP

@Tamim Try this code and see if it helpful: (prompt "\nTo run a LISP type: LPL") (princ) (defun c:LPL ( / ss len circ txt_height lst i minPt maxPt midPt circle inc ang num ptlist k pt ssn pl_len ins_pt) (prompt "\nSelect all TEXT entities:\n") (setq ss (ssget (list (cons 0 "TEXT"))) len (sslength ss) circ 0.05 ;; radius of the circle can be changeable txt_height 0.01 ;; mtext height can be changeable lst (list) i 0 ) (while (< i len) (vla-GetBoundingBox (vlax-ename->vla-object (ssname ss i)) 'minPt 'maxPt) (setq minPt (vlax-safearray->list minPt) maxPt (vlax-safearray->list maxPt) midPt (mapcar '* (mapcar '+ minPt maxPt) (list 0.5 0.5)) ) (entmake (list (cons 0 "CIRCLE") (cons 100 "AcDbEntity") (cons 100 "AcDbCircle") (cons 8 (getvar 'clayer)) (cons 10 midpt) (cons 40 circ))) (setq circle (entlast) inc 0.25 ang 0 num (fix (/ (* pi 2) inc)) ptlist (list) k 0 ) (repeat num (setq pt (polar midPt ang circ) ptlist (append (list pt) ptlist) ang (+ ang inc) ) ) (setq ssn (ssget "_F" ptlist (list (cons 0 "LWPOLYLINE"))) pl_len (getpropertyvalue (ssname ssn k) "Length") ) (entdel circle) (setq lst (cons (list (cdr (assoc 1 (entget (ssname ss i)))) "\t " (rtos pl_len 2 3) "\\P") lst) i (1+ i) ) ) (setq lst (vl-sort lst (function (lambda (x e) (< (atoi (substr (car x) 3 (strlen (car x)))) (atoi (substr (car e) 3 (strlen (car e)))))))) lst (cons (list "\\fArial|b0|i0|c0|p34;S.No\tLength Ft\\P") lst) ins_pt (getpoint "\nPick the insertation point:") ) (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 8 (getvar 'clayer)) (cons 10 ins_pt) (cons 40 txt_height) (cons 72 1) (cons 1 (apply 'strcat (mapcar '(lambda (x) (apply 'strcat x)) lst))))) (prompt "\nThe labels and the length of the polylines were added as MTEXT!") (princ) ) Also, you can see the short video example of how it works. LengthPolylineMtext.mp4 Best regards.

No, the program is required to define the reactors used to update the textbox position.

I've disabled some lines of your code that weren't working and added some new lines of code. I hope this helps.

Your code, ready. (defun C:bm (/ obj num i obj1 db ct rd ang1 ang2 p1 p2 r ptlist) (setvar "osmode" 0) ; Turn off OSNAP (setq obj (ssget '((0 . "LWPOLYLINE,ARC")))) (setq num (sslength obj)) (setq i 0) (repeat num (setq obj1 (ssname obj i)) (setq db (entget obj1) ptlist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) db)) i 0 ) (if (= (cdr (assoc 0 db)) "ARC") (progn (setq ct (cdr (assoc 10 db))) (setq rd (cdr (assoc 40 db))) (setq ang1 (* (cdr (assoc 50 db)) (/ 180.0 pi)) ang2 (* (cdr (assoc 51 db)) (/ 180.0 pi)) ) (setq p1 (polar ct ang1 rd)) (setq p2 (polar ct ang2 rd)) (command "_.dimradius" "_non" p1 "_non" p2 "") (command "_.dimarc" "_non" p1 "_non" p2 "") ) ;progn ;;; (progn ;polyline arc segment ;;;;;code (foreach l db (if (= (car l) 10) (if p1 (if bulge (progn (command "_.dimradius" "_non" p1 "_non" (cdr l) "") (command "_.dimarc" "_non" p1 "_non" (setq p1 (cdr l)) "") ; ) ) (setq p1 (cdr l)) ) (if (= (car l) 42) (setq bulge (/= (cdr l) 0.0))) ) ;;; (if (/= bulge 0.0) ;;; (progn ;;; (setq p1 (nth i ptlist)) ;;; (setq p2 (nth (+ i 1) ptlist)) ;;; ;;; (command "_.dimradius" "_non" p1 "_non" p2 "") ;;; (command "_.dimarc" "_non" p1 "_non" p2 "") ; ;;; ) ;progn ;;; ) ;if ) ;progn ) (setq i (1+ i)) ) ;repeat end ; Turn off OSNAP (setvar "osmode" 511) (princ) )

It will require more modification than just extending the bulge list - you also need to calculate the positions of the additional vertices. However, I really liked your suggestion (and it's also consistent with my existing Box Text program), and so I've updated the program to Version 1.3 to incorporate a new Filleted Rectangle textbox option (you may need to refresh the page to view the new version). Enjoy!

A start with this ? (vl-load-com) (defun make_mlead (pt o r obj / ptlst arr nw_obj) (setq ptlst (append pt (polar pt o r)) arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1))) ) (vlax-safearray-fill arr ptlst) (setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0)) (vla-put-contenttype nw_obj acMTextContent) (vla-put-textstring nw_obj (strcat "{\\fArial|b0|i0|c0|p34;R=" (rtos r 2 2) "\\P\\C1You can put here other value}")) (vla-put-layer nw_obj (getvar "CLAYER")) (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5)) (vla-put-TextHeight nw_obj (getvar "TEXTSIZE")) (if (> (car ptlst) (cadddr ptlst)) (progn (vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0))) (vla-put-TextJustify nw_obj acAttachmentPointMiddleRight) (vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr)) ) (vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft) ) (vla-update nw_obj) ) (defun c:rad2lead ( / ent dxf_ent typ_ent mkv vector vlaobj prm id_rad AcDoc Space ent pt1 pt2 pt x) (while (not (setq ent (entsel "\nSelect a bulge: ")))) (setq typ_ent (cdr (assoc 0 (setq dxf_ent (entget (car ent)))))) (cond ((or (eq typ_ent "ARC") (eq typ_ent "CIRCLE") (eq typ_ent "LWPOLYLINE") (and (eq typ_ent "POLYLINE") (zerop (boole 1 120 (cdr (assoc 70 dxf_ent)))) ) ) (if (or (> (fix (car (trans (cadr ent) 1 0))) 1E6) (> (fix (cadr (trans (cadr ent) 1 0))) 1E6)) (setq mkv T vector (trans (cadr ent) 0 0 T) vlaobj (vlax-ename->vla-object (car ent))) (setq mkv nil) ) (if mkv (vla-move vlaobj (vlax-3d-point (trans (cadr ent) 1 0)) (vlax-3d-point '(0.0 0.0 0.0)))) (setq id_rad (distance '(0 0) (trans (vlax-curve-getsecondderiv (car ent) (setq prm (vlax-curve-getparamatpoint (car ent) (vlax-curve-getclosestpointto (car ent) (if mkv '(0.0 0.0 0.0) (trans (cadr ent) 1 0))) ) ) ) 0 (car ent) T ) ) ) (if mkv (vla-move vlaobj (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point vector))) (cond ((not (zerop id_rad)) (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) (setq ent (car ent)) (if (member typ_ent '("POLYLINE" "LWPOLYLINE")) (setq pt1 (vlax-curve-getPointAtParam ent (fix prm)) pt2 (vlax-curve-getPointAtParam ent (1+ (fix prm))) pt (vlax-curve-getPointAtParam ent (+ (fix prm) 0.5)) ) (setq pt1 (vlax-curve-getStartPoint ent) pt2 (vlax-curve-getEndPoint ent) pt (vlax-curve-getPointAtDist ent (* 0.5 (- (vlax-curve-getDistAtPoint ent pt2) (vlax-curve-getDistAtPoint ent pt1)))) ) ) (setq x (* (fix (/ (angle (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5 0.5)) pt) (* 0.125 pi))) 0.125 pi) x (+ x (rem x (* 0.25 pi))) ) (make_mlead pt x id_rad (vlax-ename->vla-object ent)) (vla-regen AcDoc acactiveviewport) (vla-endundomark AcDoc) ) (T (princ "\nSegment have no bulge.")) ) ) (T (princ "\nThis object can't be availaible for this function!")) ) (prin1) )

@maahee Please upload you sample,dwg . as to test

Long time I'm nothing written in Lisp. So, I hoppe it will serve you. Also, you can saw a short video how it works. The code: (prompt "\nTo run a LISP type: yval") (princ) (defun c:yval ( / old_osmode pline spt ept spt_pline ept_pline datum_line yval_datum_line yval_start_pline yval_end_pline txt_position ang_spt_pline ang_ept_pline datum_value intersecting_lines len i int_pt_pline int_pt_datum_line dist yval_position ang) (setq old_osmode (getvar 'osmode)) (setq pline (car (entsel "\nSelect Polyline to get an Elevation:"))) (while (or (equal pline nil) (not (equal "LWPOLYLINE" (cdr (assoc 0 (entget pline)))))) (prompt "\nSelected entity must be LWPOLYLINE. Try again...\n") (setq pline (car (entsel "\nSelect Polyline to get an Elevation:"))) ) (setq spt_pline (vlax-curve-getStartPoint pline) ept_pline (vlax-curve-getEndPoint pline) ) (if (> (car spt_pline) (car ept_pline)) (progn (command-s "_reverse" pline "") (setq spt_pline (vlax-curve-getStartPoint pline) ept_pline (vlax-curve-getEndPoint pline) ) ) ) (setq datum_line (car (entsel "\nSelect Datum Line:"))) (while (or (equal datum_line nil) (not (equal "LINE" (cdr (assoc 0 (entget datum_line)))))) (prompt "\nSelected entity must be LINE. Try again...\n") (setq datum_line (car (entsel "\nSelect Datum Line:\n"))) ) (setq yval_datum_line (cadr (vlax-curve-getStartPoint datum_line)) yval_start_pline (- (cadr spt_pline) yval_datum_line) yval_end_pline (- (cadr ept_pline) yval_datum_line) ) (setq txt_position (getpoint "\nPick the lower-left corner of the box for elevation value:\n")) (setvar 'osmode 0) (setq datum_value (car (entsel "\nSelect Datum value:"))) (if (equal "MTEXT" (cdr (assoc 0 (entget datum_value)))) (setq datum_value (LM:UnFormat (cdr (assoc 1 (entget datum_value))) T)) (setq datum_value (cdr (assoc 1 (entget datum_value)))) ) (setq ang_spt_pline (angle (setq yval_position_one (list (car spt_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))) spt_pline) ang_ept_pline (angle (setq yval_position_two (list (car ept_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))) ept_pline) ) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ yval_start_pline (atof datum_value)) 2 3)) (cons 10 yval_position_one) (cons 11 yval_position_one) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_spt_pline))) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ yval_end_pline (atof datum_value)) 2 3)) (cons 10 yval_position_two) (cons 11 yval_position_two) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_ept_pline))) (princ "\nSelect intersecting lines:") (setq intersecting_lines (ssget (list (cons 0 "LINE") (cons 8 "DATUM-GRID"))) len (sslength intersecting_lines) i 0 ) (while (< i len) (setq int_pt_pline (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object pline) (vlax-ename->vla-object (ssname intersecting_lines i)) acExtendNone))) int_pt_datum_line (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object datum_line) (vlax-ename->vla-object (ssname intersecting_lines i)) acExtendNone))) dist (distance int_pt_pline int_pt_datum_line) yval_position (list (car int_pt_pline) (+ (cadr txt_position) 0.1) (caddr txt_position)) ang (angle yval_position int_pt_pline) i (1+ i) ) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ dist (atof datum_value)) 2 3)) (cons 10 yval_position) (cons 11 yval_position) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_spt_pline))) ) (setvar 'osmode old_osmode) (prompt "\nAn elevation values were added!") (princ) ) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun LM:UnFormat ( str mtx / _replace rx ) (vl-load-com) (defun _replace ( new old str ) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda ( ) (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '( ("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) The short video: YVAL.mp4 Best regards.