Problem to Create a loft with intersecting planes (vb)

[dvakondios]

I want to create a solid using VB and loft definition.

I creat each time different planes that have a constant distance in x dimension and a steady rotation each time φ (deg).

On each each plane i sketch the same profile and that is happened for 360 deg.

The problem is that Loft is not made because a line of the profile must follow a line tragectory and all other points must follow a circular tragectory. Also, there is a problem from 180 deg to 360 because there is intersection of profiles.

The result must be a solid similar to snail shell but all the same solid, as a cylindar whith a half sphere in the bottom.

Can somebody help me? please

It is too important for my work.

Thank you!

[MariaManuela]

Hi,

Attach the file here please.

[dvakondios]

Thank you very much for your imediate response!

My code is:

Public Sub gg()

Call CreateDir

Call SetDir

Dim fz, x, Diam, deg, stang, tz, txy As Double

Diam = 20 / 10

fz = 0.6 / 10

tz = 0.6 / 10

txy = 0.6 / 10

deg = 10

stang = 0 'start angle

h = 15 / 10

x = deg * fz / 360

Call BEM(Diam, x, deg, stang, h)

MsgBox ("Done !!!")

End Sub

Public Function SetDir() As String

SetDir = "C:\TasksDVAK\" & Year(Now)

End Function

Public Function CreateDir() As String

Dim SetDir As String

SetDir = "C:\TasksDVAK\" & Year(Now)

End Function

'-----------------------

'-----------------------------

Public Sub BEM(Diam, x, deg, stang, h)

'-----------------------------

Dim oProfile As Profile

Dim oSections As ObjectCollection

Dim oPartDoc1 As PartDocument

Set oPartDoc1 = ThisApplication.Documents.Add(kPartDocumentObject, _

                 ThisApplication.FileManager.GetTemplateFile(kPartDocumentObject))

Dim oPartCompDef As PartComponentDefinition

Set oPartCompDef = oPartDoc1.ComponentDefinition

Dim oTrans As TransientGeometry

Set oTrans = ThisApplication.TransientGeometry

Set oSections = ThisApplication.TransientObjects.CreateObjectCollection

Dim oPnt As Point

Set oPnt = oTrans.CreatePoint(0, 0, 0)

Dim oWorkPoint1 As WorkPoint

Set oWorkPoint1 = oPartCompDef.WorkPoints.AddFixed(oPnt, False)

Dim oWorkPoint2 As WorkPoint

Set oPnt = oTrans.CreatePoint(0, 1, 0)

Set oWorkPoint2 = oPartCompDef.WorkPoints.AddFixed(oPnt, False)

Dim oWorkAxis As WorkAxis

Set oWorkAxis = oPartCompDef.WorkAxes.AddByTwoPoints(oWorkPoint1, oWorkPoint2, False)

Dim oWorkPlane As WorkPlane

Set oWorkPlane = oPartCompDef.WorkPlanes.AddByLinePlaneAndAngle _

   (oWorkAxis, oPartCompDef.WorkPlanes.Item("YZ Plane"), 180 * 4 * Atn(1) / 180, False)

oWorkPlane.Name = "MyWorkPlane"

Dim oCompDef As PartComponentDefinition

Set oCompDef = oPartDoc1.ComponentDefinition

Dim oSketch As PlanarSketch

Set oSketch = oCompDef.Sketches.Add(oWorkPlane)

Dim oTransGeom As TransientGeometry

Set oTransGeom = ThisApplication.TransientGeometry

For i = 0 To 360 / deg

Set oPnt = oTrans.CreatePoint(x * i, 0, 0)

Set oWorkPoint1 = oPartCompDef.WorkPoints.AddFixed(oPnt, False)

Set oPnt = oTrans.CreatePoint(x * i, 0, 1)

Set oWorkPoint2 = oPartCompDef.WorkPoints.AddFixed(oPnt, False)

Set oWorkAxis = oPartCompDef.WorkAxes.AddByTwoPoints(oWorkPoint1, oWorkPoint2, False)

Set oWorkPlane = oPartCompDef.WorkPlanes.AddByLinePlaneAndAngle _

   (oWorkAxis, oPartCompDef.WorkPlanes.Item("MyWorkPlane"), (90 - stang - i * deg) * 4 * Atn(1) / 180, False)

Set oSketch = oCompDef.Sketches.Add(oWorkPlane)

Dim R, Rz, Rr, ar As Double

R = Diam / 2

Rz = Diam / 2

Rr = 0

Dim Mr, Mz, Nr, Nz As Double

Nz = Diam / 2

Nr = Diam / 2

Dim oLines(2 To 4) As SketchLine

Dim oArc(1 To 2) As SketchArc

Set oArc(1) = oSketch.SketchArcs.AddByCenterStartEndPoint(oTransGeom.CreatePoint2d(Rz, 0), oTransGeom.CreatePoint2d(0, 0), _

oTransGeom.CreatePoint2d(Nz, Nr), False)

Set oLines(2) = oSketch.SketchLines.AddByTwoPoints(oArc(1).StartSketchPoint, _

oTransGeom.CreatePoint2d(h, Nr))

Set oLines(3) = oSketch.SketchLines.AddByTwoPoints(oLines(2).EndSketchPoint, _

oTransGeom.CreatePoint2d(h, 0))

Set oLines(4) = oSketch.SketchLines.AddByTwoPoints(oLines(3).EndSketchPoint, _

oArc(1).EndSketchPoint)

Set oProfile = oSketch.Profiles.AddForSolid

 Call oSections.Add(oProfile)

Next i

    Dim oLoftDefinition As LoftDefinition

    Set oLoftDefinition = oPartCompDef.Features.LoftFeatures.CreateLoftDefinition(oSections, kJoinOperation)

    Dim oLof As LoftFeature

    Set oLof = oPartCompDef.Features.LoftFeatures.Add(oLoftDefinition)

    Call oPartDoc1.SaveAs(SetDir() & "Trajectory" & ".ipt", False)

    oPartDoc1.Close

End Sub