Problem with a old lisp file

[Mondo]

Wrote this years ago and have not messed with much lisp since then. Not sure what the problem is but was written if I remember R14. Not sure what has changed with 2010 but it last worked in 2006.

 

What it did was you would have intersecting line 3 each for back of curb, face of curb, and edge of pavement. You would start this enter the radius, pick the 2 back of curb lines to fillet with supplied radius, fillet would be made, then asked for next 2 picks, fillet radius indexed up by .5, fillet created, then pick next 2 lines, fillet radius indexed up by 1, fillet created.

 

Now in 2010 I pick the 2 lines, the second line highlights, no fillet made and it ask for next picks. Below is the code

 

(defun c:CCR(/)
   (setq r1 nil)
   (setq ra nil)
   (setvar "cmdecho" 0)
   (SETQ R1 (GETREAL "\n ENTER RADIUS AT BACK OF CURB<5.0>:  "))
   (if (= r1 nil) (setq r1 5.0))
(TERPRI)
(TERPRI)
   (SETQ R2 (+ 0.5 R1))
   (SETQ R3 (+ 1.5 R1))
(SETVAR "FILLETRAD" R1)
(SETQ PT1 (GRREAD (SETQ OBJ1 (ENTGET (CAR (ENTSEL "\nPICK FIRST BACK OF CURB LINE:  "))))))
(SETQ PT1 (CAR (CDR PT1)))
(SETQ PT2 (GRREAD (SETQ OBJ2 (ENTGET (CAR (ENTSEL "\nPICK SECOND BACK OF CURB LINE:  "))))))
(SETQ PT2 (CAR (CDR PT2)))
(COMMAND "FILLET")
(COMMAND PT1)
(COMMAND PT2)
(SETVAR "FILLETRAD" R2)
(TERPRI)
(SETQ PT1 (GRREAD (SETQ OBJ1 (ENTGET (CAR (ENTSEL "\nPICK FIRST FACE OF CURB LINE:  "))))))
(SETQ PT1 (CAR (CDR PT1)))
(SETQ PT2 (GRREAD (SETQ OBJ2 (ENTGET (CAR (ENTSEL "\nPICK SECOND FACE OF CURB LINE:  "))))))
(SETQ PT2 (CAR (CDR PT2)))
(COMMAND "FILLET")
(COMMAND PT1)
(COMMAND PT2)
(SETVAR "FILLETRAD" R3)
(TERPRI)
(SETQ PT1 (GRREAD (SETQ OBJ1 (ENTGET (CAR (ENTSEL "\nPICK FIRST EDGE OF CURB LINE:  "))))))
(SETQ PT1 (CAR (CDR PT1)))
(SETQ PT2 (GRREAD (SETQ OBJ2 (ENTGET (CAR (ENTSEL "\nPICK SECOND EDGE OF CURB LINE:  "))))))
(SETQ PT2 (CAR (CDR PT2)))
(COMMAND "FILLET")
(COMMAND PT1)
(COMMAND PT2)
(SETVAR "FILLETRAD" 0.0)
)

end product see image

 

 

Thanks for looking

 

Kent

Edited June 15, 2012 by Mondo

[BIGAL]

Without answering your code question way better way to do this, drag a line across first kerb then across second kerb enter radius bingo done. You use the ability to measure the spacing of the kerb lines from a INTERS lisp calc now vlclosestpointto, the point of intersection is the fillet points for selection. I wrote a routine for as many lines as you like many years ago. This idea was in an option to simple change wall sizes by dragging over existing wall lines.

 

I will have a look for code.

[BIGAL]

Try this code not cleaned up

 

;;;---------------------------------------------------------------------------
;;;
;;;   autokerb rad.LSP   Version 1.0
;;;   by BIGAL
;;;   1 Aug 2011
;;;   uses fillet given inside radius for any number of lines 
;;; 
;;;---------------------------------------------------------------------------
(defun C:krad (/ CM EN EN2 NUM OLDSNAP PT1 PT2 PT3 RAD SS1 SS2 TP1 TP2 ANS NUM2 PT4 X Y)
(vl-load-com)
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 1)
(setq oldsnap (getvar "osmode"))
(setvar "osmode" 0)
(setq pt1 (getpoint "\nPick outside first kerb :"))
(setq pt2 (getpoint Pt1 "\nPick centre pt :"))
(setq pt3 (getpoint pt2 "\nPick outside second kerb :"))
(setq rad (getreal "\nEnter  radius  :"))
(setq ss1 (ssget "F" (list pt1 pt2)))
(setq ss2 (ssget "F" (list pt3 pt2)))
(setq num (sslength ss1))
(setq num2 (sslength ss2))
(if (/= num num2)
(progn
(princ "\nYou have unequal number of lines ")
(Setq ans (getstring "\Press any key when ready and try again")) 
(exit)
)
)
(repeat num
(setq en (ssname ss1 0))
(setq en2 (ssname ss2 0))
(setq tp1 (cons (vlax-curve-getClosestPointTo en pt2) tp1))
(setq tp2 (cons (vlax-curve-getClosestPointTo en2 pt2) tp2))

(ssdel en ss1)   ; Delete each measured entity from set  
(ssdel en2 ss2)   ; Delete each measured entity from set                
)   ; end repeat
(reverse tp2)
(setq pt1 (nth 0 tp1))
(setq pt2 (nth 0 tp2))
(setvar "filletrad" rad) 
(command "fillet" pt1 pt2)
(setq num (- num 1))
(setq x 0)
(repeat  num
(setq pt1d (nth x tp1))
(setq pt2d (nth (+ x 1) tp1))
(setq rad (+ rad (distance pt1d pt2d)))   ;  add distance between to rad
(setvar "filletrad" rad)
(setq pt1 (nth (+ x 1) tp1))
(setq pt2 (nth (+ x 1) tp2))
(command "fillet" pt1 pt2) 
(setq x (+ x 1))
)     ; end repeat 

(setvar "CMDECHO" cm)
(setvar "osmode" oldsnap)
; (setq ss1 nil
; ss2 nil 
; tp1 nil
; tp2 nil   )
)
(princ)

Edited June 16, 2012 by BIGAL

[SLW210]

Please read the CODE POSTING GUIDELINES and edit your post.

[Mondo]

Thanks for your code, will give it a try. I would like to know why mine no longer works though.

 

Kent