How do I use CreateSphere

How do I use CreateSphere

JBEDsol
Collaborator Collaborator
354 Views
1 Reply
Message 1 of 2

How do I use CreateSphere

JBEDsol
Collaborator
Collaborator
Dim tgGeom As TransientGeometry
Set tgGeom = ThisApplication.TransientGeometry
Dim sphWeight As Sphere
Set sphWeight = tgGeom.CreateSphere
 
Not sure how I apply the create sphere command.  What does this command do?  I'm having the dangdest time trying to find anything on this online.
0 Likes
355 Views
1 Reply
Reply (1)
Message 2 of 2

HideoYamada
Advisor
Advisor

Hello JBEDsol,

 

To create a sphere(ball) solid, you must prepare the sketch and add RevolveFeature.

Option Explicit

Const PI = 3.1415926536

Sub test()
    CreateSphere 1, 2, 3, 10
    CreateSphere -3, -2, -1, 5
End Sub

Sub CreateSphere(x As Double, y As Double, z As Double, d As Double)
    Dim pDoc As PartDocument
    Dim pCompDef As PartComponentDefinition
    Set pDoc = ThisApplication.ActiveEditDocument
    Set pCompDef = pDoc.ComponentDefinition
    
    ' Add workplane and make a sketch.
    Dim wp As WorkPlane
    Set wp = pCompDef.WorkPlanes.AddByPlaneAndOffset(pCompDef.WorkPlanes("XY Plane"), z)
    wp.Visible = False
    Dim skt As PlanarSketch
    Set skt = pCompDef.Sketches.Add(wp)
    
    ' Project Center Point of Origin.
    Dim originPoint As SketchPoint
    Set originPoint = skt.AddByProjectingEntity(pCompDef.WorkPoints("Center Point"))
    
    ' Add an Arc to the sketch.
    Dim p2d As Point2d
    Set p2d = ThisApplication.TransientGeometry.CreatePoint2d(x, y)
    Dim sktArc As SketchArc
    Set sktArc = skt.SketchArcs.AddByCenterStartSweepAngle(p2d, d, 0, PI)
    
    ' Add a diameter dimension.
    Dim dimConst As DiameterDimConstraint
    Set dimConst = skt.DimensionConstraints.AddDiameter(sktArc, p2d)
    dimConst.Parameter.Expression = d & "cm"

    ' Add dimensions between center points.
    Dim twoPointDisDim As TwoPointDistanceDimConstraint
    p2d.x = x / 2
    p2d.y = 0
    Set twoPointDisDim = skt.DimensionConstraints.AddTwoPointDistance(originPoint, sktArc.CenterSketchPoint, kHorizontalDim, p2d)
    twoPointDisDim.Parameter.Expression = x & "cm"
    
    p2d.x = 0
    p2d.y = y / 2
    Set twoPointDisDim = skt.DimensionConstraints.AddTwoPointDistance(originPoint, sktArc.CenterSketchPoint, kVerticalDim, p2d)
    twoPointDisDim.Parameter.Expression = y & "cm"
    
    ' Add an Axis line.
    Dim sktLine As SketchLine
    Set sktLine = skt.SketchLines.AddByTwoPoints(sktArc.StartSketchPoint, sktArc.EndSketchPoint)
    sktLine.Centerline = True
    
    ' Add constraints to the line.
    skt.GeometricConstraints.AddCoincident sktLine, sktArc.CenterSketchPoint
    skt.GeometricConstraints.AddHorizontal sktLine
    
    ' Create RevolveFeature
    pCompDef.Features.RevolveFeatures.AddFull skt.Profiles.AddForSolid, sktLine, kNewBodyOperation
End Sub

Executing test() causes the result as follows :

Capture.PNG

 

=====

Freeradical

 Hideo Yamada

 

 

=====
Freeradical
 Hideo Yamada
https://www.freeradical.jp
0 Likes