Topic: Old lisp crashing 2016

[DanB]

I've had this LISP routine for quite some time. First use in 2016 is causing program to fatal error. I've tested a couple of times each crashes out. Any thoughts? (Snippet of error attached too.)

Code: [Select]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                       7/25/06                               ;;
;;        3d Polyline with User defined Elevations             ;;
;;                                                             ;;
;;    PROGRAM PROVIDED "AS IS" AND WITH ALL FAULTS,            ;;
;;    AND DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM   ;;
;;    WILL BE UNINTERRUPTED OR ERROR FREE.                     ;;
;;                                                             ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun c:3pe (/ oldecho oldos pnt1 elevz elev1txt elev1 pnt1e pntx elev2txt elevx) ;3pe
 (setq oldecho (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 
 (setq pnt1 (getpoint "\nSpecify start point of polyline: "))
 
 (setq elevz (last pnt1))
 (if (/= elevz 0)
  (setq pe:elev1 elevz)
 )
 
 (if pe:elev1
  (progn
   (setq elev1txt (rtos pe:elev1 2 2)) 
   (setq elev1 (getreal (strcat "\nStart elevation: <" elev1txt "> ")))
    (if (= elev1 nil)
     (setq pe:elev1 pe:elev1)
     (setq pe:elev1 elev1)
    )
  ) ;end progn
  (setq pe:elev1 (getreal "\nStart elevation: "))
 ) ;end if   
 (setq pnt1e (subst pe:elev1 (last pnt1) pnt1))
             
 (command ".3dpoly")
  (while
   (if (= pntx nil)
    (progn
     (setq oldos (getvar "osmode"))
     (setvar "osmode" 0)
     (command pnt1e)
     (setvar "osmode" oldos)
     (setq pntx (getpoint pnt1e "\nPick point: "))
    ) ;end progn
    (setq pntx (getpoint pntx "\nPick Point: "))
   ) ;end if
   (command pntx)
   
   (setq elev2z (last pntx))
   (if (/= elev2z 0)
    (setq pe:elev1 elev2z)
   )
   
   (setq elev2txt (rtos pe:elev1 2 2))
   (setq elevx (getreal (strcat "\nElevation: <" elev2txt "> ")))
    (if (= elevx nil)
     (setq elevx pe:elev1)
     (setq elevx elevx)
    )
   (setq pe:elev1 elevx)
   (setq pntx (subst elevx (last pntx) pntx))
   (command "undo")
   (setq oldos (getvar "osmode"))
   (setvar "osmode" 0)
   (command pntx)
   (setvar "osmode" oldos)
  ) ;end while
 (command "")
 
 (setvar "cmdecho" oldecho)
 (princ)
)

[squirreldip]

I don't get any error in C3D 2014...

[Jeff_M]

It crashed my C3D2016 to the desktop. No error message, no CER, just "AutoCAD has stopped working" and gone. Now I've got a client coming in so no more time to troubleshoot.

[Lee Mac]

Here's a quick rewrite - maybe this will resolve it:

Code - Auto/Visual Lisp: [Select]

1. (defun c:3pe ( / cmd pt1 pt2 )
2.     (if (setq pt1 (getpoint "\nSpecify start point: "))
3.         (progn
4.             (setq cmd (getvar 'cmdecho))
5.             (setvar 'cmdecho 0)
6.             (command "_.3dpoly" "_non" (setq pt1 (list (car pt1) (cadr pt1) (getelevation (caddr pt1)))))
7.             (while (setq pt2 (getpoint pt1 "\nSpecify next point <exit>: "))
8.                 (command "_non" (setq pt1 (list (car pt2) (cadr pt2) (getelevation (caddr pt2)))))
9.             )
10.             (command "")
11.             (setvar 'cmdecho cmd)
12.         )
13.     )
14.     (princ)
15. )
16. (defun getelevation ( def / tmp )
17.     (or (and  3pe:elv (equal 0.0 def 1e-8))
18.         (setq 3pe:elv def)
19.     )
20.     (if (setq tmp (getreal (strcat "\nSpecify elevation <" (rtos 3pe:elv 2 2) ">: ")))
21.         (setq 3pe:elv tmp)
22.     )
23.     3pe:elv
24. )
25. (princ)

[Jeff_M]

That did function for me without crashing, Lee.  If I were to use this I would need to add a way to Close or eXit, but I don't think either of those were in the original anyway.

[Lee Mac]

That did function for me without crashing, Lee.

Excellent, thank you for testing it Jeff.

If I were to use this I would need to add a way to Close or eXit, but I don't think either of those were in the original anyway.

Implementing your suggestions:

Code - Auto/Visual Lisp: [Select]

1. (defun c:3pe ( / cmd lst pt1 pt2 )
2.     (if (setq pt1 (getpoint "\nSpecify start point: "))
3.         (progn
4.             (setq cmd (getvar 'cmdecho)
5.                   pt1 (list (car pt1) (cadr pt1) (getelevation (caddr pt1)))
6.                   lst (list pt1)
7.             )
8.             (setvar 'cmdecho 0)
9.             (command "_.3dpoly" "_non" pt1)
10.             (while
11.                 (progn
12.                     (initget
13.                         (strcat
14.                             (if (cdr  lst) "Undo "  "")
15.                             (if (cddr lst) "Close " "")
16.                             "eXit"
17.                         )
18.                     )
19.                     (cond
20.                         (   (or
21.                                 (vl-catch-all-error-p
22.                                     (setq pt2
23.                                         (vl-catch-all-apply 'getpoint
24.                                             (list pt1
25.                                                 (strcat
26.                                                     "\nSpecify next point ["
27.                                                     (if (cdr  lst) "Undo/"  "")
28.                                                     (if (cddr lst) "Close/" "")
29.                                                     "eXit] <eXit>: "
30.                                                 )
31.                                             )
32.                                         )
33.                                     )
34.                                 )
35.                                 (null pt2) (= "eXit" pt2)
36.                             )
37.                             (command "")
38.                         )
39.                         (   (= "Close" pt2)
40.                             (command "_c")
41.                         )
42.                         (   (= "Undo" pt2)
43.                             (command "_u")
44.                             (setq lst (cdr lst)
45.                                   pt1 (car lst)
46.                             )
47.                         )
48.                         (   (listp pt2)
49.                             (command "_non" (setq pt1 (list (car pt2) (cadr pt2) (getelevation (caddr pt2)))))
50.                             (setq lst (cons pt1 lst))
51.                         )
52.                     )
53.                 )
54.             )
55.             (setvar 'cmdecho cmd)
56.         )
57.     )
58.     (princ)
59. )
60. (defun getelevation ( def / tmp )
61.     (or (and  3pe:elv (equal 0.0 def 1e-8))
62.         (setq 3pe:elv def)
63.     )
64.     (if (setq tmp (getreal (strcat "\nSpecify elevation <" (rtos 3pe:elv 2 2) ">: ")))
65.         (setq 3pe:elv tmp)
66.     )
67.     3pe:elv
68. )
69. (princ)

[DanB]

Sorry for the delay in responding back. Thank you for getting this to work, quick test in 2016 and there's no crashing out. 

[Lee Mac]

Excellent to hear, hope the new code proves useful 

[krampaul82]

Lee Mac
You Rock!  Thank you for your numerous contributions to the lisp community!  I hope you win the lottery!

[Lee Mac]

Lee Mac
You Rock!  Thank you for your numerous contributions to the lisp community!  I hope you win the lottery!

Thank you! - Now that would be something! 

[MSTG007]

Nice job!