This will label them all - you can remove the ones you don't want:
Code:(defun c:LabelSegs ( / *error* spc doc ent flg ) (vl-load-com) ;; Lee Mac ~ 18.05.10 (defun *error* ( msg ) (and flg (vla-EndUndomark doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (setq spc (if (or (eq AcModelSpace (vla-get-ActiveSpace (setq doc (vla-get-ActiveDocument (vlax-get-acad-object) ) ) ) ) (eq :vlax-true (vla-get-MSpace doc)) ) (vla-get-ModelSpace doc) (vla-get-PaperSpace doc) ) ) (if (setq ent (CurveifFoo (lambda ( x ) (eq "LWPOLYLINE" (cdr (assoc 0 (entget x))) ) ) "\nSelect LWPolyline to Label: " ) ) ( (lambda ( n / der ) (setq flg (not (vla-StartUndoMark doc))) (repeat (fix (vlax-curve-getEndParam ent)) (vla-put-rotation (AddText spc (rtos (- (vlax-curve-getDistatParam ent (setq n (1+ n))) (vlax-curve-getDistatParam ent (1- n)) ) ) (polar (vlax-curve-getPointatParam ent (- n 0.5)) (+ (setq der (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv ent (- n 0.5)) ) ) (/ pi 2.) ) (/ (getvar 'TEXTSIZE) 2.) ) (getvar 'TEXTSIZE) ) (MakeReadable der) ) ) (setq flg (vla-EndUndomark doc)) ) (vlax-curve-getStartParam ent) ) ) (princ) ) (defun MakeReadable ( a ) (cond ( (and (> a (/ pi 2)) (<= a pi)) (- a pi) ) ( (and (> a pi) (<= a (/ (* 3 pi) 2))) (+ a pi) ) ( a ) ) ) (defun AddText ( block str point height / o ) (vla-put-Alignment (setq o (vla-AddText block str (vlax-3D-point point) height ) ) acAlignmentMiddleCenter ) (vla-put-TextAlignmentPoint o (vlax-3D-point point)) o ) (defun CurveifFoo ( foo str / sel ent ) (while (progn (setq sel (entsel str)) (cond ( (vl-consp sel) (if (not (foo (setq ent (car sel)))) (princ "\n** Invalid Object Selected **") ) ) ) ) ) ent )



Reply With Quote

Bookmarks