[Tebernus]

Merhaba.

Alphacam VBA ile iki çizgi ile Yüzey olu?turmak istiyorum.

Yüzey olu?tumak için örnek program kodlar?na ihtiyac?m var.

yard?mlar?n?z? bekliyorum.

[Maroslav4]

Hello,

check this code.

Option Explicit
Public Sub surfaceCreate()

Dim drw As Drawing
Set drw = App.ActiveDrawing

Dim SurRec As Path
Set SurRec = drw.CreateRectangle(0, 0, 1000, 500)
drw.CreateSurfaceFlat SurRec
End Sub



https://drive.google.com/file/d/1jmF...usp=share_link

[Tebernus]

Merhaba. ilginiz icin tesekkur ederim. istedigim 3D Surface olusturmak. Sizin orneginiz Flat Surface. 3dPolyLine ile yüzey olu?turmak istiyorum. 3dPolyLine ile Path yapamiyorum. bir video çekip atmayi deneyecegim.

[Tebernus]

3D yüzey örnek

[Maroslav4]

In this case is code very similar.

Option Explicit
Public Sub surfaceCreate()

Dim drw As Drawing
Set drw = App.ActiveDrawing


Dim SurPoly_1 As PolyLine
Dim geo_sur1 As Path
Set SurPoly_1 = drw.Create3DPolyline(0, 0, 0)
SurPoly_1.AddLine 100, 0, 40
Set geo_sur1 = SurPoly_1.Finish

Dim SurPoly_2 As PolyLine
Dim geo_sur2 As Path
Set SurPoly_2 = drw.Create3DPolyline(0, 200, 0)
SurPoly_2.AddLine 100, 200, 40
Set geo_sur2 = SurPoly_2.Finish


Dim tolerance As Double
tolerance = 0.1

drw.CreateSurfaceRuled geo_sur1, geo_sur2, tolerance
End Sub

https://drive.google.com/file/d/11CJ...usp=share_link

[Tebernus]

I've tested it.
Thank you very much. Thank you very much. Thank you very much.
Thank you very much. Thank you very much. Thank you very much.
Thank you very much. Thank you very much. Thank you very much.
Thank you very much. Thank you very much. Thank you very much.
Thank you very much. Thank you very much. Thank you very much.
Thank you very much. Thank you very much. Thank you very much.

[Tebernus]

Dim Sf As Surface
Set Sf = pC.CreateSurfaceRuled(geo_sur1, geo_sur2, tolerance)
Sf.Redraw
Sf.Selected = True

mc.ChordError = 0.1
mc.MachineSurfaces

Sf.Selected command not select surface



https://youtu.be/panGGGYZkYY

How To Toolpath Surface 3dProject

[Maroslav4]

Code should look something like this.
Option Explicit
Public Sub surfaceCreate()

Dim drw As Drawing
Set drw = App.ActiveDrawing


Dim SurPoly_1 As PolyLine
Dim geo_sur1 As Path
Set SurPoly_1 = drw.Create3DPolyline(0, 0, 0)
SurPoly_1.AddLine 100, 0, 40
Set geo_sur1 = SurPoly_1.Finish

Dim SurPoly_2 As PolyLine
Dim geo_sur2 As Path
Set SurPoly_2 = drw.Create3DPolyline(0, 200, 0)
SurPoly_2.AddLine 100, 200, 40
Set geo_sur2 = SurPoly_2.Finish


Dim tolerance As Double
tolerance = 0.1


Dim M1 As Surface
Set M1 = drw.CreateSurfaceRuled(geo_sur1, geo_sur2, tolerance)
M1.Selected = True


App.SelectTool App.LicomdatPath & "licomdat\rtools.alp\Bull Nose - 10mm x 1.5mm rad.art"
Dim MD As MillData
Set MD = App.CreateMillData
MD.ChordError = 0.1
MD.WidthOfCut = 0.5
MD.SetSurfaceMCPoints 20, 20, 0, 30, 20, 0
MD.SurfaceMCAction = acamSurfaceMCActionMCSURFACES
MD.SurfaceMCMethod = acamSurfaceMCPARAMETER_LINES
MD.MachineSurfaces
End Sub