Help with 3d shape

[Anonymous]

I am working on this shape, i made the lower platform of the picture, but dont have an idea how add these "shapes" on platform.
Here is my code so far:

Option Explicit
Const pi As Double = 3.14159265358979

Public Sub z5(r1 As Double, r2 As Double, n As Integer)
Dim cp(0 To 2) As Double, d As Double, ang As Double, br As Integer, curang As Double

Dim ms As AcadModelSpace: Set ms = ThisDrawing.ModelSpace
Dim solid1 As Acad3DSolid, solid2 As Acad3DSolid, solid3 As Acad3DSolid
ang = 2 * pi / n
d = (r2 - r1) / 4
Set solid1 = ms.AddCylinder(cp, r2, d)
Set solid2 = ms.AddCylinder(cp, r1, d)
Call solid1.Boolean(acSubtraction, solid2)
End Sub

[Ed__Jobe]

A quick review shows that,  1. a Sub cannot have arguments, only a Function can. 2. You Dim a lot of variables, but none are assigned a value, they are all empty. The only one you assigned to is pi. And some vars are declared but unused. 3. Your last statement doesn't need Call. Just assign it to variable solid3.

Also, post your code in a code window. It keeps the formatting and is easier to read. Use the </> button.

Set solid3 = solid1.Boolean(acSubtraction, solid2)

See this help topic for some sample code.

[Anonymous]

Um I know that, but that does not help me.

[parikhnidi]

Hi,

The best way to handle this issue is through class module that will help you in organizing your program very effectively.

First step is class module. Here you define your all properties to be used. Also, here you will arrive at the calculated values like D in your code. The draw method in this class module does all heavy lifting for you.

Class Module Code

In this code I have converted angle 60° in your drawing as a variable. This will add flexibility of setting any angle desired.

Option Explicit

Private pi As Double

Private mRadius1 As Double
Private mRadius2 As Double
Private mAngle As Double
Private mSlotCount As Integer

Private mLocation As Variant
Private mStartAngle As Double

Private mConeHeight As Double
Private mComponentHeight As Double
Private mCompThickness As Double
'=================
Public Property Let Radius1(pRadius1 As Double)
    mRadius1 = pRadius1
    CalcCompThk
End Property
Public Property Get Radius1() As Double
    Radius1 = mRadius1
End Property
'=================
Public Property Let Radius2(pRadius2 As Double)
    mRadius2 = pRadius2
    CalcMainConeHeight
    CalcCompHeight
    CalcCompThk
End Property
Public Property Get Radius2() As Double
    Radius2 = mRadius2
End Property
'=================
Public Property Let Angle(pAngle As Double)
    mAngle = pAngle
    CalcMainConeHeight
End Property
Public Property Get Angle() As Double
    Angle = mAngle
End Property
'=================
Public Property Let SlotCount(pSlotCount As Integer)
    mSlotCount = pSlotCount
End Property
Public Property Get SlotCount() As Integer
    SlotCount = mSlotCount
End Property
'=================
Public Property Let Location(pLocation As Variant)
    mLocation = pLocation
End Property
Public Property Get Location() As Variant
    Location = mLocation
End Property
'=================
Public Property Let StartAngle(pStartAngle As Double)
    mStartAngle = pStartAngle
End Property
Public Property Get StartAngle() As Double
    StartAngle = mStartAngle
End Property
'=================
Public Property Get ConeHeight() As Double
    ConeHeight = mConeHeight
End Property
'=================
Public Sub Draw()
    Dim cone1 As Acad3DSolid
    Dim cone2 As Acad3DSolid
    Dim cone3 As Acad3DSolid
    Dim cyl As Acad3DSolid
    Dim box As Acad3DSolid
    
    Dim tempLoc(0 To 2)  As Double
    
    tempLoc(0) = mLocation(0)
    tempLoc(1) = mLocation(1)
    tempLoc(2) = mLocation(2) + mConeHeight / 2
    
    Set cone1 = ThisDrawing.ModelSpace.AddCone(tempLoc, mRadius2, mConeHeight)
    
    Dim tempConeHeight As Double
    tempConeHeight = mConeHeight - mComponentHeight
    
    tempLoc(0) = mLocation(0)
    tempLoc(1) = mLocation(1)
    tempLoc(2) = mLocation(2) + mComponentHeight + tempConeHeight / 2
    
    Set cone2 = ThisDrawing.ModelSpace.AddCone(tempLoc, mRadius2 * (1 - Tan(pi / 2 - mAngle) / 2), tempConeHeight)
    
    cone1.Boolean acSubtraction, cone2
    
    Dim tempX As Double
    tempX = mCompThickness / Tan(mAngle / 2)
    tempConeHeight = (mRadius2 - tempX) * Tan(mAngle)
    
    tempLoc(0) = mLocation(0)
    tempLoc(1) = mLocation(1)
    tempLoc(2) = mLocation(2) + mCompThickness + tempConeHeight / 2
    
    Set cone3 = ThisDrawing.ModelSpace.AddCone(tempLoc, mRadius2 - tempX, tempConeHeight)
    cone1.Boolean acSubtraction, cone3
    
    tempLoc(0) = mLocation(0)
    tempLoc(1) = mLocation(1)
    tempLoc(2) = mLocation(2) + mCompThickness / 2
    
    Set cyl = ThisDrawing.ModelSpace.AddCylinder(tempLoc, mRadius1, mCompThickness)
    cone1.Boolean acSubtraction, cyl
    
    Dim i As Integer
    Dim inclAngle As Double
    inclAngle = 2 * pi / mSlotCount
    
    tempLoc(0) = mLocation(0)
    tempLoc(1) = mLocation(1)
    tempLoc(2) = mCompThickness + (mComponentHeight - mCompThickness) / 2
    
    For i = 1 To mSlotCount / 2
    
        Set box = ThisDrawing.ModelSpace.AddBox(tempLoc, 2 * mRadius2, mCompThickness, mComponentHeight - mCompThickness)
        box.Rotate mLocation, mStartAngle + (i - 1) * inclAngle
        cone1.Boolean acSubtraction, box
    Next i
    cone1.Update
    
    Set cone1 = Nothing
    Set cone2 = Nothing
    Set cone3 = Nothing
    Set cyl = Nothing
    Set box = Nothing
    
End Sub

Private Sub Class_Initialize()
    
    pi = 4 * Atn(1)
    
    mRadius1 = 100
    mRadius2 = 300
    mSlotCount = 8
    mAngle = pi / 3
    mStartAngle = 0
    
    CalcMainConeHeight
    CalcCompHeight
    CalcCompThk
    
End Sub

Private Sub CalcMainConeHeight()
    mConeHeight = mRadius2 * Tan(mAngle)
End Sub
Private Sub CalcCompHeight()
    mComponentHeight = mRadius2 / 2
End Sub
Private Sub CalcCompThk()
    mCompThickness = (mRadius2 - mRadius1) / 4
End Sub

Second step is to use this class in your regular function. Here is the code that uses the class module defined above.

Calling Function

Option Explicit

Public Function DrawPart()
    Dim pi As Double
    
    Dim Radius1 As Double
    Dim Radius2 As Double
    Dim Angle As Double
    Dim SlotCount As Integer
    
    Dim StartAngle As Double

    Dim loc(0 To 2) As Double
    
    pi = 4 * Atn(1)
    
    Dim myPart As clsComponent
    Set myPart = New clsComponent
    
    With myPart
        loc(0) = 1000
        loc(1) = 2000
        loc(2) = 0
        
        .Radius1 = 100
        .Radius2 = 400
        .Angle = 60 * pi / 180
        .SlotCount = 10
        .Location = loc
        .StartAngle = 0
        .Draw
    End With

    Set myPart = Nothing
End Function

I am sure, you will like this.

Thanks,

Nimish

PS: I will document the geometric calculations for your ready reference as I get time in the future.