Ish Posted February 17, 2020 Share Posted February 17, 2020 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 Quote Link to comment Share on other sites More sharing options...
Ish Posted February 17, 2020 Author Share Posted February 17, 2020 hii team Quote Link to comment Share on other sites More sharing options...
BIGAL Posted February 17, 2020 Share Posted February 17, 2020 Start with Chainage.lsp there are a few out there. 1 Quote Link to comment Share on other sites More sharing options...
Ish Posted February 18, 2020 Author Share Posted February 18, 2020 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 Quote Link to comment Share on other sites More sharing options...
dlanorh Posted February 18, 2020 Share Posted February 18, 2020 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 1 Quote Link to comment Share on other sites More sharing options...
Ish Posted February 18, 2020 Author Share Posted February 18, 2020 Thanks Dlanorh rising star. its fulfill my requirements perfectly. Thanks again 1 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.