[COLOR=teal]
; CNCPATH.LSP
; Revision Date: 1.0 31 March 1989 Origional release
; 1.01 20 April 1989 Added loading routines (cosmetic)
; 1.02 28 June 1989 changed format to XYZ from bandit
; added code to show progress of CNCOUT
; 1.03 26 July 1989 Separated XYZ words in output with
; spaces.
; 1.10 26 Sept 1989 Added error handling function,
; fixed minor bug in axis removal
; Programmer: Tom Blough (CIS ID# 76137,3211)
; System: AutoCAD Release 10 c2 (10/26/88) IBM PC
; AutoLISP Release 10.0
; These LISP routines will convert a CNC program in XYZ
; format to a 3D-Polyline in AutoCad where the path may be
; edited. The edited Polyline can then be converted back
; into an XYZ compatible ASCII text file that will need
; only minor editing.
(prompt "\nCNCPATH V1.10 -- A CNC utility by Tom Blough (c) 1989")
(prompt "\nLoading CNCPATH .") ; show that we are loading
(setq true nil
false 1
)
(prompt ".") ; update loading status
(defun cncerr (mesg)
; This function replaces the Autocad error
; handler while our routines are running.
(if (<> mesg "Function cancelled")
(progn
(princ "\nThe folowing error has occurred: ")
(princ mesg)
)
)
(setq *error* olderr) ; restore autocads error handler
(prin1) ; and exit cleanly
)
(prompt ".") ; update loading status
;====================
; CNCIN
;====================
(defun findchar (string begchr endchr / tempstr char pos b e)
; This function locates the
; first character whose ASCII value is between
; the ASCII values of begchr and endchr, and
; returns its interger position in the string.
; If no matching characters are found, the
; function returns NIL
(setq tempstr string pos nil)
(setq b (ascii begchr))
(setq e (ascii endchr))
(if (> b e)
(progn
(setq e b)
(setq b (ascii endchr))
)
)
(while (/= tempstr "")
(setq char (ascii (substr tempstr 1 1)))
(if (and (>= char b) (<= char e))
;found letter
(progn
(setq pos (1+ (- (strlen string) (strlen tempstr))))
(setq tempstr "")
)
;not a match, so check next character
(setq tempstr (substr tempstr 2))
)
)
(eval 'pos)
)
(prompt ".") ; update loading status
(defun parsepoint (fname vertex / done line start tempstr end found point)
; This function reads lines from the open file
; until it locates x,y,z values. It then
; constructs a point using those values and
; returns the point. The function returns NIL
; when it reaches EOF.
(setq done false) ; reset the coordinates and flag
(while done
(if (setq line (read-line fname)) ; get a line from CNC file
; not EOF
(progn
(setq found false) ; reset found flag
(setq line (strcase line)) ; convert the Alpha chars to upper
; search for X coordinate
(if (setq start (findchar line "X" "X"))
; found a value
(progn
(setq tempstr (substr line (1+ start))) ; find end of number
(if (setq end (findchar tempstr "A" "Z")) ; any more letters?
; truncate string at the next letter
(setq tempstr (substr tempstr 1 (1- end)))
)
(setq found true)
(setq vertex (list (atof tempstr) (cadr vertex) (caddr vertex)))
)
)
; search for Y coordinate
(if (setq start (findchar line "Y" "Y"))
; found a value
(progn
(setq tempstr (substr line (1+ start))) ; find end of number
(if (setq end (findchar tempstr "A" "Z")) ; any more letters?
; truncate string at the next letter
(setq tempstr (substr tempstr 1 (1- end)))
)
(setq found true)
(setq vertex (list (car vertex) (atof tempstr) (caddr vertex)))
)
)
; search for Z coordinate
(if (setq start (findchar line "Z" "Z"))
; found a value
(progn
(setq tempstr (substr line (1+ start))) ; find end of number
(if (setq end (findchar tempstr "A" "Z")) ; any more letters?
; truncate string at the next letter
(setq tempstr (substr tempstr 1 (1- end)))
)
(setq found true)
(setq vertex (list (car vertex) (cadr vertex) (atof tempstr)))
)
)
(if (not found)
; found one or more coordinates
(progn
(setq done true)
(eval 'vertex)
)
)
)
; EOF encountered
(setq done true)
)
)
)
(prompt ".") ; update loading status
(defun C:CNCIN (/ name file vert)
; This function reads Bandit coordinate data
; from a user specified file, and converts
; it into an Autocad 3D Polyline.
(setq olderr *error*) ; save old error handler
(setq *error* cncerr) ; point error to our handler
; get a CNC file to work with
(setq name nil) ; reset name string
(while (not name) ; loop until valid filename
(setq name (getstring "Filename and extension of CNC Program: "))
(if (not (setq file (open name "r"))) ; does file exist?
; file not found
(setq name (prompt "CNC file not found\n"))
)
)
; we now have the CNC file open
; lets begin our polyline, and loop, creating
; verticies, until our parsing function returns
; a nil indicating that it has reached the end
; of the file.
(setq vert '(0.0 0.0 0.0)) ; set starting verticie to the origin
(command "PLINE")
(while (setq vert (parsepoint file vert))
(command vert)
)
(command "") ; finish out the poly command
(close file) ; done with file so put it away
(setq *error* olderr) ; reset error to autocads handler
(prin1) ; and return to AutoCAD cleanly
)
(prompt ".") ; update loading status
;====================
CNCOUT
;====================
(defun getpoly (/ tpath)
; This function queries the user to select the CNC path.
; It checks that the selected entity is a polyline.
(setq tpath nil)
(while (not tpath)
(while (not (setq tpath (entsel "Select a CNC path polyline: ")))
(prompt " None found.\n")
)
(setq tpath (entget (car tpath)))
(if (/= (cdr (assoc 0 tpath)) "POLYLINE")
; entity selected was not a polyline, try again
(progn
(prompt " Entity selected was not a polyline.\n")
(setq tpath nil)
)
)
)
(eval 'tpath)
)
(prompt ".") ; update loading status
(defun formprint (vertpoint fname / flag)
; This function takes a list of 3 reals and formats
; the output in XYZ CNC form XXX.XXXX with leading
; but not trailing zeros truncated.
(setq flag true)
(if (/= (car vertpoint) oldx)
; x value has changed, print new value
(progn
(setq oldx (car vertpoint))
(setq flag false)
(princ "X" fname)
(princ (rtos (car vertpoint) 2 4) fname)
)
)
(if (/= (cadr vertpoint) oldy)
; y value has changed, print new value
(progn
(setq oldy (cadr vertpoint))
(if flag
(princ " " fname)
)
(setq flag false)
(princ "Y" fname)
(princ (rtos (cadr vertpoint) 2 4) fname)
)
)
(if (/= (caddr vertpoint) oldz)
; z value has changed, print new value
(progn
(setq oldz (caddr vertpoint))
(if flag
(princ " " fname)
)
(setq flag false)
(princ "Z" fname)
(princ (rtos (caddr vertpoint) 2 4) fname)
)
)
(if flag
(princ "\n" fname)
)
)
(prompt ".") ; update loading status
(defun C:CNCOUT (/ vertex path name outfile ourpt oldpdmode oldpdsize)
; This funtion asks the user to select a polyline
; to convert into ASCII coordinate data. The data
; will then be written to the user specified file
; in XYZ compatible format. The user will then
; need to do only minor editing on the cnc file.
(setq oldx nil
oldy nil
oldz nil
) ; initalize redundant move
; signals
(setq olderr *error*) ; save old error handler
(setq *error* cncerr) ; point error to our handler
; get the CNC polyline
(setq path (getpoly))
; got the polyline, now get a file to send the output to
(setq name nil) ; reset name string
(while (not name) ; loop until valid filename
(setq name (getstring "\nFilename and extension of CNC Program: "))
(if (setq outfile (open name "r")) ; does file exist?
; file found
(progn
(initget 1 "Y N")
(if (/= (getkword "File exists. Overwrite (Y/N)? ") "Y")
; user doesn't want to overwrite it
(progn
(close outfile) ; close file and retry
(setq name nil)
)
; ok to overwrite it
(close outfile)
)
)
)
)
; got a name for the output file, open it for writing
(setq outfile (open name "w"))
(princ "% \r" outfile) ; header for cnc file
(princ "G70 \r" outfile) ; dimensions are in inches
(princ "G91 \r" outfile) ; relative mode
(princ "G0X0Y0 \r" outfile)
(princ "M04 \r" outfile) ; M04 - Cut on
(SETQ kerf (GETSTRING "\kerf - None, Left or Right <N or L or R>: "))
(IF (OR (= kerf "N") (= kerf "n"))
(progn (princ "\r" outfile) )) ; No kerf
(IF (OR (= kerf "L") (= kerf "l"))
(progn (princ "G41 \r" outfile) )) ; Left kerf
(IF (OR (= kerf "R") (= kerf "r"))
(progn (princ "G42 \r" outfile) )) ; Right kerf
; save the current point style and size, and change it to ours
(setq oldpdmode (getvar "PDMODE"))
(setq oldpdsize (getvar "PDSIZE"))
(setvar "PDMODE" 3) ; set point style to an X
(setvar "PDSIZE" -3) ; and its size to 3% of screen
; create a point in the database to use
(command "point" "0,0,0")
(setq ourpt (entget (entlast)))
; got a polyline and a file so... step through the verticies, and
; output each to the print formatter.
; we will get the next vertex and also check to see if we are
; finished in the test expression of the while loop
(while (/= (cdr (assoc 0 (setq path (entget (entnext (cdr (assoc -1 path))))))) "SEQEND")
(progn
(setq vertex (cdr (assoc 10 path))) ; now get its coordinates
(setq ourpt (subst (cons '10 vertex) (assoc 10 ourpt) ourpt)) ; update progress
(entmod ourpt)
(formprint vertex outfile) ; and send them to formatter
)
)
(princ "M03 \r" outfile) ; cut off
(princ "M30 \r" outfile) ; End of Program
(entdel (cdr (assoc -1 ourpt))) ; delete the point we used
(setvar "PDMODE" oldpdmode) ; set point style back
(setvar "PDSIZE" oldpdsize) ; and its size back
(princ "\n" outfile) ; add a blank line to our output file
(close outfile) ; finished, so close file
(setq *error* olderr) ; reset error to autocads handler
(prin1) ; and return cleanly
)
(prompt ".") ; update loading status
;====================
; CNCINFO
;====================
(defun C:CNCINFO (/ path start number long total next dist short)
; This function uses a function in the CNCOUT section to query the
; user for a CNC path. It then calculates the number of line
; segments, the shortest and longest segment length, and the
; average segment length in the CNC tool path
(setq olderr *error*) ; save old error handler
(setq *error* cncerr) ; point error to our handler
; get a CNC path
(setq path (getpoly))
(setq path (entget (entnext (cdr (assoc -1 path))))) ; get first vertex
(setq start (cdr (assoc 10 path))) ; get start point of vertex
; we will get the next vertex and also check to see if we are
; finished in the test expression of the while loop
(setq number 0) ; initialize our segment counter to 0
(setq long 0.0) ; initialize longest
(setq total 0.0) ; initialize total lenght
(while (/= (cdr (assoc 0 (setq path (entget (entnext (cdr (assoc -1 path))))))) "SEQEND")
(setq next (cdr (assoc 10 path))) ; get next start point
(setq number (1+ number)) ; increment # of segments
(setq dist (distance start next)) ; how long is it?
(if (< dist short) ; is it the shortest?
; its shorter so make it the new short
(setq short dist)
)
(if (> dist long) ; is it the longest?
; its longer so make it the new long
(setq long dist)
)
(setq total (+ total dist)) ; keep track of total distance
(setq start next) ; get ready for next segment
)
; print the results
(princ "\n\nTotal number of line segments: ")
(princ number)
(princ "\n Shortest segment: ")
(princ short)
(princ "\n Longest segment: ")
(princ long)
(princ "\n Average length of segments: ")
(princ (/ total number))
(princ "\n Total length of CNC path: ")
(princ total)
(setq *error* olderr) ; reset error to autocads handler
(prin1) ; exit cleanly
)
(prompt ". Loaded\n") ; update loading status
(prin1) ; and exit cleanly
[/color]
