'
'             -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

    Source: geocities.com/wpsmoke/acadmdt/vbacam

               ( geocities.com/wpsmoke/acadmdt)                   ( geocities.com/wpsmoke)