It takes a bit of time to play with trigonometry, but this is what I understand you are trying to achieve:
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