Picks to Accumulate Distance

[GregGleason]

I adapted some code I found.  The idea is to pick two points, and show the distance.  Then two more points, showing the distance of those two points, followed by the cumulative length.  When you hit return you exit.  The code works on the first pass then falls over.

(defun c:ptd ()
(setvar "cmdecho" 0)
(graphscr)
(setq
p1 (getpoint "\nPick start point ")
p2 (getpoint p1 "\nPick end point ")
d1 (distance p1 p2)
prdist (strcat "\nDistance: " (rtos d1))
)
(princ prdist)
p3 (getpoint "\nPick start point ")
p4 (getpoint p3 "\nPick next point ")
(while p4
(setq
d0 (distance p3 p4)
d1 (+ (distance p3 p4) d1)
p3 p4
prdist (strcat "\nDistance: " (rtos d0) ", Cumulative distance: " (rtos d1))
)
(princ prdist)
(setq
p3 (getpoint "\nPick start point ")
p4 (getpoint p3 "\nPick next point ")
)
)
(setq cumd (strcat "Cumulative distance --> " (rtos d1)))
(prompt cumd)
(princ)
)

What do I need to fix the code so that it works?

 

Greg

[Tharwat]

Something like this?

(defun c:Test ( / 1st 2nd dis )
  (setq dis 0.0)
  (while (and (setq 1st (getpoint "\n1st point :"))
              (setq 2nd (getpoint "\n2nd point :" 1st))
              )
    (princ "\nAccumulated distance is : ")
    (princ (setq dis (+ dis (distance 1st 2nd))))
    )
  (princ)
  )

 

[GregGleason]

Tharwat, that really helped.

 

I adapted the code and this is the result:

(defun c:ccc ( / 1st 2nd dis )
  (setq dis 0.0)
  (while (and (setq 1st (getpoint "\n1st point :"))
              (setq 2nd (getpoint "\n2nd point :" 1st))
              )
    (princ "\nAccumulated distance is : ")
    (setq d0 (distance 1st 2nd))
    (princ (setq dis (+ dis (distance 1st 2nd))))
    (setq prdist (strcat "\nDistance: " (rtos d0) ", Cumulative distance: " (rtos dis)))
    (princ prdist)
    )
  (princ)
)

 

I appreciate the help.

 

Thanks,

Greg

[Tharwat]

Excellent to hear that.  

But try always to localize variables as I did with the three variables to avoid any conflict with other routines you may use on the same drawing session.

[Lee Mac]

6 minutes ago, GregGleason said:

Tharwat, that really helped.

 

I adapted the code and this is the result:

(defun c:ccc ( / 1st 2nd dis )
  (setq dis 0.0)
  (while (and (setq 1st (getpoint "\n1st point :"))
              (setq 2nd (getpoint "\n2nd point :" 1st))
              )
    (princ "\nAccumulated distance is : ")
    (setq d0 (distance 1st 2nd))
    (princ (setq dis (+ dis (distance 1st 2nd))))
    (setq prdist (strcat "\nDistance: " (rtos d0) ", Cumulative distance: " (rtos dis)))
    (princ prdist)
    )
  (princ)
)

 

 

Well done for modifying the code yourself, but there seems to be quite a bit of repetition, e.g. the code could be reduced to:

(defun c:ccc ( / 1st 2nd cds dis )
    (setq cds 0.0)
    (while
        (and (setq 1st (getpoint "\n1st point: "))
             (setq 2nd (getpoint "\n2nd point: " 1st))
        )
        (setq dis (distance 1st 2nd)
              cds (+ dis cds)
        )
        (princ (strcat "\nDistance: " (rtos dis) ", Cumulative distance: " (rtos cds)))
    )
    (princ)
)

 

[GregGleason]

Wow!  Thanks Lee!

 

Beautiful and efficient.

Thank you for another opportunity to learn!

 

Greg

[ronjonp]

I've been using this one for years

(defun c:mdist (/ p1 p2 d v)
  (setq d 0)
  (while (and (or p1 (setq p1 (getpoint "\nSpecify start point: ")))
	      (setq p2 (getpoint p1 "\nSpecify next point: "))
	 )
    (setq d  (+ d (distance p1 p2))
	  v  (append v (list p1 p2))
	  p1 p2
    )
    (grvecs (append v '(1)))
    (princ (strcat "\nRunning total is " (rtos d)))
  )
  (princ)
)

 

[BIGAL]

My $0.05 added regen as temp lines do not disappear in Briscad

 

(defun c:mdist (/ p1 p2 d v)
  (setq d 0)
  (while (and (or p1 (setq p1 (getpoint "\nSpecify start point: ")))
          (setq p2 (getpoint p1 "\nSpecify next point: "))
     )
    (setq d  (+ d (distance p1 p2))
      v  (append v (list p1 p2))
      p1 p2
    )
    (grvecs (append v '(1)))
    (princ (strcat "\nRunning total is " (rtos d))) ; this line can be removed if only total required
  )
  (alert (strcat "\nTotal length is " (rtos d 2 2)))
  (command "regen") ; needed for Briscad to remove temp pick lines
  (princ)
)