Omrekenen naar 32 mm systeem
If opt32mm = True Then
Lengte = ((Int((Lengte - Dikte) / 32) * 32) + Dikte)
Breedte = ((Int((Breedte - (2 * 37)) / 32)) * 32) + (2 * 37)
Aanmaken constructieblok + uitgangsmateriaal
Dim Constructieblok As Path
Set Constructieblok = drw.CreateRectangle(0, 0, Lengte, Breedte)
Constructieblok.SetWorkVolume 0, -Dikte 'maken cnstr blok
Dim Uitgangsmateriaal As Path
Set Uitgangsmateriaal = drw.CreateRectangle(-5, -5, Lengte + 5, Breedte + 5)
Uitgangsmateriaal.SetMaterial 0, -Dikte
Aanmaken werkvlak (0-punt,punt waar x naar wijst, punt waar z naar wijst)
Dim BovenVlak As WorkPlane
Set BovenVlak = drw.CreateWorkPlane(0, 0, 0, Lengte, 0, 0, 0, Breedte, 0)
drw.SetWorkPlane BovenVlak
Contour frezen !juiste werkvlak actief maken
1. Tekenen contour
Dim Contour As Path
Set Contour = drw.CreateRectangle(0, 0, Lengte, Breedte)
2. Gereedschap definiëren
Dim ContourFrees As MillTool
On Error Resume Next '(foutmeldingen uitschakelen)
Set ContourFrees = App.SelectTool(App.LicomdatPath & "\licomdat\tools hout\rechte frezen\
recht 20_diamant.art")
On Error GoTo 0 '(foutmeldignen weer aan)
'foutmelding als frees niet gevonden
If ContourFrees Is Nothing Then
, MsgBox "selecteer zelf een gereedschap aub", vbCritical, "GEREEDDSCHAP NIET
GEVONDEN!"
Set ContourFrees = App.SelectTool("$user")
End If
3. Bewerkingsrichting
With Contour
.SetStartPoint Lengte / 2, 0 'startpunt
.CW = False 'ccw
.Selected = True 'selecteer contour
.ToolInOut = acamOUTSIDE 'frees buitenkand
End With
4. Freesbewerking definiëren
Dim ContourFreesGegevens As MillData
Set ContourFreesGegevens = App.CreateMillData
With ContourFreesGegevens
.FinalDepth = -Dikte - 1
.MaterialTop = 0
.NumberOfCuts = 1
.OffsetNumber = 100 'correctieadres
.SafeRapidLevel = 50 'vrijloop
.RapidDownTo = 10 'aanloop
.Stock = 0 'toeslag
.XYCorners = acamCornersSTRAIGHT 'rechte frees hoeken
'extra opties onder alphacam opties / vba macro's / help alphacam api
End With
5. Frezen zelf
Dim ContourFrezing As Paths
Set ContourFrezing = ContourFreesGegevens.RoughFinish
ContourFrezing.Item(1).SetLeadInOutAuto acamLeadBOTH, acamLeadBOTH , 2, 2, 45, True, True,
10 'in en uitloop instellingen
If opt32mm = True Then
Lengte = ((Int((Lengte - Dikte) / 32) * 32) + Dikte)
Breedte = ((Int((Breedte - (2 * 37)) / 32)) * 32) + (2 * 37)
Aanmaken constructieblok + uitgangsmateriaal
Dim Constructieblok As Path
Set Constructieblok = drw.CreateRectangle(0, 0, Lengte, Breedte)
Constructieblok.SetWorkVolume 0, -Dikte 'maken cnstr blok
Dim Uitgangsmateriaal As Path
Set Uitgangsmateriaal = drw.CreateRectangle(-5, -5, Lengte + 5, Breedte + 5)
Uitgangsmateriaal.SetMaterial 0, -Dikte
Aanmaken werkvlak (0-punt,punt waar x naar wijst, punt waar z naar wijst)
Dim BovenVlak As WorkPlane
Set BovenVlak = drw.CreateWorkPlane(0, 0, 0, Lengte, 0, 0, 0, Breedte, 0)
drw.SetWorkPlane BovenVlak
Contour frezen !juiste werkvlak actief maken
1. Tekenen contour
Dim Contour As Path
Set Contour = drw.CreateRectangle(0, 0, Lengte, Breedte)
2. Gereedschap definiëren
Dim ContourFrees As MillTool
On Error Resume Next '(foutmeldingen uitschakelen)
Set ContourFrees = App.SelectTool(App.LicomdatPath & "\licomdat\tools hout\rechte frezen\
recht 20_diamant.art")
On Error GoTo 0 '(foutmeldignen weer aan)
'foutmelding als frees niet gevonden
If ContourFrees Is Nothing Then
, MsgBox "selecteer zelf een gereedschap aub", vbCritical, "GEREEDDSCHAP NIET
GEVONDEN!"
Set ContourFrees = App.SelectTool("$user")
End If
3. Bewerkingsrichting
With Contour
.SetStartPoint Lengte / 2, 0 'startpunt
.CW = False 'ccw
.Selected = True 'selecteer contour
.ToolInOut = acamOUTSIDE 'frees buitenkand
End With
4. Freesbewerking definiëren
Dim ContourFreesGegevens As MillData
Set ContourFreesGegevens = App.CreateMillData
With ContourFreesGegevens
.FinalDepth = -Dikte - 1
.MaterialTop = 0
.NumberOfCuts = 1
.OffsetNumber = 100 'correctieadres
.SafeRapidLevel = 50 'vrijloop
.RapidDownTo = 10 'aanloop
.Stock = 0 'toeslag
.XYCorners = acamCornersSTRAIGHT 'rechte frees hoeken
'extra opties onder alphacam opties / vba macro's / help alphacam api
End With
5. Frezen zelf
Dim ContourFrezing As Paths
Set ContourFrezing = ContourFreesGegevens.RoughFinish
ContourFrezing.Item(1).SetLeadInOutAuto acamLeadBOTH, acamLeadBOTH , 2, 2, 45, True, True,
10 'in en uitloop instellingen
