Please help me about Grading Lisp!

[Anonymous]

Hi everyone, now i have a lisp can be calculating and insert text grade value for polyline. But it can select a single polyline. Now i want to select mutiple polyline (or mutiple line if possible), so somebody can help me to edit this lisp

(defun c:gd (/ entpl p1 text_height sp ep ang grade)
(vl-load-com)
(setq entpl (entsel "\n Select Polyline")
      entob (vlax-ename->vla-object (car entpl))
)
(setq x (getreal "\n Scale X: ")
      y (getreal "\n Scale Y: "))
(setq text_height (getreal "\n Text Height: ")
      h (getreal "\n Distanse from Text to Polyline: ")
      i 0
      p1 (cadr entpl)
      ent (car entpl)
      m (vlax-curve-getendparam ent))
(while (< i m)
(setq sp (vlax-curve-getPointatparam ent i)
      ep (vlax-curve-getPointatparam ent (1+ i))
      ang (angle sp ep)
      x1 (car sp)
      y1 (cadr sp)
      x2 (car ep)
      y2 (cadr ep)
      grade (* (abs (/ (/ (- y2 y1) y) (/ (- x2 x1) x))) )
      grade (strcat (rtos grade) ))
(if (< (car sp) (car ep))
    (progn
    (setq pt (vlax-curve-getpointatparam ent (+ i 0.1)))
    (command "_.text" (list (- (car pt) (* h (sin ang))) (+ (cadr pt) (* h (cos ang)))) text_height (/ (* ang 180) pi)(strcat grade))
    )
    (if (> (car sp) (car ep))
    (progn
    (setq pt (vlax-curve-getpointatparam ent (+ i 0.9)))
    (command "_.text" (list (+ (car pt) (* h (sin ang))) (+ (cadr pt) (* h (cos ang)))) text_height (+ 180 (/ (* ang 180) pi)) (strcat grade))
    )
    (progn
    (setq pt (vlax-curve-getpointatparam ent (+ i 0.5)))
    (command "_.text" (list (+ (car pt) h) (cadr pt)) text_height 90 (strcat grade))
    )
    )
)
(setq i (1+ i))
)
)

Thank everyone for reading and please help me!

[Ajilal.Vijayan · Accepted solution]

Hi,

Welcome to Autodesk Community !!

Try with this.

Click the +sign to see the Code

Spoiler

 

(defun c:gd (/ entpl p1 text_height sp ep ang grade slctn cnt)
(vl-load-com)
(setq cnt 0)
(setq slctn (ssget '((0 . "LWPOLYLINE"))))
(if slctn
(progn
(setq x (getreal "\n Scale X: ")
      y (getreal "\n Scale Y: "))
(setq text_height (getreal "\n Text Height: ")
      h (getreal "\n Distanse from Text to Polyline: ")
      i 0)

(repeat (sslength slctn)
	(setq ent (ssname slctn cnt)
	m (vlax-curve-getendparam ent))
	(while (< i m)
(setq sp (vlax-curve-getPointatparam ent i)
      ep (vlax-curve-getPointatparam ent (1+ i))
      ang (angle sp ep)
      x1 (car sp)
      y1 (cadr sp)
      x2 (car ep)
      y2 (cadr ep)
      grade (* (abs (/ (/ (- y2 y1) y) (/ (- x2 x1) x))) )
      grade (strcat (rtos grade) ))
(if (< (car sp) (car ep))
    (progn
    (setq pt (vlax-curve-getpointatparam ent (+ i 0.1)))
    (command "_.text" (list (- (car pt) (* h (sin ang))) (+ (cadr pt) (* h (cos ang)))) text_height (/ (* ang 180) pi)(strcat grade))
    )
    (if (> (car sp) (car ep))
    (progn
    (setq pt (vlax-curve-getpointatparam ent (+ i 0.9)))
    (command "_.text" (list (+ (car pt) (* h (sin ang))) (+ (cadr pt) (* h (cos ang)))) text_height (+ 180 (/ (* ang 180) pi)) (strcat grade))
    )
    (progn
    (setq pt (vlax-curve-getpointatparam ent (+ i 0.5)))
    (command "_.text" (list (+ (car pt) h) (cadr pt)) text_height 90 (strcat grade))
    )
    )
)
(setq i (1+ i))
);whle
(setq i 0)
(setq cnt ( + cnt 1))	
);repeat
);progn
);if
);defun

[Anonymous]

Thank you, it's exactly what i need. Thank you very much

[Ajilal.Vijayan]

You're welcome @Anonymous, Glad I could help.