Lisp for measure dist. between 2 Line (Tunnel work)

[tawan_survey]

I got the Lisp from this Topic https://www.cadtutor.net/forum/topic/44246-measure-distance-between-polylines/page/2/ by Lee Mac but I want to use Lisp for tunnel work. The text must seperate by setting tolerance (Can set the tolerance for Overbreak and Underbreak) In tolerance (Green Text) ,Overbreak (Blue text) and Underbreak (Red text)

Ps.1 Thank you for your help
Ps.2 My English skill is bad

[Sea-Haven]

You should post a dwg it should just be  a getclosestpointto function. 

[tawan_survey]

Lisp By Lee Mac

[devitg]

@tawan_survey It is not a DWG , it is a Img 

[devitg]

@tawan_survey please upload the sample.dwg

[tawan_survey]

dwg sir this is Civil3D format

[tawan_survey]

(defun c:test ( / a1 d1 d2 d3 e1 e2 p1 p2 sp xl zv )
   (if
       (and
           (setq e1 (LM:ssget "\nSelect 1st Polyline: " '("_+.:E:S" ((0 . "LWPOLYLINE")))))
           (setq e2 (LM:ssget "\nSelect 2nd Polyline: " '("_+.:E:S" ((0 . "LWPOLYLINE")))))
           (progn
               (initget 6)
               (setq d1 (getdist  "\nSpecify Step Distance: "))
           )
       )
       (progn
           (setq d3 (- d1)
                 e1 (ssname e1 0)
                 e2 (vlax-ename->vla-object (ssname e2 0))
                 d2 (vlax-curve-getdistatparam e1 (vlax-curve-getendparam e1))
                 zv (trans '(0.0 0.0 1.0) 1 0 t)
                 sp (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
                        (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)
                    )
           )
           (while (<= (setq d3 (+ d3 d1)) d2)
               (setq p1 (vlax-curve-getpointatdist e1 d3)
                     a1 (- (angle '(0.0 0.0) (trans (vlax-curve-getfirstderiv e1 (vlax-curve-getparamatpoint e1 p1)) 0 1)) (/ pi 2.0))
                     xl (vlax-invoke sp 'addxline p1 (trans (polar (trans p1 0 1) a1 1.0) 1 0))
               )
               (if
                   (setq p2
                       (car
                           (vl-sort (LM:group3 (vlax-invoke xl 'intersectwith e2 acextendthisentity))
                              '(lambda ( a b ) (< (distance a p1) (distance b p1)))
                           )
                       )
                   )
                   (progn
                       (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
                       (entmake
                           (list
                              '(0 . "TEXT")
                               (cons 10 (trans p1 0 zv))
                               (cons 11 (trans p1 0 zv))
                               (cons 50 (- a1 (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 zv t))))
                               (cons 40 (getvar 'textsize))
                               (cons 07 (getvar 'textstyle))
                               (cons 01 (strcat "L=" (rtos (distance p1 p2) 2) "m"))
                              '(72 . 0)
                              '(73 . 2)
                               (cons 210 zv)
                           )
                       )
                   )                                
               )
               (vla-delete xl)
           )
       )
   )
   (princ)
)

(defun LM:group3 ( lst / rtn )
   (repeat (/ (length lst) 3)
       (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
             lst (cdddr lst)
       )
   )
   (reverse rtn)
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt

(defun LM:ssget ( msg params / sel )
   (princ msg)
   (setvar 'nomutt 1)
   (setq sel (vl-catch-all-apply 'ssget params))
   (setvar 'nomutt 0)
   (if (not (vl-catch-all-error-p sel)) sel)
)
(vl-load-com) (princ)