Jump to content

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


enthralled

Recommended Posts

Hi,

 

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

 

33zd15y.jpg

 

Thanks

Edited by enthralled
Link to comment
Share on other sites

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))
)

Link to comment
Share on other sites

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 :)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...