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