Determine Distance Between Points On An Entity

[utkub]

Hi everyone,

 

Attached lisp is writen by Alan Thompson and then modifed by another developer.

 

This lisp calculates the distance between two points along an object (line, circle, arc, polyline, spline, etc.) and writes the distance on second point.

 

But it takes too much time while using this lisp for 2 or more times on same object. Because you have to restart the procedure for each point pair.

 

Can this lisp upgradeable like this;

first, we will choose a start point on an object,

then lisp will write the distance which is between start point and n'th point, on n'th point.

 

So we will choose start point only once and then lisp will write the distance on all next points which we click on the object.

 

Thanks for help,

 

DistanceBetweenPoints2.rar

[hanhphuc]

But it takes too much time while using this lisp for 2 or more times on same object. Because you have to restart the procedure for each point pair.

 

prefer WHILE function

[color="red"][b]([/b][/color][color="blue"]while[/color]
          (AT:DrawX (setq p2 (getpoint p1 "\nSpecify next point on curve: ")) 3)
...
...
[color="red"][b])[/b][/color]
(princ)

[utkub]

Dear hanhphuc, thanks for your help.

 

I have modified code but it didn't work. I think I modified it wrong.

I have attached the modified code.

 

DistanceBetweenPoints3.rar

[hanhphuc]

Dear hanhphuc, thanks for your help.

 

I have modified code but it didn't work. I think I modified it wrong.

I have attached the modified code.

 

[ATTACH]61976[/ATTACH]

 

no worries failed, still good job at least you made your 1st step to try:)

 

you can paste the code in code tag

[/color]  [color="darkgreen"]code here[/color][color="red"] [/ CODE][/color]  (slash without space )


[code]

(defun c:DBP3 (/ AT:DrawX AT:CycleThroughSS p1 ent p2 d1 d2 dlst)
 ;; Calculate distance between 2 specified points on curve object
 ;; Alan J. Thompson, 03.20.10 / 03.28.10 / 03.07.11 / 05.09.11

 (vl-load-com)

 (defun AT:DrawX (P C)
   ;; Draw and "X" vector at specified point
   ;; P - Placement point for "X"
   ;; C - Color of "X" (must be integer b/w 1 & 255)
   ;; Alan J. Thompson, 10.31.09
   (if (vl-consp P)
     ((lambda (d)
        (grvecs (cons C
                      (mapcar (function (lambda (n) (polar P (* n pi) d)))
                              '(0.25 1.25 0.75 1.75)
                      )
                )
        )
        P
      )
       (* (getvar 'viewsize) 0.02)
     )
   )
 )

 (defun AT:CycleThroughSS (ss / l i e)
   ;; Cycle through a selection set to choose one
   ;; ss - selection set
   ;; Alan J. Thompson, 03.30.11
   (if (eq (type ss) 'PICKSET)
     (if (eq (setq l (sslength ss)) 1)
       (ssname ss 0)
       (progn (princ "\n<Tab> to cycle through entities: ")
              (redraw (setq e (ssname ss (setq i 0))) 3)
              (while (eq (cadr (grread nil 10)) 9)
                (mapcar 'redraw (list e (setq e (ssname ss (setq i (rem (1+ i) l))))) '(4 3))
              )
              (redraw e 4)
              e
       )
     )
   )
 )

 (redraw)

 (if (and (AT:DrawX (setq p1 (getpoint "\nSpecify first point on curve: ")) 3)
          (or (setq ent (AT:CycleThroughSS
                          (ssget "_C"
                                 (list (car p1) (cadr p1))
                                 (list (car p1) (cadr p1))
                                 '((0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE"))
                          )
                        )
              )
              (progn (alert "Point must be on curve!") (redraw))
          )
          (progn (redraw ent 3) T)
   )
(while
          (AT:DrawX (setq p2 (getpoint p1 "\nSpecify next point on curve: ")) 3)
          (or (and (ssget "_C"
                          (list (car p2) (cadr p2))
                          (list (car p2) (cadr p2))
                          '((0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE"))
                   )
                   (setq d1 (vlax-curve-getDistAtPoint ent (trans p1 1 0)))
                   (setq d2 (vlax-curve-getDistAtPoint ent (trans p2 1 0)))
              )
              (progn (alert "Points must be on curve!") (redraw))
          )
     
   ((lambda (dist / div)
      (while (< dist (- (cadr dlst) (setq div (/ (cadr dlst) 100.))))
        (grdraw (trans (vlax-curve-getPointAtDist ent dist) 0 1)
                (trans (vlax-curve-getPointAtDist ent (setq dist (+ div dist))) 0 1)
                1
        )
      )
      (princ)
;;;       (command "_.text" p2 "" "" (rtos (abs (- d1 d2))))
      (entmakex (list '(0 . "TEXT")(cons 1 (rtos (abs (- d1 d2))2))(cons 10 (trans p2 1 0))(cons 40 (getvar 'textsize)))
    )
     (car (setq dlst (vl-sort (list d1 d2) (function <))))
   )
 
 (and ent (redraw ent 4))
   )
 )
 (princ)
)

you can try to apply osnap to nearest then restore (getvar 'osnap) etc..

 

i only modified entmake text & while loop hope its more generic to OP's request, the code all credits to guru Alan