;;;Note: This program is freeware. (Free to everyone at no cost) The code is open AutoLisp. ;;;If you would like to improve or add additional functions, you are free to do so as ;;;long as the modified code is made available to the world through the internet ;;;and by keeping this note in the code. ;;;Steve J. Lindsay www.LindsayEngraving.com www.AirGraver.com www.engravingschool.com www.engravingforum.com ;;;PS This used to be sold back in 2003 and was crippled as a demo until a user registered. It is now freeware. ;;;I have marked out the cripple demo portion so that it is fully functional. ;;;Thank you, Steve Lindsay www.LindsayEngraving.com ;;;July 23, 2003 gcode4.lsp has been modified from gcode3.lsp to allow ;;;the user to select more than one entity so that they will all be processed at once ;;;The Z rapid height is entered by the user but when putting the z back down I have set it ;;;at 0.000. This should be also included for the user to enter what height he wants to do the machining ;;;at. This update was done to polygcode as well as the autogcode function. ;(defun c:gcode ( / dcl_id run_again pdist) (defun c:gcode (/ dcl_id run_again pdist) ;(check_for_demo) ;(there is a global varible called "demo" in check_is_demo..check_for_demo is the only place it is changed. the check_for_demo funciton to see if this is a demo. T is yes nil is no (keep the variable demo as global as it is checked in the gcode functions ; I marked out the above line on 13 1999 because I couldn't get through my own password/demo stuff... (setvar "cmdecho" 0) ;Controls whether AutoCAD echoes prompts and input during the AutoLISP (command) function (setq run_ppgcode 1) ;set one of the funcions to a 1 just to get in the loop (setq pdist "0.010") ;default pdist is 0.010 (setq saved_toggle "0") (while (or (= run_poly_gcode 1) (= run_auto_gcode 1) (= run_ppgcode 1) (= run_reg 1) (= run_again T) ) (setq run_poly_gcode nil) (setq run_auto_gcode nil) (setq run_ppgcode nil) (setq run_reg nil) (setq run_ok_register nil) ;set these all back to nil again (setq run_again nil) (setq dcl_id (load_dialog "autogcode.dcl")) (if (not (new_dialog "toolpath_gcode_mainDialog" dcl_id)) (progn (princ "\nCannot open autogcode.dcl...Please find and place it in the autocad directory" ) (exit) ) ) (set_tile "auto_jog_distance" pdist);this keeps whatever was typed in the edit box there if it goes through this loop again ;(set_tile "toggle_vertexes" (itoa saved_dimed_jog)) (set_tile "toggle_vertexes" saved_toggle) ;save the toggle so it is the same (while going throug this loop) (mode_tile "auto_jog_distance" (atoi saved_toggle)) ;for the toggle of if the box is dimed or not (action_tile "cancel" " (done_dialog)") (action_tile "poly_gcode_ok" "(setq run_poly_gcode 1) (done_dialog) " ) (action_tile "auto_gcode_ok" "(setq run_auto_gcode 1) (done_dialog) " ) (action_tile "pp_gcode_ok" "(setq run_ppgcode 1) (done_dialog) " ) (action_tile "register_key" "(setq run_reg 1) (done_dialog) " ) (action_tile "auto_jog_distance" (strcat "(setq pdist (get_tile \"auto_jog_distance\"))") ) (action_tile "about" "(strings_to_dialogs \"about_string\") (setq run_again T) (done_dialog) " ) (action_tile "poly_gcode_help" "(strings_to_dialogs \"poly_help\") (setq run_again T) (done_dialog) " ) (action_tile "auto_gcode_help" "(strings_to_dialogs \"auto_help\") (setq run_again T) (done_dialog) " ) (action_tile "pp_gcode_help" "(strings_to_dialogs \"pp_help\") (setq run_again T) (done_dialog) " ) ;(action_tile "group_on" "(mode_tile \"group\" (- 1 (atoi $value)))") ;(action_tile "toggle_vertexes" "(mode_tile \"auto_jog_distance\" (atoi (get_tile \"toggle_vertexes\")))") ;(action_tile "toggle_vertexes" "(progn (mode_tile \"auto_jog_distance\" (atoi (get_tile \"toggle_vertexes\"))) (setq saved_toggle (get_tile \"toggle_vertexes\")))") (action_tile "toggle_vertexes" "(progn (mode_tile \"auto_jog_distance\" (atoi (get_tile \"toggle_vertexes\"))) (setq saved_toggle (get_tile \"toggle_vertexes\")))" ) ;(action_tile "toggle_vertexes" "(mode_tile \"auto_jog_distance\" (get_tile \"toggle_vertexes\")))") ;(action_tile "toggle_vertexes" " (mode_tile \"auto_jog_distance\" (atoi (get_tile \"toggle_vertexes\"))) (setq saved_ (get_tile \"toggle_vertexes\"))") ;(action_tile "toggle_vertexes" "(mode_tile \"auto_jog_distance\" (atoi (get_tile \"toggle_vertexes\"))) ") ;(setq save_toggle (atoi (get_tile \"toggle_vertexes\"))) (setq save_dimed_jog saved_toggle) ") (start_dialog) (unload_dialog dcl_id) (if (= run_poly_gcode 1) (poly_gcode) ) (if (= run_auto_gcode 1) (progn (if (= saved_toggle "1") (setq n_or_v "V") ) (if (= saved_toggle "0") (setq n_or_v "N") ) (auto_gcode n_or_v (atof pdist)) ) ) ;start auto_gcode and pass the point to point distance to it (this came from the auto_jog_distance user input box) (atof turns it in to a real number) (if (= run_ppgcode 1) (ppgcode) ) (if (= run_reg 1) (reg_dialog) ) ;RUN THE REG DIALOG BOX ) ;end of loop (setq demo nil) ;set the global varible back to nil before leaving (setvar "cmdecho" 1) (princ "\nType GCODE at any time to run Tool Path GCode...") ;this will print out when the gcode.arx is loaded letting the user know how to start the thing (princ) ) (defun reg_dialog (/ dcl_id) (setq run_reg_info 1) ;set one of the actions to 1 just to get in the loop (while (or (= run_reg_info 1) (= run_ok_register 1)) ;BRING THIS DIALOG BACK UP IF ANY OF THESE ARE SET TO 1 (setq run_reg_info nil) (setq run_ok_register nil) (setq dcl_id (load_dialog "autogcode.dcl")) (if (not (new_dialog "register_dialog" dcl_id)) (progn (princ "\nCannot open autogcode.dcl...Please find and place it in the autocad directory" ) (exit) ) ) (action_tile "cancel" " (done_dialog)") (action_tile "ok" "(setq run_ok_register 1) (done_dialog) ") (action_tile "email_key" (strcat "(setq email (get_tile \"email_key\"))") ) ;whatever is typed in these two boxes will be stored in email and password (action_tile "password_key" (strcat "(setq password (get_tile \"password_key\"))") ) (action_tile "reg_info" "(setq run_reg_info 1) (done_dialog) " ) (start_dialog) (unload_dialog dcl_id) (if (= run_ok_register 1) (ok_register email password) ) ;try and register with ok_register function... email and password to ok_register (if (= run_reg_info 1) (strings_to_dialogs "reg_info_string") ) ) ;END OF WHILE LOOP ) (defun auto_gcode (quest pdist / show_cnt demo_cnt Z_clearance Z_cutdepth ename ent sset the_selection ssetnum filename checkfile Ncount count xstring ystring zstring string 3d info temp vertex vertexlist is_it_closed firstvertex how_many_cuts) (setq demo_cnt 0) ;counter for limiting demo (setq show_cnt 0) ; for showing how many gcodes were written to the file (show for show off) (setvar "cmdecho" 0) ;Controls whether AutoCAD echoes prompts and input during the AutoLISP (command) function (initget 1 "Y N") ;this is for the getkword below. getkword will only accept Y or N (setq 3d (getkword "\nWould you like the Z coordinates included? (Y or N) ")) (setq Z_clearance (getdist "\nEnter a Z hight for rapiding between cuts: ")) (setq Z_cutdepth (getdist "\nEnter a Z depth of cut for machining: ")) ;(initget 1 "V N") ;this is for the getkword below. getkword will only accept V or N ;(setq quest (getkword "Use the 'V'ertexes that already exist for jog points or make 'N'ew ones? (V or N) ")) (if (= quest "V") (progn ;if the user wants to use the current vertexes ;(setq vertexlist (get_vertexes) ) ;use the homemade get_vertexes function (initget 1 "N A") ;this is for the getkword below. getkword will only accept Y or N (setq new_or_append (getkword "\nCreate a New Gcode file or Append an existing one? ('N' 'A') ")) (if (= new_or_append "N") (progn ;if a new file (setq filename (getfiled "Create a New Gcode File" ".." "*" 1)) (setq filename (open filename "w")) ;open a new file for writing. (setq Ncount "100"))) (if (= new_or_append "A") (progn ;if we are appending (setq filename (getfiled "Select an Existing Gcode File to Append" ".." "*" 0)) (setq Ncount (last_gcode_num filename)) ;use homemade funtion to find what the last gcode number was in the file (setq filename (open filename "a")) ;open it for appending and mark the spot in the file (princ "Marking spot in file with 'appended here'") (write-line "(appended here)" filename))) ;the () around "appended here" also gets written to the file (setq N_cnt (atoi Ncount)) ;turn the string into a interger number for later adding 5 to. ;*******************88 ;(while (= nil (setq ename (car (entsel "\nSelect a pline, spline or 3dpoly"))) )) (setq the_selection (ssget)) (setq how_many_cuts (sslength the_selection)) ;find out how many points are in the selection set (store in how_many_cuts) (setq cut_count 0) (while (/= cut_count how_many_cuts) ;loop as many times as there are objects in the selection set (how_many_cuts) (setq vertexlist nil) (setq ename (ssname the_selection cut_count)) ;extracts selection object name (store name in ename) (setq cut_count (+ cut_count 1)) (setq info (entget ename)) ;lots and all of the info list about the entity (stored in a "dotted pair" list) (setq is_it_closed (cdr (assoc 70 info))) ;assoc 70 tells if it is an open or closed entity (later on if it is closed we will write copy the first vertex and make it last too (to complete the closed circle) (foreach temp info (setq temp (list temp (cons 1101 "junk"))) ;this adds the assoc number 1101. "junk" to the list with whatever the other assoc happens to be in there. This is done so I can use assoc on the list as it has to have more than one assoc in it. (if (/= (assoc 10 temp) nil) (progn ;if assoc 10 is in the list do this (setq vertex (cdr(assoc 10 temp))) ;now get the vertex (because we found one since assoc 10 is a vertex) (setq vertexlist (append vertexlist (list vertex))))) ;now add it to the collection of vertexes ) ;(if (= is_it_closed 11) (progn ;if it is a closed entity (with a closed spline the first is already last without this (I don't know why but it won't hurt it will just be at the end with the same two gcodes in a row ;11, 9 and 1 are what the group codes that means it is closed (they go to 3dpline, pline, spline) if it is a closed entity (with a closed spline the first is already last without this.. ;I don't know why but it won't hurt it will just be at the end with the same two gcodes in a row (if (or (= is_it_closed 11) (= is_it_closed 9) (= is_it_closed 1))(progn (setq firstvertex (car vertexlist)) ;//these two lines add the first point to the end of the vertexlist to make a complete around the polyline (setq vertexlist (append vertexlist (list firstvertex))))) ;******************* (setq count 0) (foreach point vertexlist (setq count (+ count 1)) (setq N_cnt (+ N_cnt 5)) ;add 5 to the Nnumber counter (used to number the gcodes) (setq xstring (rtos (car point) 2 4)) ;extract and convert the real number (x cordinate) to a string (so it can be written to a file) (setq ystring (rtos (cadr point) 2 4)) ;extract and convert the real number (y cordinate) to a string (so it can be written to a file) (if (= (length point) 3) ;see if the z cordinate is even there (setq zstring (rtos (caddr point) 2 4))) ;extract and convert the real number (z cordinate) to a string (so it can be written to a file) (if (= (length point) 2) (setq zstring "0.0000")) ;if there are only x and y in the point info then make up one to use (setq Ncount (rtos N_cnt 2 0)) ;count N number for counting in the gcode file (if (= 3d "Y") (setq string (strcat "N" Ncount " X" xstring " Y" ystring " Z" zstring))) ;3d..put it all together in a string (if (= 3d "N") (setq string (strcat "N" Ncount " X" xstring " Y" ystring))) ;2d..put it all together in a string (setq show_cnt (+ show_cnt 1)) (if (= count 1) (progn ;if the first time through we will rapid to the next point above the surface (setq string " ") (write-line string filename) ;do a space and return for a new cut so the gcode is easier to see what cut to the next (setq zstring (rtos Z_clearance 2 4)) (setq Ncount (rtos N_cnt 2 0)) ;count N number for counting in the gcode file (setq string (strcat "N" Ncount " Z" zstring)) (write-line string filename) (setq xstring (rtos (car point) 2 4)) ;extract and convert the real number (x cordinate) to a string (so it can be written to a file) (setq ystring (rtos (cadr point) 2 4)) ;extract and convert the real number (y cordinate) to a string (so it can be written to a file) (setq string (strcat "N" Ncount " X" xstring " Y" ystring)) (write-line string filename) ;2d..put it all together in a string (setq zstring (rtos Z_cutdepth 2 4)) (setq string (strcat "N" Ncount " Z" zstring)) ;(write-line string filename) ;set the z back down to zero. You should make this users selectable so that if he told it not to do 3d he could still set the -z distance during cutting )) (write-line string filename) ;(if (= demo T) (if (< demo_cnt 11) (progn (write-line string filename) (setq demo_cnt (+ demo_cnt 1)) )) ) ;;;if a demo write only 20 lines to the file....write the string to the file ;(if (= demo nil) (write-line string filename)) ;if not a demo write all the strings to the file ) ;end of foreach loop );end of going through all the selection set while loop (close filename) )) ;end of progn and if "end of if user wanted to use the existing vertexes" (if (= quest "N") (progn ;if user wants to make new points to use ;(while (= nil (setq ename (car (entsel "\nSelect a pline, spline or 3dpoly"))) )) ;prompt user to select an object and get the name (initget 1 "N A") ;this is for the getkword below. getkword will only accept Y or N (setq new_or_append (getkword "\nCreate a New Gcode file or Append an existing one? ('N' 'A') ")) (if (= new_or_append "N") (progn ;if a new file (setq filename (getfiled "Create a New Gcode File" ".." "*" 1)) (setq filename (open filename "w")) ;open a new file for writing. (setq Ncount "100"))) (if (= new_or_append "A") (progn ;if we are appending (setq filename (getfiled "Select an Existing Gcode File to Append" ".." "*" 0)) (setq Ncount (last_gcode_num filename)) ;use homemade funtion to find what the last gcode number was in the file (setq filename (open filename "a")) ;open it for appending and mark the spot in the file (princ "Marking spot in file with 'appended here'") (write-line "(appended here)" filename))) ;the () around "appended here" also gets written to the file (setq the_selection (ssget)) (setq how_many_cuts (sslength the_selection)) ;find out how many points are in the selection set (store in how_many_cuts) (setq cut_count 0) (while (/= cut_count how_many_cuts) ;loop as many times as there are objects in the selection set (how_many_cuts) (setq ename (ssname the_selection cut_count)) ;extracts selection object name (store name in ename) (setq cut_count (+ cut_count 1)) (command "measure" ename pdist) ;use measure to find points around toolpath (setq sset (ssget "P")) ;select all the points just made with measure (store in sset) (setq ssetnum (sslength sset)) ;find out how many points are in the selection set (store in ssetnum) (setq N_cnt (atoi Ncount)) ;turn the string into a interger number for later adding 5 to. (setq is_it_closed (cdr (assoc 70 (entget ename)))) ;assoc 70 tells if it is an open or closed entity later on if it is closed we will write copy the first vertex and make it last too ..to complete the closed circle.. (setq count 0) (while (/= count ssetnum) ;loop as many times as there are objects in the selection set (sset) (setq ent (ssname sset count)) ;extracts selection object name (store name in ent) (setq count (+ 1 count)) ;add 1 to the counter (setq N_cnt (+ N_cnt 5)) ;add 5 to the Nnumber counter (setq point (cdr(assoc 10(entget ent)))) ;extract the xyz from the object (store in point) (setq xstring (rtos (car point) 2 4)) ;extract and convert the real number (x cordinate) to a string (so it can be written to a file) (setq ystring (rtos (cadr point) 2 4)) ;extract and convert the real number (y cordinate) to a string (so it can be written to a file) (setq zstring (rtos (caddr point) 2 4)) ;extract and convert the real number (z cordinate) to a string (so it can be written to a file) (setq Ncount (rtos N_cnt 2 0)) ;count N number for counting in the gcode file (if (= 3d "Y") (setq string (strcat "N" Ncount " X" xstring " Y" ystring " Z" zstring))) ;3d..put it all together in a string (if (= 3d "N") (setq string (strcat "N" Ncount " X" xstring " Y" ystring))) ;2d..put it all together in a string (setq show_cnt (+ show_cnt 1)) (if (= count 1) (progn ;if the first time through we will rapid to the next point above the surface (setq string " ") (write-line string filename) ;do a space and return for a new cut so the gcode is easier to see what cut to the next (setq zstring (rtos Z_clearance 2 4)) (setq Ncount (rtos N_cnt 2 0)) ;count N number for counting in the gcode file (setq string (strcat "N" Ncount " Z" zstring)) (write-line string filename) (setq xstring (rtos (car point) 2 4)) ;extract and convert the real number (x cordinate) to a string (so it can be written to a file) (setq ystring (rtos (cadr point) 2 4)) ;extract and convert the real number (y cordinate) to a string (so it can be written to a file) (setq string (strcat "N" Ncount " X" xstring " Y" ystring)) (write-line string filename) ;2d..put it all together in a string ;(setq string (strcat "N" Ncount " Z" Z_cutdepth)) ;(write-line string filename) ;set the z back down to zero. You should make this users selectable so that if he told it not to do 3d he could still set the -z distance during cutting (setq zstring (rtos Z_cutdepth 2 4)) (setq string (strcat "N" Ncount " Z" zstring)) ;(write-line string filename) ;set the z back down to zero. You should make this users selectable so that if he told it not to do 3d he could still set the -z distance during cutting )) (write-line string filename) ;(if (= demo T) (if (< demo_cnt 21) (progn (write-line string filename) (setq demo_cnt (+ demo_cnt 1)) )) ) ;;;if a demo write only 20 lines to the file....write the string to the file ;(if (= demo nil) (write-line string filename)) ;if not a demo write all the strings to the file (if (= count ssetnum) ;if this is the last time through (if (or (= is_it_closed 11) (= is_it_closed 9) (= is_it_closed 1))(progn ;if this is a closed entity...11,9 and 1 are the different group codes from pline,spline and 3dpoly (setq ent (ssname sset 0)) ;extracts selection object name (store name in ent) (0 is the first selection of the set) (setq point (cdr(assoc 10(entget ent)))) ;extract the xyz from the object (store in point) (setq xstring (rtos (car point) 2 4)) ;extract and convert the real number (x cordinate) to a string (so it can be written to a file) (setq ystring (rtos (cadr point) 2 4)) ;extract and convert the real number (y cordinate) to a string (so it can be written to a file) (setq zstring (rtos (caddr point) 2 4)) ;extract and convert the real number (z cordinate) to a string (so it can be written to a file) (setq N_cnt (+ N_cnt 5)) ;add 5 to the Nnumber counter (setq Ncount (rtos N_cnt 2 0)) ;count N number for counting in the gcode file (if (= 3d "Y") (setq string (strcat "N" Ncount " X" xstring " Y" ystring " Z" zstring))) ;3d..put it all together in a string (if (= 3d "N") (setq string (strcat "N" Ncount " X" xstring " Y" ystring))) ;2d..put it all together in a string (write-line string filename) )) ;write this last string to the file if it is a closed poly ) ;end of if = count ssetnum ) (command "erase" sset "") ) (close filename) ;(command "erase" sset "") )) ;end of progn and if ;end of while loop (show_results demo_cnt show_cnt) ) ;end of defun c:autogcode ;------------------------------------------------------------ (defun ppgcode (/ store_blipmode filename checkfile count currentgcode count pt Ncount xstring ystring zstring string whats_up keep_point) (setq store_blipmode (getvar "blipmode")) ;store blipmode setting so it can be put back at end of program (setvar "blipmode" 1) (setvar "cmdecho" 0) ;Controls whether AutoCAD echoes prompts and input during the AutoLISP (command) function (setq show_cnt 0) (setq demo_cnt 0) (initget 1 "N A") ;this is for the getkword below. getkword will only accept Y or N (setq new_or_append (getkword "\nCreate a New Gcode file or Append an existing one? ('N' 'A') ")) (if (= new_or_append "N") (progn ;if a new file (setq filename (getfiled "Create a New Gcode File" ".." "*" 1)) (setq filename (open filename "w")) ;open a new file for writing. (setq Ncount "100"))) (if (= new_or_append "A") (progn ;if we are appending (setq filename (getfiled "Select an Existing Gcode File to Append" ".." "*" 0)) (setq Ncount (last_gcode_num filename)) ;use homemade funtion to find what the last gcode number was in the file (setq filename (open filename "a")) ;open it for appending and mark the spot in the file (princ "Marking spot in file with 'appended here'") (write-line "(appended here)" filename))) ;the () around "appended here" also gets written to the file (setq N_cnt (atoi Ncount)) ;turn the string into a interger number for later adding 5 to. ;;;(setq filename (getstring "Enter filename: ")) ;can enter a drive/directory and file name if the user wants... if just a file name is given it will go into the acad directory ;;;(setq checkfile (findfile filename)) ;check and see if this file already exist ;;;(if (= checkfile nil) ;if file does not exist ;;; (setq filename (open filename "w"))) ;open a new file for writing. ;;;(if (/= checkfile nil) (progn ;if the file does exist ;;; (setq filename (open filename "a")) ;open it for appending and mark the spot in the file ;;; (princ "\nFile already exists...Marking spot in file with 'appended here'") ;;; (write-line "(appended here)" filename) ;;; (setq count (getstring "\nEnter Gcode N number to begin the counting for this append: ")) ;;; (setq count (atoi count)))) ;turn the string into a interger number for later adding 5 to. (setq currentgcode (getstring "Enter Gcode command to use: ")) (write-line currentgcode filename) ;this will write in the file the string (g code )just like the user entered in so it could be really any text they want to enter (if (= count nil) (setq count 0)) ;find out if this is an appended file and if not start the counting from 0 (princ "\nSelect points in the order and direction of toolpath\n") (setq pt 1) ;set pt (point) to something so you can get into the while loop (setq pt (getpoint " ...Pick point...or Enter to end or change Gcode command ")) ;this will get the first point..in the below loop the getpoint uses a rubberband from the last pt (while (/= pt nil) ;while pt is not equal to nil do this (setq count (+ count 5)) ;count by 5s for the gcode N number (princ "\n") (princ currentgcode) (setq keep_point pt) ;store a backup of the last pt for the if (= pt nil) below (setq pt (getpoint pt " ...Pick point...or Enter to end or change Gcode command ")) (if (/= pt nil) (progn ;if the user picked a point... do this otherwise the loop will go to the (if equal to nil) (setq Ncount (rtos count 2 0)) ;turn the count into a string and store it in Ncount (setq xstring (rtos (car pt) 2 4)) ;extract and convert the real number (x cordinate) to a string (so it can be written to a file) (setq ystring (rtos (cadr pt) 2 4)) ;extract and convert the real number (y cordinate) to a string (so it can be written to a file) (setq zstring (rtos (caddr pt) 2 4)) ;extract and convert the real number (z cordinate) to a string (so it can be written to a file) (setq string (strcat "N" Ncount " X" xstring " Y" ystring " Z" zstring)) ;put it all together in a string (setq show_cnt (+ show_cnt 1)) (write-line string filename) ;(if (= demo T) (if (< demo_cnt 11) (progn (write-line string filename) (setq demo_cnt (+ demo_cnt 1)) )) ) ;;;if a demo write only 20 lines to the file....write the string to the file ;(if (= demo nil) (write-line string filename)) ;if not a demo write all the strings to the file )) ;(write-line string filename))) (if (= pt nil) (progn ;the user hit enter and it retured nil (setq whats_up (getstring "\n Type in new Gcode or Enter to end: ")) ;find out what is up..does he want a new gcode or does he want to quit (if (/= whats_up "") (progn (setq currentgcode whats_up) ;store what was typed in currentgcode (write-line currentgcode filename) ;if he typed something (hopefully a gcode command) write it to the file (setq pt keep_point))))) ;set pt back to anything other than nil to stay in the loop ) ;end the while loop (close filename) (show_results demo_cnt show_cnt) ;show what was done (setvar "blipmode" store_blipmode) ;set blipmode back like it was ) ;----------------------------------------------------------- (defun get_vertexes ( / ename is_it_closed temp vertex vertexlist firstvertex info) ;(setq info2 (entget (car (entsel)))) ;lots and all of the info list about the entity (stored in a "dotted pair" list) (while (= nil (setq ename (car (entsel "\nSelect a pline, spline or 3dpoly"))) )) (setq info (entget ename)) ;lots and all of the info list about the entity (stored in a "dotted pair" list) (setq is_it_closed (cdr (assoc 70 info))) ;assoc 70 tells if it is an open or closed entity (later on if it is closed we will write copy the first vertex and make it last too (to complete the closed circle) (foreach temp info (setq temp (list temp (cons 1101 "junk"))) ;this adds the assoc number 1101. "junk" to the list with whatever the other assoc happens to be in there. This is done so I can use assoc on the list as it has to have more than one assoc in it. (if (/= (assoc 10 temp) nil) (progn ;if assoc 10 is in the list do this (setq vertex (cdr(assoc 10 temp))) ;now get the vertex (because we found one since assoc 10 is a vertex) (setq vertexlist (append vertexlist (list vertex))))) ;now add it to the collection of vertexes ) ;(if (= is_it_closed 11) (progn ;if it is a closed entity (with a closed spline the first is already last without this (I don't know why but it won't hurt it will just be at the end with the same two gcodes in a row ;11, 9 and 1 are what the group codes that means it is closed (they go to 3dpline, pline, spline) if it is a closed entity (with a closed spline the first is already last without this.. ;I don't know why but it won't hurt it will just be at the end with the same two gcodes in a row (if (or (= is_it_closed 11) (= is_it_closed 9) (= is_it_closed 1))(progn (setq firstvertex (car vertexlist)) ;//these two lines add the first point to the end of the vertexlist to make a complete around the polyline (setq vertexlist (append vertexlist (list firstvertex))))) vertexlist ;returns vertexlist ) ;________________________________________________________ ;;;write gcode to a file from selecting a polyline made up of arcs. ;;;get entity name. ;;;explode the entity ;;;select all the new arcs that have been made from the explode ;;;loop thought the selection set writing a gcode command for each arc. ;;;to do the this use the "command id" and "cen" to find the center of each arc. ;;;Radians measure angles from 0 to 2 * p (pi). (so in degress 0=0 and 360=(2*PI)) (defun poly_gcode (/ ename info vertexlist pdist sset Z_cutdepth filename checkfile Ncount first_time_loop ent arc_or_line center_of_arc info_arc start_angle end_angle radius_length half_arc_angle test_it_point check_sset been_here count what_is_it show_cnt demo_cnt) ;(setq ssetnum (sslength sset)) ;find out how many arcs are in the selection set (store in ssetnum) (used later in the loop) ;(setq filename (getstring "Enter filename: ")) ;can enter a drive/directory and file name if the user wants... if just a file name is given it will go into the acad directory (setq show_cnt 0) (setq demo_cnt 0) ;(while (= nil (setq ename (car (entsel "\nPlease select a polyline..."))) )) ;prompt user to select an object and get the name (initget 1 "N A") ;this is for the getkword below. getkword will only accept A or N (setq new_or_append (getkword "\nCreate a New Gcode file or Append an existing one? ('N' 'A') ")) ;(setq checkfile (findfile filename)) (if (= new_or_append "N") (progn ;if a new file ;(if (= checkfile nil) (progn ;if file does not exist (setq filename (getfiled "Create a New Gcode File" ".." "*" 1)) (setq filename (open filename "w")) ;open a new file for writing. ;(setq Ncount (getstring "\nEnter Gcode N number to begin counting...numbers only please...") (setq Ncount "100"))) (if (= new_or_append "A") (progn ;if we are appending ;(if (/= checkfile nil) (progn ;if the file does exist (setq filename (getfiled "Select an Existing Gcode File to Append" ".." "*" 0)) (setq Ncount (last_gcode_num filename)) ;use homemade funtion to find what the last gcode number was in the file (setq filename (open filename "a")) ;open it for appending and mark the spot in the file (princ "\nMarking spot in file with 'appended here'") (write-line "(appended here)" filename))) ;the () around "appended here" also gets written to the file (setq Z_clearance (getdist "\nEnter a Z hight for rapiding between cuts: ")) (setq Z_cutdepth (getdist "\nEnter a Z depth of cut for machining: ")) (setq the_selection (ssget)) (setq how_many_cuts (sslength the_selection)) ;find out how many points are in the selection set (store in how_many_cuts) ;(setq what_is_it (cdr(assoc 0(entget ename)))) ;(setq ename (ssname the_selection cut_count)) (setq cut_count 0) (while (/= cut_count how_many_cuts) ;loop as many times as there are objects in the selection set (how_many_cuts) (setq ename (ssname the_selection cut_count)) ;extracts selection object name (store name in ename) (setq cut_count (+ cut_count 1)) (setq info (entget ename)) ;lots and all of the info list about the entity (stored in a "dotted pair" list) ;(setq info (entget ename)) ;(setq what_is_it (cdr(assoc 0(entget ename)))) ;(if (/= what_is_it "LWPOLYLINE") (alert "Sorry...Currently Poly Gcode works only with AutoCAD 14 new polylines \"lwpolyline\"") ) ;the other end of the below "if" goes all the way to the end of this function ;(if (= what_is_it "LWPOLYLINE") (progn ;other end of this if is at the end of this function (setq N_cnt (atoi Ncount)) ;turn the string into a interger number for later adding 5 to. ;(setq ename (car (entsel))) ;prompt user to select an object and get the name ;(setq info (entget ename)) ;get lots of info about the entity (setq vertexlist (find_vertexes info)) ;use the homemade find_vertexes function to get and store all vertexs in vertexlist (command "explode" ename pdist) ;use explode to explode the polyline into arcs (setq sset (ssget "P")) ;select all the arcs just made with explode (store in sset) ;-------------------------------------------------;reverse the selections set and vertex list in case we want to cnc the other direction (setq count (- (sslength sset) 1)) ;find how many are in the selection set and store it in count (setq reversed_sset (ssadd)) (while (/= count -1) (setq ent (ssname sset count)) ;get the ent at counter position and store in ent (setq count (- count 1)) ;subtract 1 from counter (setq reversed_sset (ssadd ent reversed_sset)) ;making a new reversed selection set ) ;;;(initget 1 "Y N") ;;;(setq reverse_or_not (getkword "\nDo you want the cnc jog direction to be reversed from what the polyline was created? ('Y' 'N') ")) ;;;(if (= reverse_or_not "Y") (progn ;;; (setq sset reversed_sset) ;set sset to the reversed_sset if we are going backwords ;;; (setq vertexlist (reverse vertexlist)) )) ;reverse the vertexlist too ;;;;---------------------------------------------------- ;end of the reversing function stuff (setq count 0) (setq first_time_loop nil) ;(while (/= count ssetnum) ;loop as many times as there are objects in the selection set (sset) (foreach point vertexlist (if (= first_time_loop T) (progn ;only go in here if this is the 2nd or more times though (setq endpoint point) ;get the endpoint now (setq ent (ssname sset count)) ;extracts selection object name (store name in ent) (setq count (+ 1 count)) ;add 1 to the counter (setq N_cnt (+ N_cnt 5)) ;add 5 to the Nnumber counter (setq arc_or_line (cdr(assoc 0(entget ent)))) ;find out if this is a line or arc. (if (= arc_or_line "LINE") (progn ;if it is a arc do this (setq xstring (rtos (car endpoint) 2 4)) ;extract and convert the real number (x cordinate) to a string (so it can be written to a file) (setq ystring (rtos (cadr endpoint) 2 4)) ;extract and convert the real number (y cordinate) to a string (so it can be written to a file) (setq Ncount (rtos N_cnt 2 0)) ;turn the count into a string and store it in Ncount (setq string (strcat "N" Ncount " G01 X" xstring " Y" ystring)) ;need to write a g01 or g00 first so the g02 and g03 know where to come from for the first arc ;(write-line string filename) )) ;write the string to the file (setq show_cnt (+ show_cnt 1)) (write-line string filename) ;(if (= demo T) (if (< demo_cnt 11) (progn (write-line string filename) (setq demo_cnt (+ demo_cnt 1)) )) ) ;;;if a demo write only 20 lines to the file....write the string to the file ;(if (= demo nil) (write-line string filename)) ;if not a demo write all the strings to the file )) (if (= arc_or_line "ARC") (progn ;if it is a arc do this (setq center_of_arc (cdr(assoc 10(entget ent)))) ;group 10 holds the center id of the arc (setq info_arc (entget ent)) ;info_arc is for debugging (remove it later) ;where i cut a bunch of old stuff out (setq start_angle (RTD (cdr(assoc 50(entget ent))))) ;find the start angle of the arc (ent) (setq end_angle (RTD (cdr(assoc 51(entget ent))))) (setq radius_length (cdr(assoc 40(entget ent)))) ;(setq firstpoint (find_point_on_arc radius_length start_angle center_of_arc)) ;use the homemade find point on arc (start vertex of the arc) ;(setq endpoint (find_point_on_arc radius_length end_angle center_of_arc)) ;use the homemade find point on arc (end vertex of the arc) (setq half_arc_angle (+(- 360 start_angle) end_angle)) (if (> half_arc_angle 360) (setq half_arc_angle (- half_arc_angle 360))) ;this now holds the full angle of the arc (setq half_arc_angle (/ half_arc_angle 2)) ;divide it in half (setq half_arc_angle (- end_angle half_arc_angle )) ;this puts it in relation to where it is measure from (ucs) (if (< half_arc_angle 0) (setq half_arc_angle (+ half_arc_angle 360))) ;this now holds a direction that points to exactly half (mid point) of the arc (it could be pointing 180 of where it should be though...test it) (setq test_it_point (find_point_on_arc radius_length half_arc_angle center_of_arc)) ;use the homemade find point on arc command (setq check_sset (ssget test_it_point)) ;use this to select the arc to see if it is there (if (/= check_sset nil) (setq check_ename (ssname check_sset 0))) ;if not nil get the name of what the above line selected (if (= (cdr(assoc 0(entget ent))) "ARC") (setq check_center (cdr(assoc 10(entget ent))))) ;group 10 holds the center point (use this to test against the center_of_arc that we know is right to make sure we have the correct entity) this will return T if so (if (and(/= (car check_center) (car center_of_arc)) (/=(cadr check_center) (cadr center_of_arc))) (progn ;see if this arc center is the same as the original to make sure we have the same one ;(setq been_here 1) (setq half_arc_angle (+ 180 half_arc_angle)) ;change the direction 180 and see if it is over there (setq test_it_point (find_point_on_arc radius_length half_arc_angle center_of_arc)) ;use the homemade find point on arc command (setq check_sset (ssget test_it_point)) ;use this to select the arc to see if it is there (if (/= check_sset nil) (setq check_ename (ssname check_sset 0))) ;if not nil get the name of what the above line selected (if (= (cdr(assoc 0(entget ent))) "ARC") (setq check_center (cdr(assoc 10(entget ent))))) ;the is the same line right above the current "if" (if (and(/= (car check_center) (car center_of_arc)) (/=(cadr check_center) (cadr center_of_arc))) (princ "\nThis program is lost..ESC out")))) (setq check_sset nil) ;set this to nil otherwise a new sset will be made each time in this loop (setq mid_point test_it_point) ;it should now have the mid point on the arc so store it here (setq cw (cw_or_ccw mid_point endpoint center_of_arc)) ;use the homemade cw_or_ccw funciton to see which way we are going T is cw and nil is ccw (if (= cw T) (setq gcode "G02")) (if (= cw nil) (setq gcode "G03")) (setq xcenter (- (car center_of_arc) (car firstpoint))) ;subtracts x cordinates from firstpoint minus center_of_arc (distance in x from firstpoint to center) (setq ycenter (- (cadr center_of_arc) (cadr firstpoint))) ;subtracts y cordinates from firstpoint minus center_of_arc (setq xcenterstring (rtos xcenter 2 4)) (setq ycenterstring (rtos ycenter 2 4)) (setq xstring (rtos (car endpoint) 2 4)) ;extract and convert the real number (x cordinate) to a string (so it can be written to a file) (setq ystring (rtos (cadr endpoint) 2 4)) ;extract and convert the real number (y cordinate) to a string (so it can be written to a file) (setq Ncount (rtos N_cnt 2 0)) ;turn the count into a string and store it in Ncount (setq string (strcat "N" Ncount " " gcode " X" xstring " Y" ystring " I" xcenterstring " J" ycenterstring)) ;(write-line string filename) ;write the string to the file (setq show_cnt (+ show_cnt 1)) (write-line string filename) ;(if (= demo T) (if (< demo_cnt 11) (progn (write-line string filename) (setq demo_cnt (+ demo_cnt 1)) )) ) ;;;if a demo write only 20 lines to the file....write the string to the file ;(if (= demo nil) (write-line string filename)) ;if not a demo write all the strings to the file )) ;end of progn and "if" it is an arc )) ;end of progn and "if" this is not the first time though (if (= first_time_loop T) (progn (setq firstpoint endpoint))) ;put the first as now the last to be ready for next time in foreach loop (if (/= first_time_loop T) (progn ;if this is the first time through ;*****************start of what I added to rapid to the next cut (setq string " ") (write-line string filename) ;do a space and return for a new cut so the gcode is easier to see what cut to the next (setq zstring (rtos Z_clearance 2 4)) (setq Ncount (rtos N_cnt 2 0)) ;count N number for counting in the gcode file (setq string (strcat "N" Ncount " Z" zstring)) (write-line string filename) (setq xstring (rtos (car point) 2 4)) ;extract and convert the real number (x cordinate) to a string (so it can be written to a file) (setq ystring (rtos (cadr point) 2 4)) ;extract and convert the real number (y cordinate) to a string (so it can be written to a file) (setq zstring (rtos Z_cutdepth 2 4)) (setq string (strcat "N" Ncount " G00 X" xstring " Y" ystring)) (write-line string filename) ;2d..put it all together in a string (setq string (strcat "N" Ncount " Z" zstring)) (write-line string filename) ;set the z back down to zero. You should make this users selectable so that if he told it not to do 3d he could still set the -z distance during cutting ;********************end of what I added to rapid to the next cut (setq firstpoint point) (setq first_time_loop T) ;let the foreach loop know it has been though once. (setq xstring (rtos (car firstpoint) 2 4)) ;extract and convert the real number (x cordinate) to a string (so it can be written to a file) (setq ystring (rtos (cadr firstpoint) 2 4)) ;extract and convert the real number (y cordinate) to a string (so it can be written to a file) (setq Ncount (rtos N_cnt 2 0)) ;turn the count into a string and store it in Ncount (setq string (strcat "N" Ncount " G01 X" xstring " Y" ystring)) ;need to write a g01 or g00 first so the g02 and g03 know where to come from for the first arc (write-line string filename) )) ;write the string to the file );end of foreach (command "U") ;undo the explode so the arcs are back together and a polyline again );end of while loop for the selection set (close filename) (show_results demo_cnt show_cnt) ;show what was done ;)) ;this is the end of if and progn from "IF" this is a LWPOLYLINE (from clear back at the start of poly gcode) (about the 5th line into it) ) ;;;;;------------------------------------------------------------------------------ ; funtion to Convert value in radians to degrees ;;;Radians measure angles from 0 to 2 * p (pi). (so in degress 0=0 and 360=(2*PI)) (defun RTD (r) (/(* 360 r) (* pi 2)) ) ;;;;;------------------------------------------------------------------------------ ; funtion to Convert value in degrees to radians (defun DTR (d) (/(* d (* pi 2)) 360) ) ;;;;;------------------------------------------------------------------------------ ;;;;function that will return a vertex point lieing on an arc ;;;given input of (angle out from center of arc that crosses point, the radius and center of the arc are needed) (defun find_point_on_arc (radius center_to_point_angle center_of_arc / a b x y point) (setq center_to_point_angle (DTR center_to_point_angle)) ;use the homemade DTR to turn degrees to radians (setq b (* radius (cos center_to_point_angle))) ;a little trig to find the length of a leg (setq a (* radius (sin center_to_point_angle))) (setq x (+ (car center_of_arc) b)) ;add on the x direction (from ucs 0,0 to where center of arc is) (setq y (+ (cadr center_of_arc) a)) (setq point (list x y)) ;this is the point wanted (it will return to what called it) ) ;this will loop through a dotted pair list (info) and extract all the assoc 10s (the vertexes) and store them in vertexlist (defun find_vertexes (info / is_it_closed temp vertex vertexlist firstvertex) ;(setq info (entget (car (entsel)))) ;lots and all of the info list about the entity (stored in a "dotted pair" list) (setq is_it_closed (cdr (assoc 70 info))) ;assoc 70 tells if it is an open or closed entity (later on if it is closed we will write copy the first vertex and make it last too (to complete the closed circle) (foreach temp info (setq temp (list temp (cons 1101 "junk"))) ;this adds the assoc number 1101. "junk" to the list with whatever the other assoc happens to be in there. This is done so I can use assoc on the list as it has to have more than one assoc in it. (if (/= (assoc 10 temp) nil) (progn ;if assoc 10 is in the list do this (setq vertex (cdr(assoc 10 temp))) ;now get the vertex (because we found one since assoc 10 is a vertex) (setq vertexlist (append vertexlist (list vertex))))) ;now add it to the collection of vertexes ) (if (or (= is_it_closed 11) (= is_it_closed 9) (= is_it_closed 1))(progn (setq firstvertex (car vertexlist)) ;//these two lines add the first point to the end of the vertexlist to make a complete around the polyline (setq vertexlist (append vertexlist (list firstvertex))))) vertexlist ;return the vertexlist to the function that called it ) ;;;----------------------------------------------------------------------- ;will find if it is going cw or ccw ;it will get the two angles and uses whatever direction_cm ;is for a number to subract from each. this will take direction_cm ;to zero and direction_me will then be ready to see if it is ;less than 180 (cw) or more than 180 (ccw) (defun cw_or_ccw (mid_point endpoint center_of_arc / direction_cm direction_me cw) (setq direction_cm (RTD (angle center_of_arc mid_point))) (setq direction_me (RTD (angle mid_point endpoint))) (setq direction_me (- direction_me direction_cm)) (if (< direction_me 0) (setq direction_me (+ direction_me 360))) (if (> direction_me 180) (setq cw T)) ;(if (< direction_me 180) (setq cww T)) cw ;will return T if cw or nil if it is ccw ) ;(setq center_of_arc (list 8 5)) ;(setq endpoint (list 9.7889 5.8944)) ;(setq endpoint (list 8 7)) ;(setq mid_point (list 9.0515 6.7013)) ;(setq cww nil) ;(setq cw nil) ;(cw_or_ccw mid_point endpoint center_of_arc) ;------------------------------------------------------------------------------- ;this will find the last text line in a text file....then find and return all the numbers up until the first space in that line (defun last_gcode_num (filename / counter char string more_than_once fn a_line lastline) (setq fn (open filename "r")) (setq a_line (read-line fn)) (setq lastline a_line) ;get the first line in both to start loop (while (/= a_line nil) (setq lastline a_line) (setq a_line (read-line fn)) ) (setq counter 1) (while (/= char " ") (setq char (substr lastline counter 1)) ;gets a substring 1 char long and over "counter" far (if (or (= char "0")(= char "1")(= char "2")(= char "3")(= char "4")(= char "5")(= char "6")(= char "7")(= char "8")(= char "9")) (progn (if (= more_than_once T) (setq string (strcat string char))) ;if more than once through loop then stringcopy char to string (if (= more_than_once nil) (progn (setq string char) (setq more_than_once T))) ;if first time through loop then put the first char into string )) (setq counter (+ counter 1)) ) (close fn) string ;return the string back to what called it ) ;_______________________________________________________________________________________ (defun show_results (demo_cnt show_cnt / ) ;home made funtion to show user what was written to file (setq demo_cnt (itoa demo_cnt)) ;turn the demo count into a string (setq show_cnt (itoa show_cnt)) ;turn the show count into a string (if (= demo T) (progn (setq string (strcat show_cnt " Gcodes Generated... ")) (setq string (strcat string demo_cnt)) (setq string (strcat string " written to file for Demonstration")) (alert string) )) (if (= demo nil) (progn (setq string (strcat show_cnt " Gcodes Generated... ")) (setq string (strcat string show_cnt)) (setq string (strcat string " written to file")) (alert string) )) ) ;__________________________________________________________________________________________ ;What needs to be done first is write the engine to generate ;the serial number, incript it and write it to c:\windows\leigc.dll ;The same function should first check to see if c:\windows\leigc.dll ;is there and if it is read, decript it store it in serial_number ;function to generate random number (defun rand (/ rns rleng lastrn string more_than_once char counter random_number) ;(setq rns (rtos (getvar "tdusrtimer") 2 )) ;use the timer to generate a random serial number (turn it into a string at the sametime) (setq rns (getvar "tdusrtimer" )) ;use the timer to generate a random serial number (turn it into a string at the sametime) (setq prec (getvar "luprec")) ;get the prec of howmany places right of decimal place are displayed and store it as it will be put back at end of funcion (setvar "luprec" 8) (setq rns (rtos rns)) ;turn it into a string (setq counter 3) ;set to 3 so it misses the "0." that starts this string (while (/= char "") (setq char (substr rns counter 1)) ;gets a substring 1 char long and over "counter" far (if (or (= char "0")(= char "1")(= char "2")(= char "3")(= char "4")(= char "5")(= char "6")(= char "7")(= char "8")(= char "9")) (progn (if (= more_than_once T) (setq string (strcat string char))) ;if more than once through loop then stringcopy char to string (if (= more_than_once nil) (progn (setq string char) (setq more_than_once T))) ;if first time through loop then put the first char into string )) (setq counter (+ counter 1)) ) ;(setq random_number (atof string)) ;turns the string number back into a number (setvar "luprec" prec) ;set system var back like it was string ;returns the number as a string ) ;________________________________________________________________________ ;this will check for the serial number and if its not there a new one will be made and written to the windows dir. ;the serial number is returned as a string (defun check&get_serial ( / filename checkfile serial_string serial_scrambled windows_directory path_found win_path_file win_dir check_this write_new checker new_checkfile) (if (/= nil (setq win_path_file (open "tdpgcod.cfg" "r"))) (progn (setq win_dir (read-line win_path_file)) (close win_path_file) (setq checker T))) (if (= checker nil) (progn (setq win_path_file (open "tdpgcod.cfg" "w")) (write-line "nil" win_path_file) (close win_path_file))) (setq filename "c:\\windows\\leigc.dll") (if (/= nil (setq filename (open filename "r"))) (setq checkfile T) ) ;it was found and it is open for reading (if (and (= checkfile nil) (/= "nil" win_dir) (/= nil win_dir)) (progn ;if win_dir does not have "nil" in it then add leigc.dll to the end and see if this is the path (setq filename (strcat win_dir "\\leigc.dll")) (if (/= nil (setq filename (open filename "r"))) (setq checkfile T) ) ));it was found and it is open for reading (if (= checkfile nil) (progn ;now it is time to make a new one if we don't have it yet. (if (/= nil (setq filename (open "c:\\windows\\leigc.dll" "w"))) (setq new_checkfile T) ) ));try and write a new one (if (and (= checkfile nil) (= new_checkfile nil)) (progn ;now it is time to make a new one if we don't have it yet. (setq win_dir (getstring "\nWindows directory not found...\nPlease type the path to your Windows directory: ")) (setq filename (strcat win_dir "\\leigc.dll")) ;add the file name to the end of the path the user typed in (if (/= nil (setq filename (open filename "w"))) (setq new_checkfile T) ) ;it was found and it is open for reading (if (= new_checkfile T) (progn (setq win_path_file (open "tdpgcod.cfg" "w")) (write-line win_dir win_path_file) (close win_path_file) )) )) (if (= new_checkfile T) (progn ;if we need to make a new serial (setq serial_string (rand )) ;use the random engine to make a new serial number (setq serial_scrambled (scramble serial_string)) ;use the homemade scramble fucntion to make a mess of the serial number (write-line serial_scrambled filename) )) ;write it to the file (if (= checkfile T) (progn ;we need to read the password from leigc.dll (setq serial_scrambled (read-line filename)) ;read (setq serial_string (descramble serial_scrambled)) )) ;descramble it (close filename) serial_string ;return the serial number as a string ) ;____________________________________________________________________________ ;Will take a string of numbers and scramble them (defun scramble (serial_string / char counter more_than_once scrambled_string) (setq counter 1) (while (/= char "") (setq char (substr serial_string counter 1)) ;gets a substring 1 char long and over "counter" far (setq char (cond ;will set char to the condition it finds true ((= char "0") "6") ((= char "1") "A") ((= char "2") "F") ((= char "3") "7") ((= char "4") "M") ((= char "5") "3") ((= char "6") "B") ((= char "7") "E") ((= char "8") "L") ((= char "9") "5") (char "") )) (if (= more_than_once T) (setq scrambled_string (strcat scrambled_string char))) ;if more than once through loop then stringcopy char to string (if (= more_than_once nil) (progn (setq scrambled_string char) (setq more_than_once T))) ;if first time through loop then put the first char into string (setq counter (+ counter 1)) ) scrambled_string ;returns the scrambled_string ) ;____________________________________________________________________________ (defun descramble (number_string / char counter more_than_once descrambled_string) (setq counter 1) (while (/= char "") (setq char (substr number_string counter 1)) ;gets a substring 1 char long and over "counter" far (setq char (cond ;will set char to the condition it finds true ((= char "6") "0") ((= char "A") "1") ((= char "F") "2") ((= char "7") "3") ((= char "M") "4") ((= char "3") "5") ((= char "B") "6") ((= char "E") "7") ((= char "L") "8") ((= char "5") "9") (char "") )) (if (= more_than_once T) (setq descrambled_string (strcat descrambled_string char))) ;if more than once through loop then stringcopy char to string (if (= more_than_once nil) (progn (setq descrambled_string char) (setq more_than_once T))) ;if first time through loop then put the first char into string (setq counter (+ counter 1)) ) descrambled_string ;returns the scrambled_string ) ;Returns last modification time of the specified file (VLISP Function) ;(vl-file-systime "filename") ;filename - name of file to be checked ;______________________________________________________________________ ;____________________________________________________________________________________ ;function to check the password against serial and email ;call it by giving it the password in a string to check ;I guess first I need to write the dialog box interface to the intire program from that ;interface there will be a place to register and with a place to enter in a password ;if it finds this is a demo then demo will be set to 1 otherwise if it is nil it is registered ;I need a function that will check and see if there is a tpgcode.ini file and if there is ;open it to see if there are at least two lines in it. If there are get the first line (email address) ;and the 2nd line (password). Then check these against the serial number. If all these are ;true than it is not a demo (defun check_for_demo (/ filename checkfile user_email user_password serial_num char counter more_than_once _char) (setq demo nil) ;set this to nil to begin with..it get changed at the bottom if it is not a demo (setq filename "tdpgcod.ini") (setq checkfile (findfile filename)) ;see if it exist (if (/= checkfile nil) (progn ;if the file does exist (if (= nil (setq filename (open filename "r"))) (progn (princ "cannot open tpgcod.ini") (exit))) ;open it to read only and abort if it cannot open it (if (= nil (setq user_email (read-line filename )))(progn (princ "cannot read line from tpgcod.ini") (setq checkfile nil))) ;read (if (= nil (setq user_password (read-line filename)))(progn (princ "cannot read 2nd line from tpgcod.ini") (setq checkfile nil))) (close filename) )) (if (= checkfile nil) (progn (setq filename "tdpgcod.ini") (setq user_email "steve@lindsayengraving.com") (setq user_password "PASSWORD") (setq filename (open filename "w")) (write-line user_email filename) (write-line user_password filename) (close filename) )) (setq serial_num (check&get_serial)) (setq counter 1) (while (/= counter 9) ;only get 8 char (setq char (substr user_password counter 1)) ;gets a substring 1 char long and over "counter" far (setq char (cond ;will set char to the condition it finds true (it changes char to what it finds in the lookup table ((= char "8") "1") ((= char "3") "2") ((= char "5") "3") ((= char "7") "4") ((= char "2") "5") ((= char "9") "6") ((= char "0") "7") ((= char "4") "8") ((= char "6") "9") ((= char "1") "0") ((= char "K") "A") ((= char "J") "B") ((= char "I") "C") ((= char "H") "D") ((= char "G") "E") ((= char "F") "F") ((= char "E") "G") ((= char "D") "H") ((= char "C") "I") ((= char "B") "J") ((= char "A") "K") ((= char "Z") "L") ((= char "Y") "M") ((= char "X") "N") ((= char "S") "O") ((= char "V") "P") ((= char "U") "Q") ((= char "T") "R") ((= char "W") "S") ((= char "R") "T") ((= char "Q") "U") ((= char "P") "V") ((= char "O") "W") ((= char "N") "X") ((= char "M") "Y") ((= char "L") "Z") ((= char "@") "") ;give it an empty string and it will write nothing to the file (char "") )) (if (or(= counter 1)(= counter 3)(= counter 5)(= counter 7)) (setq _char (substr user_email counter 1))) ;gets a substring 1 char long and over "counter" far (if (or(= counter 2)(= counter 4)(= counter 6)(= counter 8)) (setq _char (substr serial_num counter 1))) ;gets a substring 1 char long and over "counter" far (if (/= char _char) (setq demo T)) ;if any of these don't match it is a demo (setq counter (+ counter 1)) );end of while demo ;returns nil if not a demo and T if it is a demo ) ;------------------------------------------------------------------------- ;this is called from the run_ok_register from when the user click ok to regestering (defun ok_register (email password / filename) (if (and (/= "" email) (/= nil email)) ;if the use click in the edit box but didn't type anything it will pass "" to email an password so ignor it (if (and (/= "" password) (/= nil password)) (progn ;i wrote the two ifs cause I could not figure out how to get them in one line (if (/= nil (setq filename (open "tdpgcod.ini" "w"))) (progn (write-line email filename) (write-line password filename) (close filename) (if (= filename nil) (princ "Cannot write to tdpgocd.ini")) )) )) ) (if (or (or (= "" email) (= "" password)) (or (= nil email) (= nil password))) (progn ;will need to get the email address since we display it in the "alert" box (if (/= nil (setq filename (open "tdpgcod.ini" "r"))) (progn (setq email (read-line filename)) ;get email string (close filename) )) )) (check_for_demo) (if (= nil demo) (progn (setq string (strcat "TOOL PATH GCODE\nRegister to: " email )) (setq string (strcat string "\n\nThank You for Registering!" )) (alert string) )) (if (= T demo) (alert " TOOL PATH GCODE\n\n DEMO MODE\n\n PASSWORD NOT ACCEPTED \n\n Please click Reg Info button to\n learn how to Register")) demo ;returns nil if not a demo and T if it is a demo ) ;__________________________________________________________ (defun strings_to_dialogs (which_string / serial string) (if (= which_string "reg_info_string") (progn (setq string " Tool Path Gcode in Demo mode is a fully functional program the only limitation is that the number of gcode commands written to a file is limited. If you find this program would be useful in your gcode programming please send check or money order for $49.95 (NE residence please add 6%) to: Tool Path Gcode 2.0 Lindsay Engraving, Inc. 3714 West Cedar Hills Drive Kearney, NE 68847 Along with the order please include the serial number shown below and your email address. After payment you will receive a password by email that will unlock the program to write an unlimited number of gcodes commands to a file. Please include this serial number along with payment. SERIAL NUMBER: ") (setq serial (check&get_serial)) ;gets the serial number and then copys it to the string (setq string (strcat string serial)) )) (if (= which_string "about_string") (progn (setq string " TOOL PATH GCODE 4.0 by Steve J. Lindsay http:\\\\www.LindsayEngraving.com SERIAL NUMBER: ") (setq serial (check&get_serial)) (setq string (strcat string serial)) )) (if (= which_string "poly_help") (setq string " Poly Gcode allows you to select a 2d polyline...the Gcode path will be written to a file. It does support arcs but not spline or fit curve polylines. The path direction will be in the same direction as the polyline was drawn. This function currently only supports AutoCAD 14 new lwpolyline (optimized polyline). PolyGCode will use the gcode commands G02 and G03 along with G01 so that it can interpolate arcs and lines from a polyline containing arcs and lines.") ) (if (= which_string "auto_help") (setq string "3D AutoGCode using the \"new vertexes\" selection will work with: * open or closed pline (plain, fit or spline curves) * open or closed 3dpoly (plain or 3D B-spline curve) * open or closed spline It will take the \"New Vertex Jog Distance\" entered and divide the entity into pieces this size, find the coordinates of these vertexes and write them to file in gcode format. Note: if you enter in a very small distance for the \"Jog Distance\" it does take some time for it to compute these points and the file size can get large. 3D AutoGCode using \"Existing Vertexes\" will work with open or closed plines. It will work with a curve fit pline or a 3d spline but it will only collect the vertexes that make up the entity and will not be as smooth as probably desired. Instead of this command using \"existing vertexes\" look at PolyGCode as it supports arcs within a polyline.") ) (if (= which_string "pp_help") (setq string "3D Pick Point Gcode allows the user to select points in 3d space using any of the object snap modes. It will write these coordinates to file in gcode format. It will also allow the user to enter in gcode commands during the function.") ) (alert string) )