Steema Central

Posted: **Fri May 07, 2021 8:38 pm**

Hi!
I'm trying to draw boxes in 3D using tee Chart 2021 in VBA EXCEL.
Wall boxes have 3 dimensions, height, width and thickness. I'm doing
fairy well till now. But I'm facing a problem. I'm using canvas on_afterdraw methods
to make the wall surfaces opaque, but my code is not working completelly well.

Using the same code to draw two parallel walls, one of them is drawn perfectly,
all the sufraces (6 faces) are drawn opaque. The other one, only five of the six
faces are drawn opaque. I'm confused.

I've attached some pictures from different points
of view so you can watch the weird behavior of my code. I've also copied
the code below. To run it you have to insert a userform in VBA Exel and an instance
of the tChart control, and run it.

For simplicity, I've commented out some instructions, so just walls parallel to the
Left-bottom plane are drawn.

The teeCommander is linked to the chart so you can move, rotate, zoom it

Does any body has a hint that I can follow to solve my problem.

this is the code:
---------------------------------------------------------------------

Code: Select all

Option Explicit

Private Const HORZSIZE = 4
Private Const VERTSIZE = 6

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 CheckBox1_Click()
   TChart1.Axis.Bottom.Visible = CheckBox1.Value

End Sub

Private Sub CheckBox2_Click()
   TChart1.Axis.Depth.Visible = CheckBox2.Value

End Sub

Private Sub CheckBox3_Click()
   TChart1.Axis.Left.Visible = CheckBox3.Value

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.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)
      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"
            makeXYPlane theChart, x0, y0, z0, x0 + wLargo, y0 + wEspesor, z0
            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
            makeXZPlane theChart, x0, y0, z0, x0 + wLargo, y0, z0 + wAlto
            makeXZPlane theChart, x0, y0 + wEspesor, z0, x0 + wLargo, y0 + wEspesor, z0 + wAlto
      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 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 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

    If notFinished Then
       Exit Sub
    End If
    ystart = 250: ydelta1 = 0: ydelta2 = 0
    With TChart1
            For i = 1 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)
                End Select
            Next i
    End With

End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()
    TeeCommander1.Chart = TChart1
    prepareChart
End Sub

Posted: **Wed May 19, 2021 12:40 pm**

Hello,

Sorry for the delayed reply here.

This happens because you are drawing the planes in a specific order, which doesn't considers the rotation and elevation of the view and the position of the object.
Ie, when you look a cube from the front, you need to draw the back plane first, and the front plane later. However, when you rotate the view and you see the cube from the back, you need to draw the front plane first, and the back plane later.
What is more, when looking the cube from the front, you probable don't even need to draw the back plane at all.
However, when looking from the side, the front/back planes will be visible or not depending on the Z position of the cube and the distance to the observer.

And the similar should be considered with the top and bottom planes, this time depending on the elevation.

Posted: **Wed May 19, 2021 3:14 pm**

Thanks for your response.

Sorry, but I'm still confused.

If you see, both "bodies" are drawn with the same code, and the upper one does not show the weird behavior.

If I use the rotating tool, I can rotate the graph in every single direction and the faces of the upper body remains
opaque. They change the color because of the direction the ligth comes from.

Have you tried my code ...?

Is there another way to graph opaque planes in 3D?

Thanks ...

Posted: **Thu May 20, 2021 11:05 am**

Hello,

Yes, I looked at your code. Now I looked at it again and indeed I was wrong and found what seems to be a bug in your code.
You are looping your series at OnAfterDraw event, but you are starting at series index 1, which skips the first series, which is corresponds to the first plane in your drawing. So changing that for to start at i=0 seems to solve the problem for me here:

Code: Select all

Private Sub TChart1_OnAfterDraw()
  '...
    With TChart1
            For i = 0 To TChart1.SeriesCount - 1
                  '...

I think it looks fine now:

: rectangles.png (46.69 KiB) Viewed 44022 times

Posted: **Thu May 20, 2021 1:17 pm**

Thank you Yeray.

Usually fresh eyes can see more than ours.

Thanks again ...

Posted: **Fri May 21, 2021 1:50 pm**

Hello,

You are welcome! Happy to be helpful

Steema Central

Weird behavior drawing opaque surfaces in 3D in VBA Excel

Weird behavior drawing opaque surfaces in 3D in VBA Excel

Re: Weird behavior drawing opaque surfaces in 3D in VBA Excel

Re: Weird behavior drawing opaque surfaces in 3D in VBA Excel

Re: Weird behavior drawing opaque surfaces in 3D in VBA Excel

Re: Weird behavior drawing opaque surfaces in 3D in VBA Excel

Re: Weird behavior drawing opaque surfaces in 3D in VBA Excel