Old Lisp routine crashing Autocad

[pyrosucks]

I have an older lisp routine that I have been using for many years. I have used it succesfully with versions 2004, 2005, and 2008. Since upgrading to 2010, it crashes autocad in the middle of the routine. I'm not sure if it is the new version, or because I'm now using 64 bit. Unfortunately, I know very little about lisp, these routines were written by someone long before I came around. I only know where to put them in my support files

 

The error message I get is !scandr.cpp@1117: eLookViolation

 

Any help in getting this to work again.would be much appreciated

 

;-----------------------------------------------------------------------------

;

; C:TIC

;

; COMMAND TO INSERT A TIC MARK AND PROMPT THE USER TO SELECT TEXT

;

;-----------------------------------------------------------------------------

 

(defun tic_error(msg)

(if (/= msg "Function cancelled")

(if (= msg "quit / exit abort")

(princ)

(princ (strcat "\nError in TIC Subroutine: " msg))

)

)

(if temp (entdel (cdar temp)))

(setvar "CLAYER" old_clayer)

(setvar "OSMODE" old_osmode)

(setvar "ORTHOMODE" old_ortho)

(setvar "CECOLOR" old_color)

(setq *error* old_error)

(princ)

)

 

;; ADDS SELECTED TEXT TO INS_TEXT VARIABLE

 

(defun tic_text_add(txt)

(cond

((= txt 1) (setq ins_txt ""))

((and (wcmatch txt "#") (= (type txt) 'STR))

(if (/= ins_txt "") (setq ins_txt (strcat ins_txt "," txt))

(setq ins_txt txt)))

((and (wcmatch txt "@") (or (wcmatch prev_txt "@") (wcmatch ins_txt "@"))

(= (type txt) 'STR))

(if (/= ins_txt "") (setq ins_txt (strcat ins_txt "," txt))

(setq ins_txt txt)))

((and (wcmatch txt "@") (= (type txt) 'STR))

(if (/= ins_txt "") (setq ins_txt (strcat ins_txt txt))

(setq ins_txt txt))))

(if (/= ins_txt "") (set_tile "ins_txt" ins_txt)

(set_tile "ins_txt" ""))

(if (= (type txt) 'STR) (setq prev_txt txt))

)

 

;; DEFINES ACTIONS FOR TILES

 

(defun tic_text_actions()

(if reset_tic (set_tile "reset" "1") (set_tile "reset" "0"))

(if reset_tic (setq ins_txt ""))

(if (= ins_txt "")

(set_tile "ins_txt" "")

(set_tile "ins_txt" (strcat "" ins_txt)))

(action_tile "A" "(tic_text_add \"A\")")

(action_tile "B" "(tic_text_add \"B\")")

(action_tile "C" "(tic_text_add \"C\")")

(action_tile "D" "(tic_text_add \"D\")")

(action_tile "E" "(tic_text_add \"E\")")

(action_tile "F" "(tic_text_add \"F\")")

(action_tile "2" "(tic_text_add \"2\")")

(action_tile "3" "(tic_text_add \"3\")")

(action_tile "4" "(tic_text_add \"4\")")

(action_tile "5" "(tic_text_add \"5\")")

(action_tile "6" "(tic_text_add \"6\")")

(action_tile "7" "(tic_text_add \"7\")")

(action_tile "ins_txt" "(setq ins_txt $value)")

(action_tile "clear" "(tic_text_add '1)")

(action_tile "reset" "(if (= $value \"1\") (progn (setq reset_tic T)

(tic_text_add '1)) (setq reset_tic nil))")

)

 

;; DEFINES EXIT CONDITIONS FOR TILES

 

(defun tic_text_exits(ex)

(if (= ex 0) (progn (entdel up) (entdel dn) (entdel lf) (entdel rt)

(setq ok nil tic_ins_pt nil)) (setq ok T))

(setq text_dia (unload_dialog text_dia))

)

 

;; DISPLAYS DIALOG BOX FOR SELECTION OF TEXT

 

(defun tic_sel_text()

(if (= ins_txt nil) (setq ins_txt ""))

(setq prev_txt "")

(setq text_dia (load_dialog "f:/dwg/lisp/tic.dcl"))

(while (and text_dia (new_dialog "tic" text_dia))

(tic_text_actions)

(tic_text_exits (start_dialog)))

)

 

;; COMMAND LINE FUNCTION

 

(defun c:tic()

(command "undo" "group")

(setq old_error *error* *error* tic_error)

(setq old_center (getvar "VIEWCTR") old_mag (getvar "VIEWSIZE"))

(if (tblsearch "STYLE" "DEV_NO") (setvar "TEXTSTYLE" "DEV_NO") (command

"style" "dev_no" "romans" "0.1" "0.75" "" "" "" ""))

(setq old_osmode (getvar "OSMODE") old_clayer (getvar "CLAYER")

old_ortho (getvar "ORTHOMODE") old_color (getvar "CECOLOR")

new_tic_ins_pt nil)

(setvar "CMDECHO" 0)

(setvar "OSMODE" 512)

(setq tic_ins_pt (getpoint "\nSelect tic Insertion point for New Text: "))

(setvar "OSMODE" 0)

(while tic_ins_pt

(setq tis_ss (ssget tic_ins_pt))

(if tic_ss (progn (setq tic_ent (entget (ssname tic_ss 0)))

(setvar "CLAYER" (cdr (assoc 8 tic_ent)))))

(setvar "ORTHOMODE" 0)

(setvar "CECOLOR" "7")

(command "insert" "tic" tic_ins_pt "" "" "0")

(setq rt (entlast))

(command "insert" "tic" tic_ins_pt "" "" "180")

(setq lf (entlast))

(command "insert" "tic" tic_ins_pt "" "" "90")

(setq up (entlast))

(command "insert" "tic" tic_ins_pt "" "" "270")

(setq dn (entlast))

(if (not new_tic_ins_pt) (tic_sel_text))

(if ok (progn

(command "zoom" "c" tic_ins_pt "1" )

(command "text" "0,0,0" "0" ins_txt)

(setq temp (entget (entlast)))

(command "move" (cdar temp) "" "0,0,0" pause)

(setq temp_pt (cdr (assoc 10 (setq temp (entget (cdar temp)))))

tic_ang (/ (* 180 (angle tic_ins_pt temp_pt)) pi))

(setq text_box (textbox temp)

txt_pt1 (cdr (assoc 10 temp))

txt_pt2 (polar (polar txt_pt1 (angle '(0 0 0) (car text_box))

(distance '(0 0 0) (car text_box))) (angle (car text_box) (cadr

text_box)) (distance (car text_box) (cadr text_box))))

(setq mid_lf (polar txt_pt1 (/ pi 2) (* (distance txt_pt1 txt_pt2)

(sin (angle txt_pt1 txt_pt2)) 0.5))

mid_rt (polar txt_pt2 (/ pi -2) (* (distance txt_pt1 txt_pt2)

(sin (angle txt_pt1 txt_pt2)) 0.5))

mid_top (polar txt_pt2 pi (* (distance txt_pt1 txt_pt2)

(cos (angle txt_pt1 txt_pt2)) 0.5))

mid_bot (polar txt_pt1 0 (* (distance txt_pt1 txt_pt2)

(cos (angle txt_pt1 txt_pt2)) 0.5)))

(cond

((or (>= tic_ang 315) (

(entdel lf) (entdel up) (entdel dn)

(setq lf nil up nil dn nil)

(setq temp (subst (cons 72 0) (assoc 72 temp) temp))

(setq temp (subst (cons 73 2) (assoc 73 temp) temp))

(setq temp (subst (cons 11 mid_lf) (assoc 11 temp) temp))

(entmod temp)

))

((and (>= tic_ang 45) (

(entdel rt) (entdel lf) (entdel dn)

(setq lf nil rt nil dn nil)

(setq temp (subst (cons 72 1) (assoc 72 temp) temp))

(setq temp (subst (cons 73 0) (assoc 73 temp) temp))

(setq temp (subst (cons 11 mid_bot) (assoc 11 temp) temp))

(entmod temp)

))

((and (>= tic_ang 135) (

(entdel rt) (entdel dn) (entdel up)

(setq rt nil up nil dn nil)

(setq temp (subst (cons 72 2) (assoc 72 temp) temp))

(setq temp (subst (cons 73 2) (assoc 73 temp) temp))

(setq temp (subst (cons 11 mid_rt) (assoc 11 temp) temp))

(entmod temp)

))

((and (>= tic_ang 225) (

(entdel rt) (entdel lf) (entdel up)

(setq lf nil rt nil up nil)

(setq temp (subst (cons 72 1) (assoc 72 temp) temp))

(setq temp (subst (cons 73 3) (assoc 73 temp) temp))

(setq temp (subst (cons 11 mid_top) (assoc 11 temp) temp))

(entmod temp)

)))

(setq temp nil)

(setvar "OSMODE" 512)

(command "zoom" "P")

(setq new_prompt (strcat "\nSelect tic Insertion point for " ins_txt

" or RETURN for New Text:"))

(setq new_tic_ins_pt (getpoint new_prompt))

(if (= new_tic_ins_pt nil) (setq tic_ins_pt (getpoint

"\nSelect tic Insertion point for New Text:")) (setq tic_ins_pt

new_tic_ins_pt))

(command "'redraw")

(setvar "OSMODE" 0)

)))

(setvar "CLAYER" old_clayer)

(setvar "OSMODE" old_osmode)

(setvar "ORTHOMODE" old_ortho)

(setvar "CECOLOR" old_color)

(setq *error* old_error)

(command "undo" "end")

(princ)

)