;;;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 (defun c:engrave (/ ename info what_is_it new_or_append Ncount last_gcode_num filename width_factor pdist oncethrough last_angle current_point vertexlist repaired_angle width_factor point temp check_angle string count Z_clearance cut_count ssetnum count the_selection angle_cnt angle_string unwind vertexlist_refined cleanup) ;(setq show_cnt 0) (setq demo_cnt 0) (setvar "cmdecho" 0) ;Controls whether AutoCAD echoes prompts and input during the AutoLISP (command) function (setvar "osmode" 0) (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) ;(while (= nil (setq ename (car (entsel "\nPlease select a polyline..."))) )) ;prompt user to select an object and get the name ;(setq info (entget ename)) ;get lots of info about the entity ;(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 (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') ")) (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 (lastgcodenum 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 N_cnt (atoi Ncount)) ;turn the string into a interger number for later adding 5 to. (initget 1 "Y N") (setq adjust_degrees (getkword "\nWould you like to use 400 degrees for a circle? (Y or N) ")) (setq width_factor (getdist "\nEnter a polyline width that represents a Z depth of -.005 (enter positive number): ")) (setq pdist (getdist "\nEnter the size of flats for steps on arcs: ")) (setq Z_clearance (getdist "\nEnter a Z hight for rapiding between cuts: ")) (initget 1 "Y N") (setq unwind (getkword "\nWould you like to unwind the hose to the air chasing graver between cuts (Y or N) ")) (if (= new_or_append "N") (setq filename (open filename "w"))) ;open a new file for writing. (if (= new_or_append "A") (progn (setq filename (open filename "a")) ;open it for appending and mark the spot in the file (setq string " ") (write-line string filename) ;do a space and return to place a space/return in the file (setq string (getstring "Enter a note to yourself (no spaces): ")) (princ "\n adding note....") (setq string (strcat "(" string ")")) ;put parthancies around the note /string (write-line string 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 (setq N_cnt 5) (setq current_point '(0 0)) ;tell it the mill is at 0,0 to start (setq angle_cnt 0) ;get this set for the loop (setq cut_count 0) ;other end of the below "while loop" is at the bottom of this function (while (/= cut_count how_many_cuts) ;loop as many times as there are objects in the selection set (how_many_cuts) (setq cut_name (ssname the_selection cut_count)) ;extracts selection object name (store name in cut_name) (setq cut_count (+ cut_count 1)) (setq what_is_it (cdr(assoc 0(entget cut_name)))) (setq info (entget cut_name)) ;get lots of info about the entity ;(setq what_is_it (cdr(assoc 0(entget cut_name)))) ;this is not now used. Use it if you want to make sure that only plines are processed (if (= what_is_it "POLYLINE") (setq vertexlist (find_vertexes2 cut_name))) ;when you use "fit curve" to a poly line in turns in to the old autocad 2d polyline.. (if (= what_is_it "LWPOLYLINE") (setq vertexlist (find_vertexes info))) (setq vertexlist_refined (refine_vertexes vertexlist pdist width_factor)) ;;;(if (= 0 what_is_it) (progn ;;; (setq vertexlist (find_vertexes info)) ;use the homemade find_vertexes function to get and store all vertexs in vertexlist ;;; ;;; ;need to find the arcs and bust them up and make a new vertext list ;;; ;when entering the below code vertexlist should contain xy only (The "A" axis will be figured below). ;;; (setq vertexlist_refined (refine_vertexes vertexlist pdist width_factor)) ;;;)) ;;;(if (/= 0 what_is_it) (progn (setq count 0) (foreach point vertexlist_refined (setq count (+ 1 count)) ;add 1 to the counter (setq N_cnt (+ N_cnt 5)) ;add 5 to the Nnumber counter (setq check_angle (angle current_point point)) ;this holds the angle in radians (setq check_angle (RTD check_angle)) ;convert it to degrees (setq check_angle (- 360 check_angle)) ;take this line out if you want it to figure angles clockwise rather than counter clockwise ;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ;------------- here starts the figuring if we are going in spirals and if so add 360 to 360 to 360 each time (setq repaired_angle check_angle) ;get this set (if (/= oncethrough 1) (progn (setq last_angle check_angle))) (if (> last_angle check_angle) (setq temp (- last_angle check_angle))) ;compare the current angle with the last and find the difference (if (< last_angle check_angle) (setq temp (- check_angle last_angle))) ;same as line above... (if (> temp 217) (progn ;I changed this in this version 10c to 217 degrees ;used 270 insead of 360 to be sure we catch it (if (< check_angle last_angle ) (progn ;going from big angle to small angle (360 to 0) so we are going in a positive direction (setq angle_cnt (+ angle_cnt 1)) )) (if (> check_angle last_angle ) (progn ;going in negative circle (setq angle_cnt (- angle_cnt 1)) )) )) (if (/= angle_cnt 0) (progn (setq temp (* angle_cnt 360)) ;use the angle_cnt number and take it times 360 (setq repaired_angle (+ check_angle temp)) ;make the changes to the angle and store it in repaired_angle )) ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ;;;------------- end of figuring if we are going in spirals ;;;------------- THE below code is for adjusting for my mill for the A axis attached direct to the spindle. ;;;------------- since my stepper motor does 400 steps to turn 360 degrees the below code compensates by tricking it that ;;;--------------there are 400 degrees in a circle ;;;--------------just mark out the code if it isn't needed.... (if (= adjust_degrees "Y") (progn (setq temp (* repaired_angle 400)) ;just cross mutiply (setq repaired_angle (/ temp 360)) )) ;just cross mutiply ;;;--------------end of tricking it that there are 400 degrees in a circle (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 (if (= unwind "Y") (progn ;do this if you want to unwind between cuts. Use this to unwind the hose to tha "air chasing graver" (setq repaired_angle 0.0) (setq angle_cnt 0)(setq check_angle 0.0) (setq last_angle 0.0) (setq angle_string (rtos repaired_angle)) (setq string (strcat "N" Ncount " A" angle_string)) (write-line string filename) )) ;write the angle to the string and to the file ;****************************************************************** ;**below is code to figure just the firt time through what angle the cutter should be pointing... it looks ahead to the next point to figure this****************** ;write the angle next ;(setq string "write the angle here") (write-line string filename) (setq 1stpoint (car vertexlist_refined)) (setq 2ndpoint (cadr vertexlist_refined)) (setq check_angle (angle 1stpoint 2ndpoint)) ;this holds the angle in radians (setq check_angle (RTD check_angle)) ;convert it to degrees (setq check_angle (- 360 check_angle)) ;take this line out if you want it to figure angles clockwise rather than counter clockwise (setq repaired_angle check_angle) ;get this set ;(if (/= oncethrough 1) (progn ; (setq last_angle check_angle))) (if (> last_angle check_angle) (setq temp (- last_angle check_angle))) ;compare the current angle with the last and find the difference (if (< last_angle check_angle) (setq temp (- check_angle last_angle))) ;same as line above... (if (> temp 270) (progn ;used 270 insead of 360 to be sure we catch it (if (< check_angle last_angle ) (progn ;going from big angle to small angle (360 to 0) so we are going in a positive direction (setq angle_cnt (+ angle_cnt 1)) )) (if (> check_angle last_angle ) (progn ;going in negative circle (setq angle_cnt (- angle_cnt 1)) )) )) (if (/= angle_cnt 0) (progn (setq temp (* angle_cnt 360)) ;use the angle_cnt number and take it times 360 (setq repaired_angle (+ check_angle temp)) ;make the changes to the angle and store it in repaired_angle )) (if (= adjust_degrees "Y") (progn (setq temp (* repaired_angle 400)) ;just cross mutiply (setq repaired_angle (/ temp 360)) )) ;just cross mutiply (setq angle_string (rtos repaired_angle)) (setq string (strcat "N" Ncount " A" angle_string)) (write-line string filename) ;***********end of finding angle for just this first time through ******************************************************** ;Now write the z (setq temp2 (car vertexlist)) ;the next few lines are to extract the starting width of the start of the line (setq starting_width (cadr temp2)) (setq temp (* starting_width 0.005)) ;just cross mutiply to figure z depth (setq z_axis (/ temp width_factor)) ;just cross mutiply (setq z_axis (- 0 z_axis)) ;flip the sign of the number to negative by subtracting it from 0 (setq zstring (rtos z_axis 2 4)) (setq string (strcat "N" Ncount " Z" zstring)) (write-line string filename) )) (setq angle_string (rtos repaired_angle)) ;convert it to a string for writing to the file (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 (> count 2) (progn (setq string (strcat "N" Ncount " A" angle_string)) (write-line string filename))) ;write the angle to the string and to the file ;(if (= count 1) (setq string (strcat "N" Ncount " X" xstring " Y" ystring))) ;3d..put it all together in a string (if (/= count 1) (progn (setq string (strcat "N" Ncount " X" xstring " Y" ystring " Z" zstring)) (write-line string filename))) ;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 current_point point) ;save current point the mill is setting at in current_point (setq last_angle check_angle) (setq oncethrough 1) ) ;end of: foreach point vertexlist loop );end of while loop ;_____________we are through the loops and quiting so write a few last gcode commands..... ; raising the z to 1/2" above the surface ; move x and y to zero ; move A to the nearest zero ; reset A axis to zero (setq check_angle 0) ;tell it we want to set the A Axis to zero (setq check_angle (- 360 check_angle)) ;take this line out if you want it to figure angles clockwise rather than counter clockwise (setq repaired_angle check_angle) ;get this set ;(if (/= oncethrough 1) (progn ; (setq last_angle check_angle))) (if (> last_angle check_angle) (setq temp (- last_angle check_angle))) ;compare the current angle with the last and find the difference (if (< last_angle check_angle) (setq temp (- check_angle last_angle))) ;same as line above... (if (> temp 270) (progn ;used 270 insead of 360 to be sure we catch it (if (< check_angle last_angle ) (progn ;going from big angle to small angle (360 to 0) so we are going in a positive direction (setq angle_cnt (+ angle_cnt 1)) )) (if (> check_angle last_angle ) (progn ;going in negative circle (setq angle_cnt (- angle_cnt 1)) )) )) (if (/= angle_cnt 0) (progn (setq temp (* angle_cnt 360)) ;use the angle_cnt number and take it times 360 (setq repaired_angle (+ check_angle temp)) ;make the changes to the angle and store it in repaired_angle )) (if (= adjust_degrees "Y") (progn (setq temp (* repaired_angle 400)) ;just cross mutiply (setq repaired_angle (/ temp 360)) )) ;just cross mutiply (setq angle_string (rtos repaired_angle)) (setq zstring (rtos Z_clearance 2 4)) (setq string (strcat "N" Ncount " Z" zstring)) (write-line string filename) (setq string (strcat "N" Ncount " A" angle_string)) (write-line string filename) (setq string (strcat "N" Ncount " G92 A0.000")) (write-line string filename) ;THIS G92 REZEROS THE A AXIS (setq string (strcat "N" Ncount " G00")) (write-line string filename) ;DO A G00 AFTER G92 TO CLEAR IT (initget 1 "Y N") (setq cleanup (getkword "\nFinished.....\nWould you like the x y postioned to zero and the spindle raised to .5 (Y or N) ")) (if (= cleanup "Y") (progn (setq string (strcat "N" Ncount " Z0.500")) (write-line string filename) ;raise the z up (setq string (strcat "N" Ncount " X0.0000 Y0.0000")) (write-line string filename) )) (close filename) (setvar "cmdecho" 1) ) ;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 count) (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) ;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) (if (/= (assoc 40 temp) nil) ;if assoc 40 is in the list do this (setq begining_width (cdr(assoc 40 temp)))) ;now get the starting width since assoc 40 is the starting width (if (/= (assoc 41 temp) nil) ;if assoc 41 is in the list do this (setq ending_width (cdr(assoc 41 temp)))) ;now get the ending width since assoc 41 is the ending width (if (/= (assoc 42 temp) nil) (progn ;if assoc 42 is in the list do this (setq bulge (cdr(assoc 42 temp))) ;now get the arc bulge since assoc 42 is the arc bulge width (setq temp nil) ;clear this for use below (setq temp (append temp (list vertex))) ;now add it to the collection of vertexes (setq temp (append temp (list begining_width))) ;now add it to the collection of vertexes (setq temp (append temp (list ending_width))) ;now add it to the collection of vertexes (setq temp (append temp (list bulge)));now add it to the collection of vertexes (setq vertexlist (append vertexlist (list temp))) )) ;put them all together in one list called vertexlist ) vertexlist ;return the vertexlist to the function that called it ) (defun find_vertexes2 (entityname / is_it_closed temp vertex vertexlist firstvertex count entityname subentity kind) ;(setq entityname (cdr(assoc -1(entget (car (entsel)))))) (setq subentity entityname) (setq vertex "") (while (/= vertex nil) (setq subentity (entnext subentity)) (setq vertex (cdr(assoc 10 (entget subentity)))) (setq begining_width (cdr(assoc 40 (entget subentity)))) (setq ending_width (cdr(assoc 41 (entget subentity)))) (setq bulge (cdr(assoc 42 (entget subentity)))) (setq temp nil) ;clear this for use below (setq temp (append temp (list vertex))) ;now add it to the collection of vertexes (setq temp (append temp (list begining_width))) ;now add it to the collection of vertexes (setq temp (append temp (list ending_width))) ;now add it to the collection of vertexes (setq temp (append temp (list bulge)));now add it to the collection of vertexes (setq vertexlist (append vertexlist (list temp))) ;put them all together in one list called vertexlist ) (setq vertexlist (reverse vertexlist)) ;//these 3 lines are used to take away the nil at the end of the list (setq vertexlist (cdr vertexlist)) (setq vertexlist (reverse vertexlist)) vertexlist ) (defun refine_vertexes (vertexlist pdist width_factor / 2nd_vertexlist vertexlist fixed_vertexlist ending_width starting_width prev_ending_width prev_bulge point ending_width starting_width temp ending_width z_axis z_axis_tmp increment ent count dif ent_data_change ent_data ending_width bulge ssetnum going_up ppoint ) (setq prev_starting_width 0) (setq prev_ending_width 0) (setq prev_bulge 0) (foreach temp vertexlist ;this first foreach is to reposition the list so that the point in the list is together with the correct width/bulge info (setq point (car temp)) (setq starting_width (cadr temp)) (setq ending_width (caddr temp)) (setq bulge (car (reverse temp))) (setq temp nil) ;clear this (setq temp (append temp (list point))) ;now add it to the collection of (setq temp (append temp (list prev_starting_width))) ;now add it to the collection of (setq temp (append temp (list prev_ending_width))) ;now add it to the collection of (setq temp (append temp (list prev_bulge)));now add it to the collection of (setq 2nd_vertexlist (append 2nd_vertexlist (list temp))) ;put them all together in one list called vertexlist (setq prev_starting_width starting_width) (setq prev_ending_width ending_width) (setq prev_bulge bulge) ) (setq prev_starting_width 0) (setq prev_ending_width 0) (setq prev_bulge 0) (foreach temp 2nd_vertexlist (setq starting_width (cadr temp)) (setq ending_width (caddr temp)) (setq bulge (car (reverse temp))) (setq point (car temp)) (if (/= bulge 0.0) (progn ;do this if it is an arc ;here you will need to draw an arc on top of this arc and use the measure command on it. ;Then using the width_factor to figure how much change in the Z axis there will be from the start of the arc to the end of the arc. ;Divide this distance by how many new entitys got created useing the measure command to discover how much the z axis should move for ;each segment of the arc. ;You will need to use a foreach loop here to write the addtional xyz points and append them to the fixed_vertexlist. ;To draw an arc on the polyline arc use the x y point for the beging and end of the arc and draw a polyline between them. ; Get the entity name of this new polyline and get into it's dottoed pair and change the bulge factor to the same as the orgianal ;polyline arc. Now use the "measure" command on it. (setq checkdist (distance prev_point point)) ;check to see if the dist from the end to the start of this segment...and if it is less than the distance we are going to divide it up into skip all this "measure" function and just use the end and start points (if (< checkdist pdist) ;check to see if the dist from the end to the start of this segment...and if it is less than the distance we are going to divide it up into skip all this "measure" function and just use the end and start points (setq bulge 0.0)) ;set the bulge to 0.0 so that when it leaves it can later get into the "if bulge = 0.0" function (if (> checkdist pdist) (progn ;if the distance is larger go ahead an run through this measure function...and divide the arc up. (command "pline" prev_point point "" ) (setq ent (entlast)) ;extracts selection object name (store name in ent) (setq ent_data (entget ent)) ;get the data info (setq ent_data_change (subst (cons 42 bulge) (assoc 42 ent_data) ent_data )) ;change the bulge dotted pair 42 to the same as the one we are working on...so it is an arc (entmod ent_data_change) ;update the autocad database (command "measure" ent pdist) ;use measure to divide this arc up into chunks the size that the user entered (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 temp (* ending_width width_factor)) ;just cross mutiply to figure z depth ;(setq z_axis_tmp (/ temp 0.005)) ;just cross mutiply ;(setq z_axis_tmp (- 0 z_axis_tmp)) ;flip the sign of the number to negative by subtracting it from 0 (setq temp (* ending_width 0.005)) ;just cross mutiply to figure z depth (setq z_axis_tmp (/ temp width_factor)) ;just cross mutiply (setq z_axis_tmp (- 0 z_axis_tmp)) ;flip the sign of the number to negative by subtracting it from 0 (if (> z_axis_tmp z_axis) (progn (setq dif (- z_axis_tmp z_axis)) (setq going_up 1) )) ;find the difference in z axis change (from the start of the arc to the end of the arc) (if (< z_axis_tmp z_axis) (progn (setq dif (- z_axis z_axis_tmp)) (setq going_up 0) )) ;same as line above... (if (= z_axis_tmp z_axis) (setq dif 0)) (setq increment (/ dif (+ 1 ssetnum))) ;find how much we need to move z for each step/jog (add 1 because it doesn't placed nodes on the end of arc points (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 ppoint (cdr(assoc 10(entget ent)))) ;extract the xyz from the object (store in point) ;(if (/= count 1) (setq z_axis (+ z_axis increment))) ;only do this starting the 2nd time through.. (by the time it loops all the times it will add up to z_axis_tmp ;(if (AND (/= count 1)(= going_up 1)) (setq z_axis (+ z_axis increment)));only do this starting the 2nd time through.. (by the time it loops all the times it will add up to z_axis_tmp ;(if (AND (/= count 1)(= going_up 0)) (setq z_axis (- z_axis increment))) (if (= going_up 1) (setq z_axis (+ z_axis increment)));only do this starting the 2nd time through.. (by the time it loops all the times it will add up to z_axis_tmp (if (= going_up 0) (setq z_axis (- z_axis increment))) ;(if (= count 1) (setq z_axis z_axis)) ;only do this the first time through (this line isn't needed but it keeps things clearer so I can see what is going on) (setq temp nil) ;clear this (setq temp (append temp (list (car ppoint)))) (setq temp (append temp (list (cadr ppoint)))) (setq temp (append temp (list z_axis))) (setq fixed_vertexlist (append fixed_vertexlist (list temp))) ;append the xyz list with the xyz point ) ;(command "erase" sset "") (command "u") (command "u") (setq temp nil) ;clear this (setq temp (append temp (list (car point)))) ;do these these lines to catch the ending vertex of the arc (setq temp (append temp (list (cadr point)))) (setq temp (append temp (list z_axis_tmp))) (setq fixed_vertexlist (append fixed_vertexlist (list temp))) ;append the xyz list with the xyz point (setq prev_point point) )) )) (if (= bulge 0) (progn ;do this if it isN'T an arc ;next two lines are the figuring for the z axis here using the width_factor ;(setq temp (* ending_width width_factor)) ;just cross mutiply ;(setq z_axis (/ temp 0.005)) ;just cross mutiply ;(setq z_axis (- 0 z_axis)) ;flip the sign of the number to negative by subtracting it from 0 (setq temp (* ending_width 0.005)) ;just cross mutiply to figure z depth (setq z_axis (/ temp width_factor)) ;just cross mutiply (setq z_axis (- 0 z_axis)) ;flip the sign of the number to negative by subtracting it from 0 (setq temp nil) ;clear this (setq temp (append temp (list (car point)))) (setq temp (append temp (list (cadr point)))) (setq temp (append temp (list z_axis))) (setq fixed_vertexlist (append fixed_vertexlist (list temp))) ;append the xyz list with the xyz point (setq prev_starting_width starting_width) (setq prev_ending_width ending_width) (setq prev_bulge bulge) (setq prev_point point) )) ) fixed_vertexlist ) ;;;(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) ;;;;;------------------------------------------------------------------------------ ; 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) ) ;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 lastgcodenum (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 ) ;_____________________________________________ ;...polywidth will edit the width (varied width) of a selection of polylines all at once. (defun c:cutwidth (/ temp cut_name even heaviest_vertex run_again count how_many_cuts vertexlist num_of_vertexes the_selection info question) (if (= width nil) (setq width 0.006)) (if (= percent nil) (setq percent 50)) (setq run_again T) (setq the_selection (ssget)) (setq how_many_cuts (sslength the_selection)) (while (= run_again T) (initget 1 "L W Q") (setq question (getkword "\nWidest width of lines, Location of width, Quit: ")) (if (= question "L") (progn (setq percentstring (rtos percent 2 0)) (setq string (strcat "Enter a length percent of the line that is to be the widest place <" percentstring ">: ")) (setq temp percent) ;used below incase the user doesn't enter a valve it will set it to what it was set at (initget 6) (setq percent (getint string)) (cond ((null percent) (setq percent temp))) )) (if (= question "W") (progn (setq widthstring (rtos width 2 4)) (setq string (strcat "Enter a new max width for plines: click dist or enter valve <" widthstring ">: ")) ;(setq width (getdist "\nEnter a new max width for plines: click dist or enter valve <0.006> ")) (setq temp width) ;used below incase the user doesn't enter a valve it will set it to what it was set at (setq width (getdist string)) (cond ((null width) (setq width temp))) )) (if (= question "Q") (setq run_again nil)) (if (or (= question "L") (= question "W")) (progn (setq count 0) (while (/= count how_many_cuts) (setq cut_name (ssname the_selection count)) ;extracts selection object name (store name in cut_name) (setq count (+ count 1)) ;(setq even "no") (setq what_is_it (cdr(assoc 0(entget cut_name)))) (setq info (entget cut_name)) (if (= what_is_it "POLYLINE") (setq vertexlist (find_vertexes2 cut_name))) ;when you use "fit curve" to a poly line in turns in to the old autocad 2d polyline.. (if (= what_is_it "LWPOLYLINE") (setq vertexlist (find_vertexes info))) (setq num_of_vertexes (length vertexlist)) (setq num_of_vertexes (- num_of_vertexes 1)) (setq temp (* num_of_vertexes percent)) ;cross multiply using 75% (setq uphill ( / temp 100)) (setq downhill (- num_of_vertexes uphill)) (if (= uphill 0) (progn (setq uphill 1) (setq downhill(- downhill 1)))) ;these two lines are incase the percent figuring comes out that one of these is 0... and since that doesn't work set it to 1 (if (= downhill 0) (progn (setq downhill 1) (setq uphill(- uphill 1)))) ;(setq uphill 1) ;(setq downhill (- num_of_vertexes 1)) (if (= what_is_it "POLYLINE") (p_update_width cut_name uphill downhill width vertexlist num_of_vertexes)) (if (= what_is_it "LWPOLYLINE") (plw_update_width cut_name uphill downhill width vertexlist num_of_vertexes)) );end of while loop ));end of if question is equal to L or W ) ) (defun plw_update_width ( cut_name uphill downhill width vertexlist num_of_vertexes / inc_uphill inc_downhill temp skip vertex inc_width going_up subentity current_width count is_it_closed temp vertex vertexlist firstvertex count count entityname subentity kind) (setq inc_uphill (/ width uphill)) (setq inc_downhill (/ width downhill)) (setq current_width 0.0) (setq going_up T) (setq ent_data (entget cut_name)) ;get the data info (setq ent_data_change nil) (setq count 0) (foreach temp ent_data (setq temp2 (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 40 temp2) nil) (progn ;if assoc 40 is in the list do this (setq temp (cons '40 current_width)) (if (>= current_width width) (setq going_up nil)) (if (= going_up nil) (setq current_width (- current_width inc_downhill))) (if (= going_up T) (setq current_width (+ current_width inc_uphill))) ;(if (< current_width 0.0001) (setq current_width 0.0)) )) (if (/= (assoc 41 temp2) nil) (progn ;if assoc 41 is in the list do this (setq temp (cons '41 current_width)) (setq count (+ count 1)) (if (= count num_of_vertexes) (progn ;if this is the last vertex (setq temp (cons '41 0.0)) )) ;if the last time through make sure the ending width is set to 0.0 )) (if (= (assoc 43 temp2) nil) ;if assoc 43 is in the list skip the below code (43 is used in lwpolylines to tell the overall width of all lines and it should be removed if the polyline is to have different widths at each vertex (setq ent_data_change (append ent_data_change (list temp))) ) ;append the new list (dotted pair list) (setq skip nil) ) ;end of foreach loop (entmod ent_data_change) (entupd cut_name) ;(entmake ent_data_change) ) (defun p_update_width ( cut_name uphill downhill width vertexlist num_of_vertexes / inc_uphill inc_downhill ent_data_change count skip vertex inc_width ent_data_change going_up subentity current_width count is_it_closed temp vertex vertexlist firstvertex count count entityname subentity kind) (setq inc_uphill (/ width uphill)) (setq inc_downhill (/ width downhill)) (setq current_width 0.0) (setq going_up T) (setq subentity cut_name) (setq vertex "") (setq count 0) (while (/= vertex nil) (setq count (+ count 1)) (setq subentity (entnext subentity)) (setq vertex (cdr(assoc 10 (entget subentity)))) ;this is just used to find if we are still if there are more vertex to know when to stop looping (setq ent_data (entget subentity)) (setq ent_data_change (subst (cons 40 current_width) (assoc 40 ent_data) ent_data)) ;40 is the starting width (if (>= current_width width) (setq going_up nil) ) (if (= going_up nil) (setq current_width (- current_width inc_downhill))) (if (= going_up T) (setq current_width (+ current_width inc_uphill))) (if (< current_width 0.0001) (setq current_width 0.0)) (setq ent_data_change (subst (cons 41 current_width) (assoc 41 ent_data_change) ent_data_change)) ;41 is the ending width (if (= count num_of_vertexes) ;if this is the last vertex (setq ent_data_change (subst (cons 41 0.0) (assoc 41 ent_data_change) ent_data_change)) ) (entmod ent_data_change) (entupd cut_name) ;change the acad data base and regen the entity (setq skip nil) ) ) ;;;(defun p_update_width ( cut_name heaviest_vertex width vertexlist even / vertex inc_width ent_data_change going_up subentity current_width count is_it_closed temp vertex vertexlist firstvertex count count entityname subentity kind) ;;; (setq inc_width (/ width heaviest_vertex)) ;;; (setq current_width 0.0) ;;; (setq going_up T) ;;; (setq subentity cut_name) ;;; (setq vertex "") ;;; (while (/= vertex nil) ;;; (setq subentity (entnext subentity)) ;;; (setq vertex (cdr(assoc 10 (entget subentity)))) ;this is just used to find if we are still if there are more vertex to know when to stop looping ;;; (setq ent_data (entget subentity)) ;;; (setq ent_data_change (subst (cons 40 current_width) (assoc 40 ent_data) ent_data)) ;40 is the starting width ;;; (if (>= current_width width) (setq going_up nil)) ;;; (if (= going_up nil) (setq current_width (- current_width inc_width))) ;;; (if (= going_up T) (setq current_width (+ current_width inc_width))) ;;; (setq ent_data_change (subst (cons 41 current_width) (assoc 41 ent_data_change) ent_data_change)) ;41 is the ending width ;;; (entmod ent_data_change) (entupd cut_name) ;change the acad data base and regen the entity ;;; ) ;;;) ;;;Assuming that the first entity in the drawing is a 3D polyline with several vertices, the following code modifies and redisplays the polyline: ;;; ;;;(setq e1 (entnext)) ; Sets e1 to the polyline's entity name ;;;(setq e2 (entnext e1)) ; Sets e2 to its first vertex ;;;(setq ed (entget e2)) ; Sets ed to the vertex data ;;;(setq ed ;;; (subst '(10 1.0 2.0) ;;; (assoc 10 ed) ; Changes the vertex's location in ed ;;; ed ; to point (1,2) ;;; ) ;;;) ;;;(entmod ed) ; Moves the vertex in the drawing ;;; ;;;(entupd e1) ; Regenerates the polyline entity e1 ;;; ;;; ;;;;;; (setq subentity (entnext subentity)) ;;;;;; (setq vertex (cdr(assoc 10 (entget subentity)))) ;;;(setq ent_data (cdr (entget subentity))) ;;;(setq ent (entlast)) ;extracts selection object name (store name in ent) ;;;(setq ent_data (entget ent)) ;get the data info ;;;(setq ent_data_change (subst (cons 42 bulge) (assoc 42 ent_data) ent_data )) ;change the bulge dotted pair 42 to the same as the one we are working on...so it is an arc ;;;(entmod ent_data_change)