Nc Code Generator

[WILLY]

ok...this is the dcl lisp thingie....
with this u should be able to pick which cnc machine u are
going to use and then the lisp program will generate the code
for u....if need be, i can attache the lisp routine that actually
writes the code...also this was written by another engineer who
is WAY smarter that i...

G-Coder By Jason Wallace, 2001 Release 0.9

 
gcoder : dialog{
    label = "G-Coder Setup";
: row {
: boxed_column {
 label = "Code Properties";
: row {
            : popup_list {
                key = "gcproglist";
         label = "Machine";
                edit_width = 14;
         horizontal_alignment = left;
         allow_accept         = true;
            }
}
: row {
        : edit_box {
        mnemonic             = "X";
        label                = "X-Axiz Start Position";
        key                  = "gcxoffset";
        edit_width           = 6;
        horizontal_alignment = left;
        allow_accept         = true;
      }
}
: row {
 : edit_box {
        mnemonic             = "Z";
        label                = "Z-Axiz Start Position";
        key                  = "gczoffset";
        edit_width           = 6;
        horizontal_alignment = left;
        allow_accept         = true;
      }
}
: row {
 : edit_box {
        label                = "Radial Finish Stock";
        key                  = "rfs";
        edit_width           = 6;
        horizontal_alignment = left;
        allow_accept         = true;
      }
}
: row {
 : edit_box {
        label                = "Axial Finish Stock";
        key                  = "afs";
        edit_width           = 6;
        horizontal_alignment = left;
        allow_accept         = true;
      }
}
: row {
 : edit_box {
        label                = "Take-Off";
        key                  = "sto";
        edit_width           = 6;
        horizontal_alignment = left;
        allow_accept         = true;
      }
}
: row {
 : edit_box {
        label                = "Return";
        key                  = "ret";
        edit_width           = 6;
        horizontal_alignment = left;
        allow_accept         = true;
      }
}
: row {
 : edit_box {
        label                = "End of Cycle Over-Cut";
        key                  = "overcut";
        edit_width           = 6;
        horizontal_alignment = left;
        allow_accept         = true;
      }
}
}
: boxed_column {
 label = "Cut Properties";
: row {
 : edit_box {
        mnemonic             = "Z";
        label                = "Rough Cut Feed Rate (In/Rev)";
        key                  = "rcfr";
        edit_width           = 6;
        horizontal_alignment = left;
        allow_accept         = true;
      }
}
: row {
 : edit_box {
        mnemonic             = "Z";
        label                = "Finish Cut Feed Rate (In/Rev)";
        key                  = "fcfr";
        edit_width           = 6;
        horizontal_alignment = left;
        allow_accept         = true;
      }
}
: row {
 : edit_box {
        mnemonic             = "Z";
        label                = "Spindle RPM";
        key                  = "srpm";
        edit_width           = 6;
        horizontal_alignment = left;
        allow_accept         = true;
      }
}
: row {
 : edit_box {
        mnemonic             = "Z";
        label                = "Spindle Max RPM";
        key                  = "smrpm";
        edit_width           = 6;
        horizontal_alignment = left;
        allow_accept         = true;
      }
}
}
}
: row {
 : button {
label = "Help";
key = "helpme";
fixed_width = true;
is_default = true;
width = 9;
is_cancel = true;
}
 : button {
label = "Go";
key = "nothin";
allow_accept = true;
fixed_width = true;
is_default = true;
if_focus = true;
width = 9;
is_cancel = true;
}
 cancel_button;
    }
}

[mahahaavaaha]

Hi,

this was just the DCL definition part of the program, not where it initially calls the DCL-code. Need that to make the whole... ie the LSP -file

/Petri

[WILLY]

ok....gonna have to send coder in 3 or 4 snippets...it is really big...
hang on...

 
;G-Coder By Jason Wallace, 2001 Release 0.9
(defun c:gc () ; Initialize and start
;Begin Portion
(setq echo (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq oldprec (getvar "luprec"))
(setvar "luprec" 4)
(setq errduh *error*)
(command "undo" "begin")
;Define some special error control
(defun *error* (msg)
(if (and (/= msg "Function cancelled") (/= msg "quit / exit abort"))
(progn
(princ "\nError Was: ")
(princ msg)
(princ "\n")
(command)
(command "undo" "end")
(command ".u")
(setvar "luprec" oldprec)
(setvar "clayer" gcoldlay)
(setvar "cecolor" gcoldcolor)
(setvar "osmode" gcoldsnap)
(if (= gcisopen "Y")
(close gcfile))
(setq *error* errduh)
(setvar "cmdecho" echo)
(prin1)
(startapp "//IBMS1/Engineering Machine/Borders/LISP/GCoder/BEEP.COM")
(alert "An Error Has Occured. Verify That The Profile is Continous. \nIf This Does Not Resolve The Problem, Please Report to: \nJason.Wallace")
(prin1)))
(if (or (= msg "Function cancelled") (= msg "quit / exit abort"))
(progn
(command)
(command "undo" "end")
(command ".u")
(setvar "luprec" oldprec)
(setvar "clayer" gcoldlay)
(setvar "cecolor" gcoldcolor)
(setvar "osmode" gcoldsnap)
(if (= gcisopen "Y")
(close gcfile))
(setq *error* errduh)
(setvar "cmdecho" echo)
(princ "\nFunction Canceled :")
(prin1)))
(prin1)
)
;End error handeler
;Initalize
(setq gcentlast (entlast))
(setq gcoldlay (getvar "clayer"))
(setvar "clayer" "0")
(setq gcoldcolor (getvar "cecolor"))
(setvar "cecolor" "255")
(setq gcproglist (list "Mori-Seiki" "Tak" "Warner-Swasey"))
(setq gcxo 0.64)
(setq gczo 0.1)
(setq gcxoffset (rtos gcxo))
(setq gczoffset (rtos gczo))
(setq rcfr 0.012)
(setq fcfr 0.005)
(setq rfs 0.015)
(setq afs 0.015)
(setq sto 0.05)
(setq ret 0.05)
(setq helpme 0)
(setq srpm 4500)
(setq smrpm 5000)
(setq gcmachine 0)
(setq overcut 0.05)
(setq gcfail 0)
(setq gcfilepath "c:/G-Code.txt")
(c:gcd)
)
(defun c:gcd () ;Dialog Box
(setq chfnpth 0)
(setq dcl_id (load_dialog "//IBMS1/Engineering Machine/Borders/LISP/GCoder/gcoder.dcl"))
(if (not (new_dialog "gcoder" dcl_id) ) (exit))
(action_tile "accept" "(done_dialog)")
(start_list "gcproglist")
(mapcar 'add_list gcproglist)
(end_list)
(set_tile "gcxoffset" gcxoffset)
(set_tile "gczoffset" gczoffset)
(set_tile "srpm" (rtos srpm))
(set_tile "smrpm" (rtos smrpm))
(set_tile "rcfr" (rtos rcfr))
(set_tile "fcfr" (rtos fcfr))
(set_tile "rfs" (rtos rfs))
(set_tile "afs" (rtos afs))
(set_tile "sto" (rtos sto))
(set_tile "ret" (rtos ret))
(set_tile "overcut" (rtos overcut))
(action_tile "gcproglist" "(setq gcmachine (atoi $value))")
(action_tile "gcxoffset" "(setq gcxo (distof $value))")
(action_tile "gczoffset" "(setq gczo (distof $value))")
(action_tile "cancel" "(setq gcfail (distof $value))")
(action_tile "srpm" "(setq srpm (distof $value))")
(action_tile "smrpm" "(setq smrpm (distof $value))")
(action_tile "rcfr" "(setq rcfr (distof $value))")
(action_tile "fcfr" "(setq fcfr (distof $value))")
(action_tile "rfs" "(setq rfs (distof $value))")
(action_tile "afs" "(setq afs (distof $value))")
(action_tile "sto" "(setq sto (distof $value))")
(action_tile "ret" "(setq ret (distof $value))")
(action_tile "overcut" "(setq overcut (distof $value))")
(action_tile "helpme" "(setq helpme (distof $value))")
(start_dialog)
(unload_dialog dcl_id)
(if (= gcfail 1.0)
(quit))
(setq gcmach (car gcproglist))
(setq tripper 0)
(if (/= nil gcmachine)
(progn
(while (/= tripper gcmachine)
(setq gcproglist (append (cdr gcproglist) (list (car gcproglist))))
(setq tripper (+ tripper 1))
(setq gcmach (car gcproglist)))
(while (/= (car gcproglist) gcmach)
(setq gcproglist (append (cdr gcproglist) (list (car gcproglist)))))
(setq gcmach (car gcproglist))))
(setq gcxoffset (rtos gcxo))
(setq gczoffset (rtos gczo))
(princ)
(if (/= 0 helpme)
(progn
(setq helpme 0)
(startapp "notepad.exe //IBMS1/Engineering Machine/Borders/LISP/GCoder/helpme.txt")
(c:gcd)))
(if (/= gcfail 1.0)
(c:gce)
(prin1))
)

[WILLY]

here is second part....

 
(defun c:gce () ;Body
;Data Analysis
(setq gcxo (/ gcxo 2.0))
(setq gcp1 (getpoint "\nSelect the Start Point (Origin): "))
(setq gcplast (getpoint "\nSelect the End Point (Outside Edge): "))
;Point 1
(setq gcp1x (car gcp1)) 
(setq gcp1y (cadr gcp1))
(setq gcp1z (caddr gcp1))
;Point Last
(setq gcplastx (car gcplast)) 
(setq gcplasty (cadr gcplast))
(setq gcplastz (caddr gcplast))
;Data Manipulation: All changes done incrementally from point to point.
;Point 2
(setq gcp2x gcp1x) 
(setq gcp2y (- gcp1y 0.045))
(setq gcp2z gcp1z)
;Point 3
(setq gcp3x (+ gcp2x gczo)) 
(setq gcp3y gcp2y)
(setq gcp3z gcp2z)
;Point 4
(setq gcp4x gcp3x) 
(setq gcp4y (+ gcp3y (+ 0.045 gcxo)))
(setq gcp4z gcp3z)
;Point 5
(setq gcp5x (- gcplastx overcut))
(setq gcp5y gcp4y)
(setq gcp5z gcp4z)
;Point 6
(setq gcp6x gcp5x) 
(setq gcp6y (+ gcplasty 0.05))
(setq gcp6z gcp5z)
;Point 7
(setq gcp7x (+ gcp6x 0.05)) 
(setq gcp7y gcp6y)
(setq gcp7z gcp6z)
;Point 8
(setq gcp8x gcp5x) 
(setq gcp8y (- gcp7y 0.05))
(setq gcp8z gcp7z)
;Point in Inside
(setq gcpinsidex (/ (+ gcp5x gcp4x) 2.0)) 
(setq gcpinsidey (/ (+ gcp5y gcplasty) 2.0))
(setq gcpinsidez gcp1z)
;Data Assembly
(setq gcp1 (list gcp1x gcp1y gcp1z))
(setq gcp2 (list gcp2x gcp2y gcp2z))
(setq gcp3 (list gcp3x gcp3y gcp3z))
(setq gcp4 (list gcp4x gcp4y gcp4z))
(setq gcp5 (list gcp5x gcp5y gcp5z))
(setq gcp6 (list gcp6x gcp6y gcp6z))
(setq gcp7 (list gcp7x gcp7y gcp7z))
(setq gcp8 (list gcp8x gcp8y gcp8z))
(setq gcpinside (list gcpinsidex gcpinsidey gcpinsidez))
(setq gcplast (list gcplastx gcplasty gcplastz))
;Change View to Accomidate Hatching
(command "zoom" (list (- gcp2x 1) (- gcp2y 1)) (list (+ gcp4x 1) (+ gcp4y 1)))
;Data Construction: Bounding Box
(setq gcoldsnap (getvar "osmode"))
(setvar "osmode" (+ gcoldsnap 16384))
(command "line" gcp1 gcp2 gcp3 gcp4 gcp5 gcp8 "")
(command "boundary" gcpinside "")
;Data Acquisition
(setq gcpoly (entlast))
;More Construction
(command "BHATCH" "p" "ANSI31" "" "" gcpinside "")
;Compute G-code points: The ENGINE
(setq gcentinfo (entget gcpoly))
;Grab Vertices and Bulges
(setq gcpx nil)
(setq gcpy nil)
(setq gcbulge nil)
(while (/= gcentinfo nil)
(setq gcentpart (car (car gcentinfo)))
(if (= gcentpart 10)
(progn
(setq gcpx (append (list (cadr (car gcentinfo))) gcpx))
(setq gcpy (append (list (caddr (car gcentinfo))) gcpy))))
(if (= gcentpart 42)
(progn
(setq gcbulge (append (list (cdr (car gcentinfo))) gcbulge))))
(setq gcentinfo (cdr gcentinfo)))
;Rearrange Lists
;FIRST CYCLE THRU UNTIL POINT 4 IS FIRST
(while (not (equal (list (atof (rtos (car gcpx))) (atof (rtos (car gcpy)))) (list (atof (rtos gcp4x)) (atof (rtos gcp4y)))))
(setq gcpx (append (cdr gcpx) (list (car gcpx))))
(setq gcpy (append (cdr gcpy) (list (car gcpy))))
(setq gcbulge (append (cdr gcbulge) (list (car gcbulge)))))
;fix the bulge order
(setq gcbulge (cdr (append gcbulge (list (car gcbulge)))))
(setq gccount 0)
(while (< gccount (length gcpx))
(setq gccount (1+ gccount))
(setq gcbulge (cdr (append gcbulge (list (* -1.0 (car gcbulge)))))))
;if point 3 is after point 4, then the list is in proper order
;else, point 4 is moved to the end and the list is reversed
(if (not (equal (list (atoi (rtos(car (cdr gcpx)))) (atoi (rtos (car (cdr gcpy))))) (list (atoi (rtos gcp3x)) (atoi (rtos gcp3y)))))
(progn
(setq gcpx (cdr (append gcpx (list (car gcpx)))))
(setq gcpy (cdr (append gcpy (list (car gcpy)))))
(setq gcbulge (cdr (append gcbulge (list (car gcbulge)))))
(setq gcpx (reverse gcpx))
(setq gcpy (reverse gcpy))
(setq gcbulge (reverse gcbulge))
(setq gcbulge (cdr (append gcbulge (list (car gcbulge)))))
(setq gccount 0)
(while (< gccount (length gcpx))
(setq gccount (1+ gccount))
(setq gcbulge (cdr (append gcbulge (list (* -1.0 (car gcbulge)))))))))
;Use Bulge to find Radii and Center points
(setq bulgeflag "notnil")
(setq gcpxx gcpx)
(setq gcpyy gcpy)
(setq gcbulges gcbulge)
(setq gcpi nil)
(setq gcpj nil)
(while (/= gcpxx nil)
(setq gccenter (list 0 0))
(if (/= (car gcbulges) 0)
(progn
(setq gcalpha (* 4 (atan (abs (car gcbulges)))))
(setq gcgamma (angle (list (car gcpxx) (car gcpyy)) (list (car (cdr gcpxx)) (car (cdr gcpyy)))))
(setq gcchord (distance (list (car gcpxx) (car gcpyy)) (list (car (cdr gcpxx)) (car (cdr gcpyy)))))
(setq gcrad (/ (/ gcchord 2) (cos (- (/ pi 2) (/ gcalpha 2)))))
(setq gcang (+ gcgamma (* (- (/ PI 2.0) (/ gcalpha 2.0)) (/ (abs (car gcbulges)) (car gcbulges)))))
(setq gccenter (polar (list (car gcpxx) (car gcpyy)) gcang (abs gcrad) ))
(command "circle" gccenter "0.0001")
(setq gcpi (append gcpi (list (- (car gccenter) (car gcpxx)))))
(setq gcpj (append gcpj (list (- (car (cdr gccenter)) (car gcpyy))))))
(progn
(setq gcpi (append gcpi (list 0.0)))
(setq gcpj (append gcpj (list 0.0)))))
(setq gcpxx (cdr gcpxx))
(setq gcpyy (cdr gcpyy))
(setq gcbulges (cdr gcbulges)))
;Verify the x-section
(setq gcaccept nil)
(setq gcaccept (getstring "\n\n Accept This Cut Pattern? (-ENTER- to Accept)? "))
(if (/= gcaccept "")
(quit))
;Make Incremental or abs
(setq gccount (length gcpx))
(setq gcp1xl nil)
(setq gcp1yl nil)
(while (/= gccount 0)
(setq gcp1xl (append gcp1xl (list gcp1x)))
(setq gcp1yl (append gcp1yl (list gcp1y)))
(setq gccount (- gccount 1.0)))
(setq gcpxxx (mapcar '- gcpx gcp1xl))
(setq gcpyyy (mapcar '- gcpy gcp1yl))
(setq gcpiii gcpi)
(setq gcpjjj gcpj)
;Round to 4 decimal places
(setq gccount (length gcpx))
(princ "\nProcessing...\n")
(command)
(while (/= gccount 0)
(setq gcpx (cdr (append gcpx (list (cal (strcat "trunc(" (rtos (car gcpxxx)) ")+(round((" (rtos (car gcpxxx)) "-trunc(" (rtos (car gcpxxx)) "))*10000))/10000"))))))
(setq gcpy (cdr (append gcpy (list (cal (strcat "trunc(" (rtos (car gcpyyy)) ")+(round((" (rtos (car gcpyyy)) "-trunc(" (rtos (car gcpyyy)) "))*10000))/10000"))))))
(setq gcpi (cdr (append gcpi (list (cal (strcat "trunc(" (rtos (car gcpiii)) ")+(round((" (rtos (car gcpiii)) "-trunc(" (rtos (car gcpiii)) "))*10000))/10000"))))))
(setq gcpj (cdr (append gcpj (list (cal (strcat "trunc(" (rtos (car gcpjjj)) ")+(round((" (rtos (car gcpjjj)) "-trunc(" (rtos (car gcpjjj)) "))*10000))/10000"))))))
(setq gcpxxx (cdr gcpxxx))
(setq gcpyyy (cdr gcpyyy))
(setq gcpiii (cdr gcpiii))
(setq gcpjjj (cdr gcpjjj))
(setq gccount (- gccount 1)))
;More rearranging
(setq gcountd (- (length gcpx) 1.0))
(while (/= gcountd 0)
(setq gcpi (append (cdr gcpi) (list (car gcpi))))
(setq gcpj (append (cdr gcpj) (list (car gcpj))))
(setq gcbulge (append (cdr gcbulge) (list (car gcbulge))))
(setq gcountd (- gcountd 1.0)))
; remove unnecessary zeros

[WILLY]

and again...

 
;Construct the G-code
(setq gcpxsave gcpx)
(setq gcpysave gcpy)
(setq gcpisave gcpi)
(setq gcpjsave gcpj)
(setq gcpbsave gcbulge)
(setq gclinenum (fix 10))
(setq gcfile (open gcfilepath "w"))
(setq gcisopen "Y")
; Count total number of lines
(setq listlength (* (length gcpx) 2.0))
;Bring in Machine specific data
(if (= "Mori-Seiki" gcmach)
(progn
(write-line "N010 M37" gcfile)
(write-line "N020 M60" gcfile)
(write-line "N030 M38" gcfile)
(write-line (strcat "N040 G50S" (itoa (fix smrpm)) "M08") gcfile)
(write-line (strcat "N050 G00T0101X" (zerocut (* 2.0 (car gcpy))) " Z" (zerocut (car gcpx)) "G97S" (itoa (fix srpm)) "M03") gcfile)
(write-line "N060 M81" gcfile)
(setq gcpx (cdr gcpx))
(setq gcpy (cdr gcpy))
(setq gcpi (cdr gcpi))
(setq gcpj (cdr gcpj))
(setq gcbulge (cdr gcbulge))
(write-line "N070 G04U.0" gcfile)
(write-line (strcat "N080 G71 U" (zerocut sto) " R " (zerocut ret)) gcfile)
(write-line (strcat "N090 G71 P100 Q" (if (< (+ 60 (* 10 listlength)) 100) "0" "") (itoa (fix (+ 60 (* 10 listlength)))) " U" (zerocut rfs) " W" (zerocut afs) " F" (zerocut rcfr)) gcfile)
(write-line (strcat "N100 G00G42X" (zerocut (* 2.0 (car gcpy)))) gcfile)
(setq gcpx (cdr gcpx))
(setq gcpy (cdr gcpy))
(setq gcpi (cdr gcpi))
(setq gcpj (cdr gcpj))
(setq gcbulge (cdr gcbulge))
(write-line (strcat "N110 G01 X" (zerocut (* 2.0 (car gcpy))) " Z" (zerocut (car gcpx)) "F" (zerocut fcfr)) gcfile)
(setq gcpxveryold (car gcpx))
(setq gcpyveryold (car gcpy))
(setq gcpx (cdr gcpx))
(setq gcpy (cdr gcpy))
(setq gcpi (cdr gcpi))
(setq gcpj (cdr gcpj))
(setq gcbulge (cdr gcbulge))
(write-line (strcat "N120 G04U.0") gcfile)
(setq gclinenum (fix 130))))
(if (= "Tak" gcmach)
(progn
(write-line "N010 G99" gcfile)
(write-line (strcat "N020 G50S" (itoa (fix smrpm)) "M08") gcfile)
(write-line (strcat "N030 G00T0101X" (zerocut (* 2.0 (car gcpy))) " Z" (zerocut (car gcpx)) "G97S" (itoa (fix srpm)) "M04") gcfile)
(setq gcpx (cdr gcpx))
(setq gcpy (cdr gcpy))
(setq gcpi (cdr gcpi))
(setq gcpj (cdr gcpj))
(setq gcbulge (cdr gcbulge))
(write-line "N040 G04U.0" gcfile)
(write-line (strcat "N050 G71 U" (zerocut sto) " R " (zerocut ret)) gcfile)
(write-line (strcat "N060 G71 P070 Q" (if (< (+ 30 (* 10 listlength)) 100) "0" "") (itoa (fix (+ 30 (* 10 listlength)))) " U" (zerocut rfs) " W" (zerocut afs) " F" (zerocut rcfr)) gcfile)
(write-line (strcat "N070 G00G42X" (zerocut (* 2.0 (car gcpy)))) gcfile)
(setq gcpx (cdr gcpx))
(setq gcpy (cdr gcpy))
(setq gcpi (cdr gcpi))
(setq gcpj (cdr gcpj))
(setq gcbulge (cdr gcbulge))
(write-line (strcat "N080 G01 X" (zerocut (* 2.0 (car gcpy))) " Z" (zerocut (car gcpx)) "F" (zerocut fcfr)) gcfile)
(setq gcpxveryold (car gcpx))
(setq gcpyveryold (car gcpy))
(setq gcpx (cdr gcpx))
(setq gcpy (cdr gcpy))
(setq gcpi (cdr gcpi))
(setq gcpj (cdr gcpj))
(setq gcbulge (cdr gcbulge))
(write-line (strcat "N090 G04U.0") gcfile)
(setq gclinenum (fix 100))))
(if (= "Warner-Swasey" gcmach)
(progn
(write-line "N010 G95" gcfile)
(write-line "N020 G92X2.0Z1.0M08" gcfile)
(write-line "N030 G00T0101M04" gcfile)
(write-line (strcat "N040 G97S" (itoa (fix srpm))) gcfile)
(write-line (strcat "N050 G00 X" (zerocut (* 2.0 (car gcpy))) " Z" (zerocut (car gcpx))) gcfile)
(setq gcpx (cdr gcpx))
(setq gcpy (cdr gcpy))
(setq gcpi (cdr gcpi))
(setq gcpj (cdr gcpj))
(setq gcbulge (cdr gcbulge))
(write-line "N060 G04U.0" gcfile)
(write-line (strcat "N070 G71 U" (zerocut sto) " R " (zerocut ret)) gcfile)
(write-line (strcat "N080 G71 P090 Q" (if (< (+ 50 (* 10 listlength)) 100) "0" "") (itoa (fix (+ 50 (* 10 listlength)))) " U" (zerocut rfs) " W" (zerocut afs) " F" (zerocut rcfr)) gcfile)
(write-line (strcat "N090 G00G42X" (zerocut (* 2.0 (car gcpy)))) gcfile)
(setq gcpx (cdr gcpx))
(setq gcpy (cdr gcpy))
(setq gcpi (cdr gcpi))
(setq gcpj (cdr gcpj))
(setq gcbulge (cdr gcbulge))
(write-line (strcat "N100 G01 X" (zerocut (* 2.0 (car gcpy))) " Z" (zerocut (car gcpx)) "F" (zerocut fcfr)) gcfile)
(setq gcpxveryold (car gcpx))
(setq gcpyveryold (car gcpy))
(setq gcpx (cdr gcpx))
(setq gcpy (cdr gcpy))
(setq gcpi (cdr gcpi))
(setq gcpj (cdr gcpj))
(setq gcbulge (cdr gcbulge))
(write-line (strcat "N110 G04U.0") gcfile)
(setq gclinenum (fix 120))))
; Body of Code
(while (/= gcpx nil)
(setq gczero "0")
(if (>= gclinenum 100)
(setq gczero ""))
(if (= (car gcbulge) 0.0)
(setq gcout (strcat "N" gczero (rtos gclinenum 5 2) " G0" (if (= nil (cdr gcpy)) "0" "1") (if (/= gcpyveryold (car gcpy)) (progn (strcat " X" (zerocut (* 2.0 (car gcpy))))) "") (if (/= gcpxveryold (car gcpx)) (progn (strcat " Z" (zerocut (car gcpx)))) ""))))
(if (> (car gcbulge) 0.0)
(setq gcout (strcat "N" gczero (rtos gclinenum 5 2) " G03 X" (zerocut (* 2.0 (car gcpy))) " Z" (zerocut (car gcpx)) " I" (zerocut (car gcpj)) " K" (zerocut (car gcpi)))))
(if (< (car gcbulge) 0.0)
(setq gcout (strcat "N" gczero (rtos gclinenum 5 2) " G02 X" (zerocut (* 2.0 (car gcpy))) " Z" (zerocut (car gcpx)) " I" (zerocut (car gcpj)) " K" (zerocut (car gcpi)))))
(setq gcpxveryold (car gcpx))
(setq gcpyveryold (car gcpy))
(setq gcpx (cdr gcpx))
(setq gcpy (cdr gcpy))
(setq gcpi (cdr gcpi))
(setq gcpj (cdr gcpj))
(setq gcbulge (cdr gcbulge))
(setq gclinenum (fix (+ gclinenum 10)))
(setq gczero "0")
(if (>= gclinenum 100)
(setq gczero ""))
(write-line gcout gcfile)
(if (/= nil gcpx)
(progn
(setq gcout (strcat "N" gczero (rtos gclinenum 5 2) " G04U.0"))
(setq gclinenum (fix (+ gclinenum 10)))
(write-line gcout gcfile))))
; Last Machine Code

[WILLY]

this should do it...

 
(if (= "Mori-Seiki" gcmach)
(progn
(write-line (strcat "N" (itoa gclinenum) " G40") gcfile)
(write-line (strcat "N" (itoa (+ 10 gclinenum)) " G70 P100 Q" (if (< (+ 60 (* 10 listlength)) 100) "0" "") (itoa (fix (+ 60 (* 10 listlength))))) gcfile)
(write-line (strcat "N" (itoa (+ 20 gclinenum)) " M09") gcfile)
(write-line (strcat "N" (itoa (+ 30 gclinenum)) " M05") gcfile)
(write-line (strcat "N" (itoa (+ 40 gclinenum)) " G28U0.0W0.0T0000") gcfile)
(write-line (strcat "N" (itoa (+ 50 gclinenum)) " M37") gcfile)
(write-line (strcat "N" (itoa (+ 60 gclinenum)) " M89") gcfile)
(write-line (strcat "N" (itoa (+ 70 gclinenum)) " /M99") gcfile)
(write-line (strcat "N" (itoa (+ 80 gclinenum)) " M30") gcfile)))
(if (= "Tak" gcmach)
(progn
(write-line (strcat "N" (itoa gclinenum) " G40") gcfile)
(write-line (strcat "N" (itoa (+ 10 gclinenum)) " G70 P70 Q" (if (< (+ 30 (* 10 listlength)) 100) "0" "") (itoa (fix (+ 30 (* 10 listlength))))) gcfile)
(write-line (strcat "N" (itoa (+ 20 gclinenum)) " G28U0.0W0.0M05T0000") gcfile)
(write-line (strcat "N" (itoa (+ 30 gclinenum)) " M09") gcfile)
(write-line (strcat "N" (itoa (+ 40 gclinenum)) " M40") gcfile)
(write-line (strcat "N" (itoa (+ 50 gclinenum)) " G04U0.2") gcfile)
(write-line (strcat "N" (itoa (+ 60 gclinenum)) " M14") gcfile)
(write-line (strcat "N" (itoa (+ 70 gclinenum)) " G04U0.5") gcfile)
(write-line (strcat "N" (itoa (+ 80 gclinenum)) " M41") gcfile)
(write-line (strcat "N" (itoa (+ 90 gclinenum)) " M6") gcfile)
(write-line (strcat "N" (itoa (+ 100 gclinenum)) " M30") gcfile)))
(if (= "Warner-Swasey" gcmach)
(progn
(write-line (strcat "N" (itoa gclinenum) " G40") gcfile)
(write-line (strcat "N" (itoa (+ 10 gclinenum)) " G70 P090 Q" (if (< (+ 50 (* 10 listlength)) 100) "0" "") (itoa (fix (+ 50 (* 10 listlength))))) gcfile)
(write-line (strcat "N" (itoa (+ 20 gclinenum)) " G00X2.0Z1.0T0000") gcfile)
(write-line (strcat "N" (itoa (+ 30 gclinenum)) " M04S10") gcfile)
(write-line (strcat "N" (itoa (+ 40 gclinenum)) " G04U1.5") gcfile)
(write-line (strcat "N" (itoa (+ 50 gclinenum)) " M30") gcfile)))
(close gcfile)
(setq gcisopen nil)
;End portion
(princ "Finished.")
(setvar "clayer" gcoldlay)
(setvar "cecolor" gcoldcolor)
(setvar "osmode" gcoldsnap)
(command "undo" "end")
(command ".u")
(startapp "notepad.exe" gcfilepath)
(command "shell" "del c:\\g-code.txt")
(setq *error* errduh)
(setvar "cmdecho" echo)
(setvar "luprec" oldprec)
(setq gcfail 1.0)
(prin1)
);
; Below is a function that the above uses
(defun zerocut ( argh1 / req )
(if (= (- (* 100000 argh1) (fix (* 100000 argh1))) 0)
(setq req 5))
(if (= (- (* 10000 argh1) (fix (* 10000 argh1))) 0)
(setq req 4))
(if (= (- (* 1000 argh1) (fix (* 1000 argh1))) 0)
(setq req 3))
(if (= (- (* 100 argh1) (fix (* 100 argh1))) 0)
(setq req 2))
(if (= (- (* 10 argh1) (fix (* 10 argh1))) 0)
(setq req 1))
(setq argh1 (rtos argh1 2 req)))
(prin1)
(princ "\nG-Coder 0.9 Loaded.\n")
(prin1)

[WILLY]

whew....that's it. the only other text to be added was at the end of the acad file itself.

 
(load "//IBMS1/Engineering Machine/Borders/LISP/GCoder/gc.lsp")

i have duplicated the path on my system so it shoul be correct when opening acad....i.e. i have added this to my search path in "preferences"
i am new here and i hope i haven't stepped on the site admin's toes...if i have i do appolgize...but i have been using acad for about 18 years and this is REALLY BUGGING ME not to be able to get the application to run on my system...i must be off.
thanks in advance to all who have contributed..

[CAB]

Note that "gc" is a reserved word in that it is a function in LISP and should not be used because it over writes the gc function.

You may attach a file to your post. See the "Additional Options" below the edit window when you are adding your post.