Ch Marking on polyline & 3d polyline vertex

[Ish]

Dear team,

 

I need a lisp program to write text (chainage marking) at every vertex of polyline & 3d polyline.

for more details see attach image and cad file.

 

thanks

 

Ch marking on polyline & 3d polyline vertex.dwg

[Ish]

hii team

[BIGAL]

Start with Chainage.lsp there are a few out there.

[Ish]

6 hours ago, BIGAL said:

Start with Chainage.lsp there are a few out there.

SIR, 

I try chainage.lsp and chainage on PL.lsp, these are marking chainage at fix interval.

But I need chainage at every vertex of pline and 3d polyline. As i attached image and cad file above.

thanks

[dlanorh]

3 hours ago, Ish said:

SIR, 

I try chainage.lsp and chainage on PL.lsp, these are marking chainage at fix interval.

But I need chainage at every vertex of pline and 3d polyline. As i attached image and cad file above.

thanks

 

Try this. Not Ideal but works.

 

(defun rh:sammlung_n (o_lst grp / tmp n_lst)
  (cond ( (and o_lst (zerop (rem (length o_lst) (float grp))))
          (while o_lst
            (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst)))
            (setq n_lst (cons (reverse tmp) n_lst) tmp nil)
          );end_while
        )
        ( (not (zerop (rem (length o_lst) (float grp)))) (princ "\nModulus Error : The passed list length is not exactly divisible by the group size!!"))
  );end_cond
  (if n_lst (reverse n_lst) nil)
);end_defun rh:sammlung_n

(defun rh:2chge (dist acc / frp pfx str)
  (setq frp (rem dist 1000)
        pfx (fix (/ dist 1000))
  )
  (cond ( (= pfx 0) (setq pfx "00+"))
        ( (< 0 pfx 10) (setq pfx (strcat "0" (itoa pfx) "+")))
        (t  (setq pfx (strcat (itoa pfx) "+")))
  )
  (cond ( (= 0.0 frp) (setq frp "000"))
        ( (< 0.0 frp 10.0) (setq frp (strcat "00" (rtos frp 2 acc))))
        ( (< 10.0 frp 100.0) (setq frp (strcat "0" (rtos frp 2 acc))))
        (t  (setq frp (rtos frp 2 acc)))
  )
  (setq str (strcat "CH: " pfx frp "    "));; adjust last blank text to shift text position left or right 
);end_defun

(defun rh:223 (lst z / a) (setq a (reverse (cons z (reverse lst)))))

(defun rh:line (spt ept) (entmakex (list '(0 . "LINE") (cons 10 spt) (cons 11 ept) (cons 8 "tick"))))

(defun rh:text (ipt ht str ang) (entmakex (list '(0 . "TEXT") (cons 10  ipt) (cons 40 ht) (cons 8 "ch text") 
                                                (cons 1  str) (cons 50 ang) (cons 11 ipt) '(72 . 2) '(73 . 2)
                                          )
                                )
)

(defun c:pvch ( / ss cnt ent typ v_lst dst txt ang tent tang tpt)
  (prompt "\nSelect Polylines")
  (setq ss (ssget '((0 . "*POLYLINE"))))
  
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq ent (ssname ss (setq cnt (1- cnt)))
                  typ (cdr (assoc 70 (entget ent)))
            );end_setq

            (if (>= typ 128) (setq typ (- typ 128)))
            (cond ( (> typ 4) (setq v_lst (rh:sammlung_n (vlax-get (vlax-ename->vla-object ent) 'coordinates) 3)))
                  (t (setq v_lst (rh:sammlung_n (vlax-get (vlax-ename->vla-object ent) 'coordinates) 2)))
            );end_cond

            (foreach pt v_lst
              (setq dst (vlax-curve-getdistatpoint ent pt)
                    txt (rh:2chge dst 3)
                    ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent pt)))
              );end_setq
              (rh:line (polar pt (+ ang (* pi 0.5)) 0.1) (polar pt (- ang (* pi 0.5)) 0.1))

              (if (< (setq tang (- ang (* pi 0.5))) 0.0) (setq tang (+ tang pi)))
              (setq tent (rh:text pt (getvar 'textsize) txt tang))
              (if (= (length pt) 2) (setq pt (rh:223 pt 0.0)))
              (if (< (* pi 0.5) tang (* pi 1.5)) (vlax-invoke (vlax-ename->vla-object tent) 'rotate pt pi))
            );end_repeat
          );end_repeat
        )
  );end_cond
  (princ)
);end_defun

 

[Ish]

Thanks Dlanorh rising star.

 

its fulfill my requirements perfectly.

 

Thanks again