Is it posible to draw opaque cylinder surfaces in tchart.ocx

TeeChart for ActiveX, COM and ASP
Post Reply
QuijoteMx
Newbie
Newbie
Posts: 13
Joined: Wed Mar 24, 2021 12:00 am
Location: Mexico

Is it posible to draw opaque cylinder surfaces in tchart.ocx

Post by QuijoteMx » Sun May 23, 2021 5:58 pm

Hi!
I want to draw 3D objetcts like the picture number one. It has to have opaque flat walls and sections of the upper wall of every wall has to be cylindrical.

Till now, I managed to do several first downs but I'm still in my forties. I need to draw cylindrical surface opaque sections. My achievements are shown in picture number two.

Is there way to draw a cylindrical opaque section surface with axis parallel to the depth axis?

any hint ?

Thanks ...
Celdas 01.jpeg
Picture number 1
Celdas 01.jpeg (30.46 KiB) Viewed 73427 times
Celdas 02.jpeg
Picture number 2
Celdas 02.jpeg (106.75 KiB) Viewed 73427 times

Yeray
Site Admin
Site Admin
Posts: 9622
Joined: Tue Dec 05, 2006 12:00 am
Location: Girona, Catalonia
Contact:

Re: Is it posible to draw opaque cylinder surfaces in tchart.ocx

Post by Yeray » Mon May 24, 2021 10:59 am

Hello,

I've been playing with your project from here and found the functions we provide don't allow to draw some polygons so I've added this to the public tracker (#2427).
Best Regards,
ImageYeray Alonso
Development & Support
Steema Software
Av. Montilivi 33, 17003 Girona, Catalonia (SP)
Image Image Image Image Image Image Please read our Bug Fixing Policy

QuijoteMx
Newbie
Newbie
Posts: 13
Joined: Wed Mar 24, 2021 12:00 am
Location: Mexico

Re: Is it posible to draw opaque cylinder surfaces in tchart.ocx

Post by QuijoteMx » Mon May 31, 2021 4:46 pm

Hi!

Is there any advance in this topic?

Yeray
Site Admin
Site Admin
Posts: 9622
Joined: Tue Dec 05, 2006 12:00 am
Location: Girona, Catalonia
Contact:

Re: Is it posible to draw opaque cylinder surfaces in tchart.ocx

Post by Yeray » Thu Jun 03, 2021 5:43 pm

Hello,

With Polygon3D (#2427) function you'll be able to get this:

polygon3D.png
polygon3D.png (71.49 KiB) Viewed 73074 times

Note that's still not a real arc. So it's done by drawing polygons side by side.

Code: Select all

Option Explicit

Private Const HORZSIZE = 4
Private Const VERTSIZE = 6
Private Const arcSteps = 360

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Dim newSeries As Integer
Dim planeType(1000) As String '  Vector to define plane type, XY, XZ, YZ, oblique
Dim notFinished As Boolean

Private Sub Form_Load()
  TeeCommander1.ChartLink = TChart1.ChartLink
  prepareChart
End Sub

Private Sub prepareChart()
  Dim x, z As Integer

  TChart1.RemoveAllSeries
  TeeCommander1.Chart = TChart1
  
  TChart1.Aspect.Zoom = 100
  TChart1.Aspect.Orthogonal = True
  TChart1.Aspect.Chart3DPercent = 100
  TChart1.Legend.Visible = False
  TChart1.Aspect.Rotation = 326
  TChart1.Aspect.HorizOffset = 0
  TChart1.Aspect.VertOffset = -170
  TChart1.Aspect.Elevation = 326
  
  TChart1.Aspect.Orthogonal = False
  TChart1.Aspect.Zoom = 75

'  TChart1.Axis.Visible = False
  TChart1.Axis.Bottom.Visible = True ' CheckBox1.Value
  TChart1.Axis.Depth.Visible = True ' CheckBox2.Value
  TChart1.Axis.Left.Visible = True ' CheckBox3.Value
    
  TChart1.Axis.Bottom.Automatic = False
  TChart1.Axis.Bottom.Maximum = 100 ' TextBox1.Text
  TChart1.Axis.Bottom.Minimum = 0
  
  TChart1.Axis.Depth.Automatic = False
  TChart1.Axis.Depth.Maximum = 100 ' TextBox2.Text
  TChart1.Axis.Depth.Minimum = 0
  
  TChart1.Axis.Left.Automatic = False
  TChart1.Axis.Left.Maximum = 100 ' TextBox3.Text
  TChart1.Axis.Left.Minimum = 0
  
  TChart1.Walls.Visible = False

'  TChart1.AddSeries scPoint3D

   do_theChart
End Sub

Private Sub do_theChart()
    Dim Largo, Ancho, Alto, eCaja As Single
    
    Largo = 90 ' Cells(4, 2)
    Ancho = 45 ' Cells(4, 3)
    Alto = 30 ' Cells(4, 4)
    eCaja = 5 ' Cells(4, 5)
    
    TChart1.Aspect.OpenGL.Active = True
    
    notFinished = True
    drawBox3d TChart1, Largo, Ancho, Alto, eCaja
    
    'makeIsoAxisBis TChart1
    notFinished = False
End Sub

Private Sub drawBox3d(theChart As TChart, Largo, Ancho, Alto, eCaja)
  Dim newSeries As Integer
  Dim rads As Double
  Dim i, j As Integer
  Dim x0, y0, z0, x1, y1, z1

  Dim Angle

        'drawSolidWall theChart, 0, 0, 0, "XY", Largo, Alto, eCaja
        'drawSolidWall theChart, 0, 0, Ancho - eCaja, "XY", Largo, Alto, eCaja

        drawSolidWall theChart, 0, 0, 0, "XZ", Largo, Ancho, eCaja
        drawSolidWall theChart, 0, Alto - eCaja, 0, "XZ", Largo, Ancho, eCaja

        'drawSolidWall theChart, 0, 0, 0, "YZ", Ancho, Alto, eCaja
        'drawSolidWall theChart, Largo - eCaja, 0, 0, "YZ", Ancho, Alto, eCaja
End Sub

Private Sub drawSolidWall(theChart As TChart, x0, y0, z0, plane, wLargo, wAlto, wEspesor)
    Dim Radio As Single
      Radio = wLargo / 4
      Select Case UCase(plane)
      Case "XY"
'            makeXYPlane theChart, x0, y0, z0, x0 + wLargo, y0 + wAlto, z0
'            makeXYPlane theChart, x0, y0, z0, x0 + wLargo, y0 + wAlto, z0 + wEspesor
'            makeYZPlane theChart, x0, y0, z0, x0, y0 + wAlto, z0 + wEspesor
'            makeYZPlane theChart, x0 + wLargo, y0, z0, x0 + wLargo, y0 + wAlto, z0 + wEspesor
'            makeXZPlane theChart, x0, y0, z0, x0 + wLargo, y0, z0 + wEspesor
'            makeXZPlane theChart, x0, y0 + wAlto, z0, x0 + wLargo, y0 + wAlto, z0 + wEspesor
      Case "XZ"
            makeXYPlaneZ theChart, x0, y0, z0, x0 + wLargo, y0 + wEspesor, z0, Radio, wLargo / 2
            makeXYPlane theChart, x0, y0, z0, x0 + wLargo, y0 + wEspesor, z0 + wAlto
            makeYZPlane theChart, x0, y0, z0, x0, y0 + wEspesor, z0 + wAlto
            makeYZPlane theChart, x0 + wLargo, y0, z0, x0 + wLargo, y0 + wEspesor, z0 + wAlto
            makeXZPlaneH theChart, x0, y0, z0, x0 + wLargo, y0, z0 + wAlto, Radio, wLargo / 2
            makeXZPlaneH theChart, x0, y0 + wEspesor, z0, x0 + wLargo, y0 + wEspesor, z0 + wAlto, Radio, wLargo / 2
      Case "YZ"
'            makeXYPlane theChart, x0, y0, z0, x0 + wEspesor, y0 + wAlto, z0
'            makeXYPlane theChart, x0, y0, z0, x0 + wEspesor, y0 + wAlto, z0 + wLargo
'            makeYZPlane theChart, x0, y0, z0, x0, y0 + wAlto, z0 + wLargo
'            makeYZPlane theChart, x0 + wEspesor, y0, z0, x0 + wEspesor, y0 + wAlto, z0 + wLargo
'            makeXZPlane theChart, x0, y0, z0, x0 + wEspesor, y0, z0 + wLargo
'            makeXZPlane theChart, x0, y0 + wAlto, z0, x0 + wEspesor, y0 + wAlto, z0 + wLargo
      End Select
End Sub

Private Sub makeXYPlane(theChart As TChart, x0, y0, z0, x1, y1, z1)
        addpoint3dSeriesBis theChart, newSeries
        With theChart
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z1, "0", clTeeColor 'Punto 0
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z1, "1", clTeeColor ' Punto 1
                .Series(newSeries).asPoint3D.AddXYZ x1, y1, z1, "2", clTeeColor ' Punto 2
                .Series(newSeries).asPoint3D.AddXYZ x0, y1, z1, "3", clTeeColor  ' Punto 3
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z1, "4", clTeeColor  ' Punto 4
        End With
        planeType(newSeries) = "XY"

End Sub

Private Sub makeXYPlaneZ(theChart As TChart, x0, y0, z0, x1, y1, z1, rad, pos)
        addpoint3dSeriesBis theChart, newSeries
        Dim i As Single
        Dim r, d, pi As Double
        pi = 4 * Atn(1)
        d = 180 / arcSteps
        With theChart
            For i = 0 To arcSteps - 1
                r = i * d * pi / 180 - 90 * pi / 180
                .Series(newSeries).asPoint3D.AddXYZ pos - rad * Sin(r), y0, rad * Cos(r), "arc", clTeeColor
            Next i
        
                .Series(newSeries).asPoint3D.AddXYZ pos - rad, y0, z1, "0", clTeeColor ' Punto 0
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z1, "1", clTeeColor 'Punto 1
                .Series(newSeries).asPoint3D.AddXYZ x0, y1, z1, "2", clTeeColor  ' Punto 2
                .Series(newSeries).asPoint3D.AddXYZ pos - rad, y1, z1, "3", clTeeColor ' Punto 3
                .Series(newSeries).asPoint3D.AddXYZ pos - rad, y0, z1, "4", clTeeColor ' Punto 4


            For i = arcSteps To 1 Step -1
                r = i * d * pi / 180 - 90 * pi / 180
                .Series(newSeries).asPoint3D.AddXYZ pos - rad * Sin(r), y1, rad * Cos(r), "arc", clTeeColor
            Next i

                .Series(newSeries).asPoint3D.AddXYZ pos + rad, y1, z1, "0", clTeeColor ' Punto 0
                .Series(newSeries).asPoint3D.AddXYZ pos + rad, y0, z1, "1", clTeeColor ' Punto 1
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z1, "2", clTeeColor 'Punto 2
                .Series(newSeries).asPoint3D.AddXYZ x1, y1, z1, "3", clTeeColor 'Punto 3
                .Series(newSeries).asPoint3D.AddXYZ pos + rad, y1, z1, "4", clTeeColor ' Punto 4
        End With
        planeType(newSeries) = "XYZ"

End Sub

Private Sub makeYZPlane(theChart As TChart, x0, y0, z0, x1, y1, z1)
        addpoint3dSeriesBis theChart, newSeries
        With theChart
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z0, "0", clTeeColor 'Punto 0
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z1, "1", clTeeColor ' Punto 1
                .Series(newSeries).asPoint3D.AddXYZ x1, y1, z1, "2", clTeeColor ' Punto 2
                .Series(newSeries).asPoint3D.AddXYZ x1, y1, z0, "3", clTeeColor ' Punto 3
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z0, "4", clTeeColor ' Punto 4
        End With
        planeType(newSeries) = "YZ"
End Sub

Private Sub makeXZPlane(theChart As TChart, x0, y0, z0, x1, y1, z1)
        addpoint3dSeriesBis theChart, newSeries
        With theChart
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z0, "0", clTeeColor 'Punto 0
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z0, "1", clTeeColor ' Punto 1
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z1, "2", clTeeColor ' Punto 2
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z1, "3", clTeeColor  ' Punto 3
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z0, "4", clTeeColor  ' Punto 4
        End With
        planeType(newSeries) = "XZ"
End Sub

Private Sub makeXZPlaneH(theChart As TChart, x0, y0, z0, x1, y1, z1, rad, pos)
        Dim i As Single
        Dim r, d, pi As Double
        pi = 4 * Atn(1)
        d = 180 / arcSteps
        
        addpoint3dSeriesBis theChart, newSeries
        With theChart
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z0, "0", clTeeColor 'Punto 0
                .Series(newSeries).asPoint3D.AddXYZ pos - rad, y0, z0, "1", clTeeColor 'Punto 1
            
            For i = arcSteps To 1 Step -1
                r = i * d * pi / 180 - 90 * pi / 180
                .Series(newSeries).asPoint3D.AddXYZ pos - rad * Sin(r), y1, rad * Cos(r), "arc", clTeeColor
            Next i
            
                .Series(newSeries).asPoint3D.AddXYZ pos + rad, y0, z0, "2", clTeeColor ' Punto 2
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z0, "3", clTeeColor ' Punto 3
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z1, "4", clTeeColor ' Punto 4
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z1, "5", clTeeColor  ' Punto 5
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z0, "6", clTeeColor  ' Punto 6
        End With
        planeType(newSeries) = "XZH"
End Sub

Private Sub addpoint3dSeriesBis(theChart As TChart, lastSeriesPointer As Integer, Optional visiblePointer = False, Optional PenWidth = 2)
   With theChart
        .AddSeries (scPoint3D)
        lastSeriesPointer = .SeriesCount - 1
        .Series(lastSeriesPointer).asPoint3D.Pointer.Visible = False
        .Series(lastSeriesPointer).Pen.Width = 2
    End With
End Sub

Private Sub TChart1_OnAfterDraw()
    Dim i
    Dim ystart As Integer
    Dim ydelta1 As Integer
    Dim ydelta2 As Integer
    Dim j As Integer
    Dim x0, x1, x2, x3, y0, y1, y2, y3, z0, z1, z2, z3 As Integer
    Dim points() As Integer
    Dim y As Integer
    
    If notFinished Then
       Exit Sub
    End If
    ystart = 250: ydelta1 = 0: ydelta2 = 0
    With TChart1
            For i = 0 To TChart1.SeriesCount - 1
                  Select Case planeType(i)
                  Case "XY"
                                .Canvas.Brush.Color = RGB(225, 225, 225)
                                .Canvas.RectangleWithZ .Series(i).CalcXPos(0), .Series(i).CalcYPos(1), .Series(i).CalcXPos(2), .Series(i).CalcYPos(3), .Series(i).asPoint3D.CalcZPos(0)
                  Case "YZ"
                                .Canvas.Brush.Color = RGB(127, 127, 127)
                                .Canvas.Plane3D .Series(i).CalcXPos(0), .Series(i).CalcYPos(0), .Series(i).CalcXPos(2), .Series(i).CalcYPos(2), .Series(i).asPoint3D.CalcZPos(0), .Series(i).asPoint3D.CalcZPos(2)
                  Case "XZ"
                                .Canvas.Brush.Color = RGB(200, 200, 200)
                                .Canvas.RectangleY .Series(i).CalcXPos(0), .Series(i).CalcYPos(0), .Series(i).CalcXPos(2), .Series(i).asPoint3D.CalcZPos(0), .Series(i).asPoint3D.CalcZPos(3)
                  Case "XYZ"
                                ReDim points(15) As Integer
                                .Canvas.Brush.Color = RGB(225, 225, 225)
                                .Canvas.Pen.Visible = False
                                .Canvas.RectangleWithZ .Series(i).CalcXPos(arcSteps), .Series(i).CalcYPos(0), .Series(i).CalcXPos(arcSteps + 2), .Series(i).CalcYPos(arcSteps + 2), .Series(i).asPoint3D.CalcZPos(0)
                                
                                For j = 0 To arcSteps - 1
                                    points(0) = .Series(i).CalcXPos(j)
                                    points(1) = .Series(i).CalcYPos(0)
                                    points(2) = .Series(i).asPoint3D.CalcZPos(j)
                                    points(3) = .Series(i).CalcXPos(j + 1)
                                    points(4) = .Series(i).CalcYPos(0)
                                    points(5) = .Series(i).asPoint3D.CalcZPos(j + 1)
                                    points(6) = .Series(i).CalcXPos(j + 1)
                                    points(7) = .Series(i).CalcYPos(arcSteps + 2)
                                    points(8) = .Series(i).asPoint3D.CalcZPos(j + 1)
                                    points(9) = .Series(i).CalcXPos(j)
                                    points(10) = .Series(i).CalcYPos(arcSteps + 2)
                                    points(11) = .Series(i).asPoint3D.CalcZPos(j)
                                    points(12) = points(0)
                                    points(13) = points(1)
                                    points(14) = points(2)
                                    
                                    .Canvas.Polygon3D 4, points
                                Next j
                                
                                .Canvas.RectangleWithZ .Series(i).CalcXPos(arcSteps * 2 + 5), .Series(i).CalcYPos(0), .Series(i).CalcXPos(arcSteps * 2 + 5 + 2), .Series(i).CalcYPos(arcSteps + 2), .Series(i).asPoint3D.CalcZPos(0)
                    Case "XZH"
                                .Canvas.Brush.Color = RGB(200, 200, 200)
                                
                                y = .Series(i).CalcYPos(0)
                                z1 = .Series(i).asPoint3D.CalcZPos(.Series(i).Count - 2)
                                
                                ReDim points(4 * 3) As Integer
                                For j = 0 To .Series(i).Count - 2
                                    points(0) = .Series(i).CalcXPos(j)
                                    points(1) = y
                                    points(2) = .Series(i).asPoint3D.CalcZPos(j)
                                    points(3) = .Series(i).CalcXPos(j + 1)
                                    points(4) = y
                                    points(5) = .Series(i).asPoint3D.CalcZPos(j + 1)
                                    points(6) = .Series(i).CalcXPos(j + 1)
                                    points(7) = y
                                    points(8) = z1
                                    points(9) = .Series(i).CalcXPos(j)
                                    points(10) = y
                                    points(11) = z1
                                    
                                    .Canvas.Polygon3D 4, points
                                Next j
                End Select
            Next i
    End With
End Sub
Best Regards,
ImageYeray Alonso
Development & Support
Steema Software
Av. Montilivi 33, 17003 Girona, Catalonia (SP)
Image Image Image Image Image Image Please read our Bug Fixing Policy

QuijoteMx
Newbie
Newbie
Posts: 13
Joined: Wed Mar 24, 2021 12:00 am
Location: Mexico

Re: Is it posible to draw opaque cylinder surfaces in tchart.ocx

Post by QuijoteMx » Thu Jun 03, 2021 11:04 pm

Thanks for your response Yeray!

Both post are related. I'm just seen that there is a response in this thread: Is it posible to draw opaque cylinder surfaces in tchart.ocx.

The second post is about 3D flat polygons not parallel to cartesian planes.

For parallel 3D planes to cartesian, I'm using after_draw method of the tChart and the canvas methods of the series:
PolygonWithZ, RectangleWithZ, Plane3D and RectangleY, but what about tilted planes?

The cylindrical surface I'm trying to draw has its axis parallel to Depth axis (z coordinate). The code you attach produces cylindrical surfaces with axis colineal to left axis (y coordinates). I hope it can be modified to make it colinear to depth axis.

I hope you can give me a hint about how to draw 3D flat polygons not parallel to cartesian planes

Thanks ...

O. Molina

Yeray
Site Admin
Site Admin
Posts: 9622
Joined: Tue Dec 05, 2006 12:00 am
Location: Girona, Catalonia
Contact:

Re: Is it posible to draw opaque cylinder surfaces in tchart.ocx

Post by Yeray » Tue Jun 08, 2021 10:45 am

Hello,

It takes a bit of time to play with trigonometry, but this is what I understand you are trying to achieve:
polygon3D.png
polygon3D.png (75.26 KiB) Viewed 72850 times

Code: Select all

Option Explicit

Private Const HORZSIZE = 4
Private Const VERTSIZE = 6
Private Const arcSteps = 360

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Dim newSeries As Integer
Dim planeType(1000) As String '  Vector to define plane type, XY, XZ, YZ, oblique
Dim notFinished As Boolean

Private Sub Form_Load()
  TeeCommander1.ChartLink = TChart1.ChartLink  
  prepareChart
End Sub

Private Sub prepareChart()
  Dim x, z As Integer

  TChart1.RemoveAllSeries
  TeeCommander1.Chart = TChart1
  
  TChart1.Aspect.Zoom = 100
  TChart1.Aspect.Orthogonal = True
  TChart1.Aspect.Chart3DPercent = 100
  TChart1.Legend.Visible = False
  TChart1.Aspect.Rotation = 326
  TChart1.Aspect.HorizOffset = 0
  TChart1.Aspect.VertOffset = -170
  TChart1.Aspect.Elevation = 326
  
  'Yeray mods
  TChart1.Aspect.Orthogonal = False
  TChart1.Aspect.Zoom = 75

'  TChart1.Axis.Visible = False
  TChart1.Axis.Bottom.Visible = True ' CheckBox1.Value
  TChart1.Axis.Depth.Visible = True ' CheckBox2.Value
  TChart1.Axis.Left.Visible = True ' CheckBox3.Value
    
  TChart1.Axis.Bottom.Automatic = False
  TChart1.Axis.Bottom.Maximum = 100 ' TextBox1.Text
  TChart1.Axis.Bottom.Minimum = 0
  
  TChart1.Axis.Depth.Automatic = False
  TChart1.Axis.Depth.Maximum = 100 ' TextBox2.Text
  TChart1.Axis.Depth.Minimum = 0
  
  TChart1.Axis.Left.Automatic = False
  TChart1.Axis.Left.Maximum = 100 ' TextBox3.Text
  TChart1.Axis.Left.Minimum = 0
  
  TChart1.Walls.Visible = False

'  TChart1.AddSeries scPoint3D

   do_theChart
End Sub

Private Sub do_theChart()
    Dim Largo, Ancho, Alto, eCaja As Single
    
    Largo = 90 ' Cells(4, 2)
    Ancho = 45 ' Cells(4, 3)
    Alto = 30 ' Cells(4, 4)
    eCaja = 5 ' Cells(4, 5)
    
    TChart1.Aspect.OpenGL.Active = True
    
    notFinished = True
    drawBox3d TChart1, Largo, Ancho, Alto, eCaja
    
    'makeIsoAxisBis TChart1
    notFinished = False
End Sub

Private Sub drawBox3d(theChart As TChart, Largo, Ancho, Alto, eCaja)
  Dim newSeries As Integer
  Dim rads As Double
  Dim i, j As Integer
  Dim x0, y0, z0, x1, y1, z1

  Dim Angle

        drawSolidWall theChart, 0, 0, Ancho, "XY", Largo, Alto, eCaja
        'drawSolidWall theChart, 0, 0, Ancho - eCaja, "XY", Largo, Alto, eCaja

        drawSolidWall theChart, 0, 0, 0, "XZ", Largo, Ancho, eCaja
        'drawSolidWall theChart, 0, Alto - eCaja, 0, "XZ", Largo, Ancho, eCaja

        'drawSolidWall theChart, 0, 0, 0, "YZ", Ancho, Alto, eCaja
        'drawSolidWall theChart, Largo - eCaja, 0, 0, "YZ", Ancho, Alto, eCaja
End Sub

Private Sub drawSolidWall(theChart As TChart, x0, y0, z0, plane, wLargo, wAlto, wEspesor)
    Dim Radio As Single
      Radio = wLargo / 4
      Select Case UCase(plane)
      Case "XY"
            makeXYPlaneH theChart, x0, y0, x0 + wLargo, y0 + wAlto, z0, Radio, wLargo / 2
            makeXYPlaneH theChart, x0, y0, x0 + wLargo, y0 + wAlto, z0 + wEspesor, Radio, wLargo / 2
            makeYZPlane theChart, x0, y0, z0, x0, y0 + wAlto, z0 + wEspesor
            makeYZPlane theChart, x0 + wLargo, y0, z0, x0 + wLargo, y0 + wAlto, z0 + wEspesor
            makeXZPlane theChart, x0, y0, z0, x0 + wLargo, y0, z0 + wEspesor
            makeXZPlaneY theChart, x0, y0 + wAlto, z0, x0 + wLargo, y0 + wAlto, z0 + wEspesor, Radio, wLargo / 2
      Case "XZ"
            makeXYPlaneZ theChart, x0, y0, z0, x0 + wLargo, y0 + wEspesor, z0, Radio, wLargo / 2
            makeXYPlane theChart, x0, y0, z0, x0 + wLargo, y0 + wEspesor, z0 + wAlto
            makeYZPlane theChart, x0, y0, z0, x0, y0 + wEspesor, z0 + wAlto
            makeYZPlane theChart, x0 + wLargo, y0, z0, x0 + wLargo, y0 + wEspesor, z0 + wAlto
            makeXZPlaneH theChart, x0, z0, x0 + wLargo, z0 + wAlto, y0, Radio, wLargo / 2
            makeXZPlaneH theChart, x0, z0, x0 + wLargo, z0 + wAlto, y0 + wEspesor, Radio, wLargo / 2
      Case "YZ"
            makeXYPlane theChart, x0, y0, z0, x0 + wEspesor, y0 + wAlto, z0
            makeXYPlane theChart, x0, y0, z0, x0 + wEspesor, y0 + wAlto, z0 + wLargo
            makeYZPlane theChart, x0, y0, z0, x0, y0 + wAlto, z0 + wLargo
            makeYZPlane theChart, x0 + wEspesor, y0, z0, x0 + wEspesor, y0 + wAlto, z0 + wLargo
            makeXZPlane theChart, x0, y0, z0, x0 + wEspesor, y0, z0 + wLargo
            makeXZPlane theChart, x0, y0 + wAlto, z0, x0 + wEspesor, y0 + wAlto, z0 + wLargo
      End Select
End Sub

Private Sub makeXYPlane(theChart As TChart, x0, y0, z0, x1, y1, z1)
        addpoint3dSeriesBis theChart, newSeries
        With theChart
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z1, "0", clTeeColor 'Punto 0
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z1, "1", clTeeColor ' Punto 1
                .Series(newSeries).asPoint3D.AddXYZ x1, y1, z1, "2", clTeeColor ' Punto 2
                .Series(newSeries).asPoint3D.AddXYZ x0, y1, z1, "3", clTeeColor  ' Punto 3
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z1, "4", clTeeColor  ' Punto 4
        End With
        planeType(newSeries) = "XY"

End Sub

Private Sub makeXYPlaneZ(theChart As TChart, x0, y0, z0, x1, y1, z1, rad, pos)
        addpoint3dSeriesBis theChart, newSeries
        Dim i As Single
        Dim r, d, pi As Double
        pi = 4 * Atn(1)
        d = 180 / arcSteps
        With theChart
            For i = 0 To arcSteps - 1
                r = i * d * pi / 180 - 90 * pi / 180
                .Series(newSeries).asPoint3D.AddXYZ pos - rad * Sin(r), y0, rad * Cos(r), "arc", clTeeColor
            Next i
        
                .Series(newSeries).asPoint3D.AddXYZ pos - rad, y0, z1, "0", clTeeColor ' Punto 0
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z1, "1", clTeeColor 'Punto 1
                .Series(newSeries).asPoint3D.AddXYZ x0, y1, z1, "2", clTeeColor  ' Punto 2
                .Series(newSeries).asPoint3D.AddXYZ pos - rad, y1, z1, "3", clTeeColor ' Punto 3
                .Series(newSeries).asPoint3D.AddXYZ pos - rad, y0, z1, "4", clTeeColor ' Punto 4


            For i = arcSteps To 1 Step -1
                r = i * d * pi / 180 - 90 * pi / 180
                .Series(newSeries).asPoint3D.AddXYZ pos - rad * Sin(r), y1, rad * Cos(r), "arc", clTeeColor
            Next i

                .Series(newSeries).asPoint3D.AddXYZ pos + rad, y1, z1, "0", clTeeColor ' Punto 0
                .Series(newSeries).asPoint3D.AddXYZ pos + rad, y0, z1, "1", clTeeColor ' Punto 1
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z1, "2", clTeeColor 'Punto 2
                .Series(newSeries).asPoint3D.AddXYZ x1, y1, z1, "3", clTeeColor 'Punto 3
                .Series(newSeries).asPoint3D.AddXYZ pos + rad, y1, z1, "4", clTeeColor ' Punto 4
        End With
        planeType(newSeries) = "XYZ"

End Sub

Private Sub makeYZPlane(theChart As TChart, x0, y0, z0, x1, y1, z1)
        addpoint3dSeriesBis theChart, newSeries
        With theChart
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z0, "0", clTeeColor 'Punto 0
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z1, "1", clTeeColor ' Punto 1
                .Series(newSeries).asPoint3D.AddXYZ x1, y1, z1, "2", clTeeColor ' Punto 2
                .Series(newSeries).asPoint3D.AddXYZ x1, y1, z0, "3", clTeeColor ' Punto 3
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z0, "4", clTeeColor ' Punto 4
        End With
        planeType(newSeries) = "YZ"
End Sub

Private Sub makeXZPlane(theChart As TChart, x0, y0, z0, x1, y1, z1)
        addpoint3dSeriesBis theChart, newSeries
        With theChart
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z0, "0", clTeeColor 'Punto 0
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z0, "1", clTeeColor ' Punto 1
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z1, "2", clTeeColor ' Punto 2
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z1, "3", clTeeColor  ' Punto 3
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z0, "4", clTeeColor  ' Punto 4
        End With
        planeType(newSeries) = "XZ"
End Sub

Private Sub makeXZPlaneY(theChart As TChart, x0, y0, z0, x1, y1, z1, rad, pos)
        addpoint3dSeriesBis theChart, newSeries
        Dim i As Single
        Dim r, d, pi As Double
        pi = 4 * Atn(1)
        d = 180 / arcSteps
        With theChart
            For i = 0 To arcSteps - 1
                r = i * d * pi / 180 - 90 * pi / 180
                .Series(newSeries).asPoint3D.AddXYZ pos - rad * Sin(r), y1 - rad * Cos(r), z0, "arc", clTeeColor
            Next i
        
                .Series(newSeries).asPoint3D.AddXYZ pos - rad, y0, z0, "0", clTeeColor ' Punto 0
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z0, "1", clTeeColor 'Punto 1
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z1, "2", clTeeColor  ' Punto 2
                .Series(newSeries).asPoint3D.AddXYZ pos - rad, y0, z1, "3", clTeeColor ' Punto 3
                .Series(newSeries).asPoint3D.AddXYZ pos - rad, y0, z0, "4", clTeeColor ' Punto 4


            For i = arcSteps To 1 Step -1
                r = i * d * pi / 180 - 90 * pi / 180
                .Series(newSeries).asPoint3D.AddXYZ pos - rad * Sin(r), y1 - rad * Cos(r), z1, "arc", clTeeColor
            Next i

                .Series(newSeries).asPoint3D.AddXYZ pos + rad, y0, z1, "0", clTeeColor ' Punto 0
                .Series(newSeries).asPoint3D.AddXYZ pos + rad, y0, z0, "1", clTeeColor ' Punto 1
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z0, "2", clTeeColor 'Punto 2
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z1, "3", clTeeColor 'Punto 3
                .Series(newSeries).asPoint3D.AddXYZ pos + rad, y0, z1, "4", clTeeColor ' Punto 4
        End With
        planeType(newSeries) = "XZY"

End Sub

Private Sub makeXZPlaneH(theChart As TChart, x0, z0, x1, z1, y, rad, pos)
        Dim i As Single
        Dim r, d, pi As Double
        pi = 4 * Atn(1)
        d = 180 / arcSteps
        
        addpoint3dSeriesBis theChart, newSeries
        With theChart
                .Series(newSeries).asPoint3D.AddXYZ x0, y, z0, "0", clTeeColor 'Punto 0
                .Series(newSeries).asPoint3D.AddXYZ pos - rad, y, z0, "1", clTeeColor 'Punto 1
            
            For i = arcSteps To 1 Step -1
                r = i * d * pi / 180 - 90 * pi / 180
                .Series(newSeries).asPoint3D.AddXYZ pos - rad * Sin(r), y, rad * Cos(r), "arc", clTeeColor
            Next i
            
                .Series(newSeries).asPoint3D.AddXYZ pos + rad, y, z0, "2", clTeeColor ' Punto 2
                .Series(newSeries).asPoint3D.AddXYZ x1, y, z0, "3", clTeeColor ' Punto 3
                .Series(newSeries).asPoint3D.AddXYZ x1, y, z1, "4", clTeeColor ' Punto 4
                .Series(newSeries).asPoint3D.AddXYZ x0, y, z1, "5", clTeeColor  ' Punto 5
                .Series(newSeries).asPoint3D.AddXYZ x0, y, z0, "6", clTeeColor  ' Punto 6
        End With
        planeType(newSeries) = "XZH"
End Sub

Private Sub makeXYPlaneH(theChart As TChart, x0, y0, x1, y1, z, rad, pos)
        Dim i As Single
        Dim r, d, pi As Double
        pi = 4 * Atn(1)
        d = 180 / arcSteps
        
        addpoint3dSeriesBis theChart, newSeries
        With theChart
                .Series(newSeries).asPoint3D.AddXYZ x0, y1, z, "0", clTeeColor 'Punto 0
                .Series(newSeries).asPoint3D.AddXYZ pos - rad, y1, z, "1", clTeeColor 'Punto 1
            
            For i = arcSteps To 1 Step -1
                r = i * d * pi / 180 - 90 * pi / 180
                .Series(newSeries).asPoint3D.AddXYZ pos - rad * Sin(r), y1 - rad * Cos(r), z, "arc", clTeeColor
            Next i
            
                .Series(newSeries).asPoint3D.AddXYZ pos + rad, y1, z, "2", clTeeColor ' Punto 2
                .Series(newSeries).asPoint3D.AddXYZ x1, y1, z, "3", clTeeColor ' Punto 3
                .Series(newSeries).asPoint3D.AddXYZ x1, y0, z, "4", clTeeColor ' Punto 4
                .Series(newSeries).asPoint3D.AddXYZ x0, y0, z, "5", clTeeColor  ' Punto 5
                .Series(newSeries).asPoint3D.AddXYZ x0, y1, z, "6", clTeeColor  ' Punto 6
        End With
        planeType(newSeries) = "XYH"
End Sub

Private Sub addpoint3dSeriesBis(theChart As TChart, lastSeriesPointer As Integer, Optional visiblePointer = False, Optional PenWidth = 2)
   With theChart
        .AddSeries (scPoint3D)
        lastSeriesPointer = .SeriesCount - 1
        .Series(lastSeriesPointer).asPoint3D.Pointer.Visible = False
        .Series(lastSeriesPointer).Pen.Width = 2
    End With
End Sub

Private Sub TChart1_OnAfterDraw()
    Dim i
    Dim ystart As Integer
    Dim ydelta1 As Integer
    Dim ydelta2 As Integer
    Dim j As Integer
    Dim x0, x1, x2, x3, y0, y1, y2, y3, z0, z1, z2, z3 As Integer
    Dim points() As Integer
    Dim y, z As Integer
    
    If notFinished Then
       Exit Sub
    End If
    ystart = 250: ydelta1 = 0: ydelta2 = 0
    With TChart1
            .Canvas.Pen.Visible = False
            For i = 0 To TChart1.SeriesCount - 1
                  Select Case planeType(i)
                  Case "XY"
                                .Canvas.Brush.Color = RGB(225, 225, 225)
                                .Canvas.RectangleWithZ .Series(i).CalcXPos(0), .Series(i).CalcYPos(1), .Series(i).CalcXPos(2), .Series(i).CalcYPos(3), .Series(i).asPoint3D.CalcZPos(0)
                  Case "YZ"
                                .Canvas.Brush.Color = RGB(127, 127, 127)
                                .Canvas.Plane3D .Series(i).CalcXPos(0), .Series(i).CalcYPos(0), .Series(i).CalcXPos(2), .Series(i).CalcYPos(2), .Series(i).asPoint3D.CalcZPos(0), .Series(i).asPoint3D.CalcZPos(2)
                  Case "XZ"
                                .Canvas.Brush.Color = RGB(200, 200, 200)
                                .Canvas.RectangleY .Series(i).CalcXPos(0), .Series(i).CalcYPos(0), .Series(i).CalcXPos(2), .Series(i).asPoint3D.CalcZPos(0), .Series(i).asPoint3D.CalcZPos(3)
                  Case "XYZ"
                                ReDim points(15) As Integer
                                .Canvas.Brush.Color = RGB(225, 225, 225)
                                .Canvas.RectangleWithZ .Series(i).CalcXPos(arcSteps), .Series(i).CalcYPos(0), .Series(i).CalcXPos(arcSteps + 2), .Series(i).CalcYPos(arcSteps + 2), .Series(i).asPoint3D.CalcZPos(0)
                                
                                For j = 0 To arcSteps - 1
                                    points(0) = .Series(i).CalcXPos(j)
                                    points(1) = .Series(i).CalcYPos(0)
                                    points(2) = .Series(i).asPoint3D.CalcZPos(j)
                                    points(3) = .Series(i).CalcXPos(j + 1)
                                    points(4) = .Series(i).CalcYPos(0)
                                    points(5) = .Series(i).asPoint3D.CalcZPos(j + 1)
                                    points(6) = .Series(i).CalcXPos(j + 1)
                                    points(7) = .Series(i).CalcYPos(arcSteps + 2)
                                    points(8) = .Series(i).asPoint3D.CalcZPos(j + 1)
                                    points(9) = .Series(i).CalcXPos(j)
                                    points(10) = .Series(i).CalcYPos(arcSteps + 2)
                                    points(11) = .Series(i).asPoint3D.CalcZPos(j)
                                    points(12) = points(0)
                                    points(13) = points(1)
                                    points(14) = points(2)
                                    
                                    .Canvas.Polygon3D 4, points
                                Next j
                                
                                .Canvas.RectangleWithZ .Series(i).CalcXPos(arcSteps * 2 + 5), .Series(i).CalcYPos(0), .Series(i).CalcXPos(arcSteps * 2 + 5 + 2), .Series(i).CalcYPos(arcSteps + 2), .Series(i).asPoint3D.CalcZPos(0)
                    Case "XZH"
                                .Canvas.Brush.Color = RGB(200, 200, 200)
                                
                                y = .Series(i).CalcYPos(0)
                                z1 = .Series(i).asPoint3D.CalcZPos(.Series(i).Count - 2)
                                
                                ReDim points(4 * 3) As Integer
                                For j = 0 To .Series(i).Count - 2
                                    points(0) = .Series(i).CalcXPos(j)
                                    points(1) = y
                                    points(2) = .Series(i).asPoint3D.CalcZPos(j)
                                    points(3) = .Series(i).CalcXPos(j + 1)
                                    points(4) = y
                                    points(5) = .Series(i).asPoint3D.CalcZPos(j + 1)
                                    points(6) = .Series(i).CalcXPos(j + 1)
                                    points(7) = y
                                    points(8) = z1
                                    points(9) = .Series(i).CalcXPos(j)
                                    points(10) = y
                                    points(11) = z1
                                    
                                    .Canvas.Polygon3D 4, points
                                Next j
                    Case "XZY"
                                ReDim points(15) As Integer
                                .Canvas.Brush.Color = RGB(225, 225, 225)
                                .Canvas.Pen.Visible = False
                                .Canvas.RectangleY .Series(i).CalcXPos(arcSteps), .Series(i).CalcYPos(0), .Series(i).CalcXPos(arcSteps + 2), .Series(i).asPoint3D.CalcZPos(0), .Series(i).asPoint3D.CalcZPos(arcSteps + 2)
                                
                                For j = 0 To arcSteps - 1
                                    points(0) = .Series(i).CalcXPos(j)
                                    points(1) = .Series(i).CalcYPos(j)
                                    points(2) = .Series(i).asPoint3D.CalcZPos(0)
                                    points(3) = .Series(i).CalcXPos(j + 1)
                                    points(4) = .Series(i).CalcYPos(j + 1)
                                    points(5) = .Series(i).asPoint3D.CalcZPos(0)
                                    points(6) = .Series(i).CalcXPos(j + 1)
                                    points(7) = .Series(i).CalcYPos(j + 1)
                                    points(8) = .Series(i).asPoint3D.CalcZPos(arcSteps + 2)
                                    points(9) = .Series(i).CalcXPos(j)
                                    points(10) = .Series(i).CalcYPos(j)
                                    points(11) = .Series(i).asPoint3D.CalcZPos(arcSteps + 2)
                                    points(12) = points(0)
                                    points(13) = points(1)
                                    points(14) = points(2)

                                    .Canvas.Polygon3D 4, points
                                Next j

                                .Canvas.RectangleY .Series(i).CalcXPos(arcSteps * 2 + 5), .Series(i).CalcYPos(0), .Series(i).CalcXPos(arcSteps * 2 + 5 + 2), .Series(i).asPoint3D.CalcZPos(0), .Series(i).asPoint3D.CalcZPos(arcSteps + 2)
                    Case "XYH"
                                .Canvas.Brush.Color = RGB(200, 200, 200)
                                
                                y1 = .Series(i).CalcYPos(.Series(i).Count - 2)
                                z = .Series(i).asPoint3D.CalcZPos(0)
                                
                                ReDim points(4 * 3) As Integer
                                For j = 0 To .Series(i).Count - 2
                                    points(0) = .Series(i).CalcXPos(j)
                                    points(1) = .Series(i).CalcYPos(j)
                                    points(2) = z
                                    points(3) = .Series(i).CalcXPos(j + 1)
                                    points(4) = .Series(i).CalcYPos(j + 1)
                                    points(5) = z
                                    points(6) = .Series(i).CalcXPos(j + 1)
                                    points(7) = y1
                                    points(8) = z
                                    points(9) = .Series(i).CalcXPos(j)
                                    points(10) = y1
                                    points(11) = z
                                    
                                    .Canvas.Polygon3D 4, points
                                Next j
                End Select
            Next i
    End With
End Sub
Best Regards,
ImageYeray Alonso
Development & Support
Steema Software
Av. Montilivi 33, 17003 Girona, Catalonia (SP)
Image Image Image Image Image Image Please read our Bug Fixing Policy

QuijoteMx
Newbie
Newbie
Posts: 13
Joined: Wed Mar 24, 2021 12:00 am
Location: Mexico

Re: Is it posible to draw opaque cylinder surfaces in tchart.ocx

Post by QuijoteMx » Wed Jun 09, 2021 2:03 pm

Looks great Yeray!

But there is something wrong with my teeChart software installation.

I copied the code you provided but I got an error.
For some reason, the Canvas.Polygon3D method it's not recognized in my Excel-VBA instalation.

I'm attaching two screen shots of the code and the error.

What's wrong with my TeeChart Software...?
Error 1.png
Error 1.png (209.8 KiB) Viewed 72792 times
Error 2.png
Error 2.png (198.28 KiB) Viewed 72792 times

Yeray
Site Admin
Site Admin
Posts: 9622
Joined: Tue Dec 05, 2006 12:00 am
Location: Girona, Catalonia
Contact:

Re: Is it posible to draw opaque cylinder surfaces in tchart.ocx

Post by Yeray » Wed Jun 09, 2021 6:21 pm

Hello,
QuijoteMx wrote:
Wed Jun 09, 2021 2:03 pm
For some reason, the Canvas.Polygon3D method it's not recognized in my Excel-VBA instalation.
I'm sorry for the confusion. There's no TeeChart ActiveX version with Polygon3D function published yet.
When I said this:
Yeray wrote:
Thu Jun 03, 2021 5:43 pm
With Polygon3D (#2427) function you'll be able to get this
I meant I was testing that function with a test version.
I will send you this test version so you can give it a try.
Best Regards,
ImageYeray Alonso
Development & Support
Steema Software
Av. Montilivi 33, 17003 Girona, Catalonia (SP)
Image Image Image Image Image Image Please read our Bug Fixing Policy

QuijoteMx
Newbie
Newbie
Posts: 13
Joined: Wed Mar 24, 2021 12:00 am
Location: Mexico

Re: Is it posible to draw opaque cylinder surfaces in tchart.ocx

Post by QuijoteMx » Sat Jun 12, 2021 1:13 pm

Thank you Yerai!

QuijoteMx
Newbie
Newbie
Posts: 13
Joined: Wed Mar 24, 2021 12:00 am
Location: Mexico

Re: Is it posible to draw opaque cylinder surfaces in tchart.ocx

Post by QuijoteMx » Tue Jun 29, 2021 3:06 pm

Hi Yeray!

It's been two weeks since you offered to me a test version of teeChart control. Till now, I have'nt recived any link or
zip file to download it. Sorry, if I'm looking so rude, it's not my intention, I'm trying to be as polite as
I can be asking for it. Is there any link from I can download the test version?

Tanks ...

Yeray
Site Admin
Site Admin
Posts: 9622
Joined: Tue Dec 05, 2006 12:00 am
Location: Girona, Catalonia
Contact:

Re: Is it posible to draw opaque cylinder surfaces in tchart.ocx

Post by Yeray » Thu Jul 08, 2021 12:58 pm

Hello,

Sorry for the late response here.
I sent a mail with a link with the download to the mail you have registered in this forum the 9th June.
Please check the spam box.
If you want us to send it to a different mail, you can write to info@steema.com referencing this thread.
Best Regards,
ImageYeray Alonso
Development & Support
Steema Software
Av. Montilivi 33, 17003 Girona, Catalonia (SP)
Image Image Image Image Image Image Please read our Bug Fixing Policy

QuijoteMx
Newbie
Newbie
Posts: 13
Joined: Wed Mar 24, 2021 12:00 am
Location: Mexico

Re: Is it posible to draw opaque cylinder surfaces in tchart.ocx

Post by QuijoteMx » Fri Jul 09, 2021 5:31 pm

Thanks for your answer. I sent you an email with another email address. I hope I can download the test version now.

Thanks again ..

O. MOlina

Yeray
Site Admin
Site Admin
Posts: 9622
Joined: Tue Dec 05, 2006 12:00 am
Location: Girona, Catalonia
Contact:

Re: Is it posible to draw opaque cylinder surfaces in tchart.ocx

Post by Yeray » Thu Jul 15, 2021 7:54 am

Hello,
QuijoteMx wrote:
Fri Jul 09, 2021 5:31 pm
I sent you an email with another email address
We haven't received that mail. Could you please try sending it at sales@steema.com?
Best Regards,
ImageYeray Alonso
Development & Support
Steema Software
Av. Montilivi 33, 17003 Girona, Catalonia (SP)
Image Image Image Image Image Image Please read our Bug Fixing Policy

Post Reply