'
' -VB/CAM-
'
' Written by Chris Lamrock, 2003
'
' chris@blackwidowguitars.com
'
Dim tb
Dim w
Dim returnObj As Object ' Define the returnobj for the 3d polyline
Dim basepnt As Variant ' Some def for the autcad stuff
Dim points(0 To 2) As Double ' Define more stuff for the points
Dim px(10000) As Variant ' Define point Array for X
Dim py(10000) As Variant ' Define point Array for Y
Dim pz(10000) As Variant ' Define point array for Z
Dim retcoord As Variant ' Define the return Cooridinate stuff
Private Sub exit_vbcam_Click()
vbcam.hide
End
End Sub
Private Sub Label2_Click()
End Sub
Private Sub pick_path_Click()
On Error GoTo errhand
' Hide the vb/cam form
vbcam.hide
' Make the Acad Visible and
' Prompt for 3d polyline
ThisDrawing.Application.Visible = acTrue
ThisDrawing.Utility.GetEntity returnObj, basepnt, "Select 3d Polyline."
If Err <> 0 Then
Err.Clear
MsgBox "An Error Has Occured", , Bye
Else
' Set the picked object to red - to show what was picked
' Update the screen
returnObj.Color = acRed
returnObj.Update
' Next we need to grab all of the coordinates of the polyline
retcoord = returnObj.Coordinates
' Count the points here - c is the number of points in the polyline
c = 0
For Each point In retcoord
c = c + 1
Next
' Now we separate the points into x, y and z arrays - very straight forward
a = 0
For w = 0 To c - 1 Step 3
px(a) = retcoord(w)
py(a) = retcoord(w + 1)
pz(a) = retcoord(w + 2)
a = a + 1
Next w
' Update status line - to show we have picked a polyline with valid points
status.Text = "Picked path with " + Str$(a) + " points."
End If
vbcam.Show
' Setup some error handling here
' You must pick a 3d polyline or vb/cad
' won't work.
errhand:
MsgBox "Please Pick a 3D Polyline", , Error
Err.Clear
vbcam.Show
End Sub
Private Sub points_in_path_Change()
End Sub
Private Sub reset_Click()
o_number.Text = ""
tool_number.Text = ""
rpm.Text = ""
z_clear.Text = ""
approach_feed.Text = ""
cut_feed.Text = ""
program_name.Text = ""
comment.Text = ""
status.Text = "Ready for Path Selection" ' Init status line
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
status.Text = "Ready for Path Selection" ' Init status line
End Sub
Private Sub write_file_Click()
If program_name.Text = "" Then
MsgBox "You must enter a program name", , Error
Err.Clear
Else
' Set up the program name to write.
' The program name should consist of the complete path
' and filename you wish to write.
' For example c:\cnc_programs\rough.cnc
' c will now be the number of the 3d point on the path
' that we are working with.
' Let's open the file & post it out
program_name = Trim(program_name.Text)
c = 0
Open program_name For Output As #1
'---------------------------------------------------------
'
'
' Following is one of the areas you may need to modify
' to make vb/cam work with your specific CNC machine
'
' The following setup works on a HAAS VF-3 and VF-6
' and probably most Vertical HAAS machines
'
' You may need to check with your CNC Manual for help
'
' Also block 40 (N40) is hard coded with the G58 work coordinate
' You might need to change this to your normal wcs.
'
'===========================================================
Print #1, "%" ' Our HAAS machines require this at the beginning of all programs
Print #1, "O" + Trim(o_number.Text) + " (" + Trim(comment.Text) + ") " 'This posts the O number for the program and also the comment on this line
Print #1, "N10 G53 G00 G40 G49 G80 G90" ' These are our standard setup G codes
Print #1, "N20 T" + Trim(tool_number.Text) + " H" + Trim(tool_number.Text) + " M06" 'This sets up the Tool number and Tool offset measure
Print #1, "N30 S" + Trim(rpm.Text) + " M03" ' Set spindle RPM & turn it on
'============================================================
Print #1, "N40 G58 G43 G00 Z" + Format(z_clear.Text, "##0.0000") ' Now lets locate the in Z to our clearance Height
Print #1, "N50 X" + Format(px(c), "##0.0000") + " Y" + Format(py(c), "##0.0000") ' Now we move to our 1st X,Y position at our Z clearance Height
Print #1, "N60 Z" + Format(pz(c), "##0.0000") ' And now down to our 1st Z point
c = 1 ' Move our pointer to our next x,y,z point
Print #1, "N70 G01 X" + Format(px(c), "##0.0000") + " Y" + Format(py(c), "##0.0000") + " Z" + Format(pz(c), "##0.0000") + " F" + Format(approach_feed.Text, "##0.") ' Move to our next point at our approach feed
c = 2 ' Move our pointer to the next point
Print #1, "N80 G01 X" + Format(px(c), "##0.0000") + " Y" + Format(py(c), "##0.0000") + " Z" + Format(pz(c), "##0.0000") + " F" + Format(cut_feed.Text, "##0.") ' Move to our next point at our Cut feed
' Ok - here's the guts of the post
' We read a point & post it out until they are done
' We'll start at N100 and go from there by 2's
' how many points again? w/3
n = -2
tb = w / 3
For c = 2 To tb - 2
n = n + 2
Print #1, "N" + LTrim(Str(n + 100)) + " G01 X" + Format(px(c), "##0.0000") + " Y" + Format(py(c), "##0.0000") + " Z" + Format(pz(c), "##0.0000")
Next c
'-----------------------------------------------------------
'
'
' Following this area is another that may need tweaking
' It is what comes at the end of our CNC program
'
' You may need to consult your cnc manual again for this info
'
'
'=============================================================
Print #1, "N" + LTrim(Str(n + 100)) + " G01 X" + Format(px(c), "##0.0000") + " Y" + Format(py(c), "##0.0000") + " Z" + Format(pz(c), "##0.0000") + " F" + Format(approach_feed.Text, "##0.") ' Move the tool off the part on the lead-out line at appraoch feed
Print #1, "N" + LTrim(Str(n + 102)) + " G00 Z" + Format(z_clear.Text, "##0.0000") ' This returns the machine to our Z clearance Height at Rapid feed
Print #1, "N" + LTrim(Str(n + 104)) + " G00 G91 G28 Z0.0000" ' This resets some of the G settings & returns the machine to HOME Z - note this is not program 0
Print #1, "N" + LTrim(Str(n + 106)) + " G91 G28 Y0.0000" ' Maybe overkill here but better to be safe than sorry & move the table to Y0 - so we can get at the parts easier
Print #1, "N" + LTrim(Str(n + 108)) + " M30" ' That's it!
Print #1, "%" ' This tells the machine the this is the end of the program
Close #1
'==============================================================
status.Text = "Wrote File"
End If
End Sub
               (
geocities.com/wpsmoke/acadmdt)                   (
geocities.com/wpsmoke)