REQ: Place points and cumulative distance (text) on polyline, every X distance

[enthralled]

Hi,

 

I'm looking for a lisp/command that would place points and cumulative distance (text) on polyline, every X distance:

 

 

Thanks

Edited March 7, 2012 by enthralled

[VVA]

Try It

(defun C:TEST ( / pline dist n pt )
 (vl-load-com)
 (and
   (setq pline (ssget "_:S:E" '((0 . "*POLYLINE"))))
   (setq pline (ssname pline 0))
   (setq dist (getdist "\nEnter distance: "))
   (setq n 0)
   (while 
     (setq pt (vlax-curve-getPointAtDist pline (setq txt (* (setq n (1+ n)) dist))))
     (point pt)
     (text-entmake
       (rtos
         txt
         2  ;;_decimal
         2  ;;_precision
         )
       (mapcar '+ pt
               '(0.5 -0.5) ;_ dX dY Text
               )
       1 ;_heigth
       0 ;_rotation
       nil;_justification
       )
     )
   )
 (princ)
 )
    

  (defun Point (pt)
    (entmakex
      (list (cons 0 "POINT")
            (cons 10 pt)
            )
      )
    )
     (defun text-entmake (txt pnt height rotation justification / ent_list)
 ;;; borrowed from ShaggyDoc
 ;;; http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=23&TID=30276
 ;;; Draw text with entmake Lisp function
 ;;; Arguments:
 ;;; txt - text string
 ;;; pnt - point in WCS
 ;;; height - text height
 ;;; rotation - rotation angle
 ;;; justification - justification ("C" "R" "M" "A" "F") or nil

 (setq  ent_list (list  '(0 . "TEXT")
    '(100 . "AcDbEntity")
    '(100 . "AcDbText")
    (list 10 (car pnt) (cadr pnt) 0.0)
    (cons 1 txt)
    (cons 8 (getvar "CLAYER"))                         
    (cons 40 height)
    (cons 7 (getvar "TEXTSTYLE"))
    (if justification
      (cond
        ((= justification "C")
         '(72 . 1)
        )
        ((= justification "R")
         '(72 . 2)
        )
        ((= justification "A")
         '(72 . 3)
        )
        ((= justification "M")
         '(72 . 4)
        )
        ((= justification "F")
         '(72 . 5)
        )
        (t
         '(72 . 0)
        )
      ) ;_ end of cond
      '(72 . 0)
    ) ;_ end of if
    (cons 50 rotation)
    (cons 51 (cdr(assoc 50 (entget(TBLOBJNAME "Style" (getvar "textstyle"))))))
    (list 11 (car pnt) (cadr pnt) 0.0)
    ) ;_ end of list
  ) ;_ end of setq
  (setq ent_list (entmakex ent_list))
)

[enthralled]

Try It

(defun C:TEST ( / pline dist n pt )
 (vl-load-com)
 (and
   (setq pline (ssget "_:S:E" '((0 . "*POLYLINE"))))
   (setq pline (ssname pline 0))
   (setq dist (getdist "\nEnter distance: "))
   (setq n 0)
   (while 
     (setq pt (vlax-curve-getPointAtDist pline (setq txt (* (setq n (1+ n)) dist))))
     (point pt)
     (text-entmake
       (rtos
         txt
         2  ;;_decimal
         2  ;;_precision
         )
       (mapcar '+ pt
               '(0.5 -0.5) ;_ dX dY Text
               )
       1 ;_heigth
       0 ;_rotation
       nil;_justification
       )
     )
   )
 (princ)
 )
    

  (defun Point (pt)
    (entmakex
      (list (cons 0 "POINT")
            (cons 10 pt)
            )
      )
    )
     (defun text-entmake (txt pnt height rotation justification / ent_list)
 ;;; borrowed from ShaggyDoc
 ;;; http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=23&TID=30276
 ;;; Draw text with entmake Lisp function
 ;;; Arguments:
 ;;; txt - text string
 ;;; pnt - point in WCS
 ;;; height - text height
 ;;; rotation - rotation angle
 ;;; justification - justification ("C" "R" "M" "A" "F") or nil

 (setq  ent_list (list  '(0 . "TEXT")
    '(100 . "AcDbEntity")
    '(100 . "AcDbText")
    (list 10 (car pnt) (cadr pnt) 0.0)
    (cons 1 txt)
    (cons 8 (getvar "CLAYER"))                         
    (cons 40 height)
    (cons 7 (getvar "TEXTSTYLE"))
    (if justification
      (cond
        ((= justification "C")
         '(72 . 1)
        )
        ((= justification "R")
         '(72 . 2)
        )
        ((= justification "A")
         '(72 . 3)
        )
        ((= justification "M")
         '(72 . 4)
        )
        ((= justification "F")
         '(72 . 5)
        )
        (t
         '(72 . 0)
        )
      ) ;_ end of cond
      '(72 . 0)
    ) ;_ end of if
    (cons 50 rotation)
    (cons 51 (cdr(assoc 50 (entget(TBLOBJNAME "Style" (getvar "textstyle"))))))
    (list 11 (car pnt) (cadr pnt) 0.0)
    ) ;_ end of list
  ) ;_ end of setq
  (setq ent_list (entmakex ent_list))
)

 

Works great!

Many Thanks