Making Isometric 3d grapsh
Posted: Mon Jun 09, 2008 4:12 am
How can I do an isometric 3d Graph.
Is any way to attach files ?
Is any way to attach files ?
Steema Software - Customer Support Forums
http://216.92.243.79/support/
Code: Select all
Option Explicit
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Const HORZSIZE = 4
Private Const VERTSIZE = 6
Private Sub Command1_Click()
MakeIsoAxis TChart1
End Sub
Private Sub Form_Load()
Dim x, z As Integer
ScaleMode = vbPixels
TChart1.Aspect.Chart3DPercent = 100
TChart1.Legend.Visible = False
TChart1.AddSeries scSurface
With TChart1.Axis.Left
.GridPen.Style = psSolid
.GridPen.Color = vbBlack
.Increment = 50
.Labels.Separation = 0
End With
With TChart1.Axis.Bottom
.GridPen.Style = psSolid
.GridPen.Color = vbBlack
.Increment = 50
.Labels.Separation = 0
End With
With TChart1.Axis.Depth
.Visible = True
.GridPen.Style = psSolid
.GridPen.Color = vbBlack
.Increment = 50
.Labels.Separation = 0
End With
For x = 1 To 50
For z = 1 To 50
TChart1.Series(0).asSurface.AddXYZ x, Rnd * 50, z, "", clTeeColor
Next z
Next x
End Sub
Private Sub MakeIsoAxis(AChart As TChart)
Dim tmpX, tmpY, tmpZ, XRange, YRange, ZRange, Offset, XYScreen As Double
With AChart
If (.ChartHeight > 0) And (.ChartWidth > 0) Then
With .Axis.Bottom
XRange = .Maximum - .Minimum
End With
With .Axis.Left
YRange = .Maximum - .Minimum
End With
With .Axis.Depth
ZRange = .Maximum - .Minimum
End With
XYScreen = (GetDeviceCaps(.Canvas.HandleDC, HORZSIZE) / Screen.Width) / (GetDeviceCaps(.Canvas.HandleDC, VERTSIZE) / Screen.Height)
tmpX = (XRange / .ChartWidth)
tmpY = (YRange / .ChartHeight) * XYScreen
tmpZ = (ZRange / (.Axis.Depth.IEndPos - .Axis.Depth.IStartPos)) * XYScreen / 2
If tmpX > tmpY And tmpX > tmpZ Then
If tmpY <> 0 Then
Offset = ((YRange * tmpX / tmpY) - YRange) / 2
With .Axis.Left
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
If tmpZ <> 0 Then
Offset = ((ZRange * tmpX / tmpZ) - ZRange)
With .Axis.Depth
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
Else
If tmpY > tmpX And tmpY > tmpZ Then
If tmpX <> 0 Then
Offset = ((XRange * tmpY / tmpX) - XRange) / 2
With .Axis.Bottom
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
If tmpZ <> 0 Then
Offset = ((ZRange * tmpY / tmpZ) - ZRange)
With .Axis.Depth
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
Else
If tmpX <> 0 Then
Offset = ((XRange * tmpZ / tmpX) - XRange) / 2
With .Axis.Bottom
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
If tmpY <> 0 Then
Offset = ((YRange * tmpZ / tmpY) - YRange) / 2
With .Axis.Left
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
End If
End If
End If
End With
End Sub
Code: Select all
Option Explicit
Const pi = 3.14159265358979
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Const HORZSIZE = 4
Private Const VERTSIZE = 6
Private Sub Command1_Click()
MakeIsoAxis TChart1
End Sub
Private Sub Form_Load()
Dim x, z As Integer
TeeCommander1.Chart = TChart1
ScaleMode = vbPixels
TChart1.Aspect.Chart3DPercent = 100
TChart1.Legend.Visible = False
drawThebox 50, 50, 25
End Sub
Private Sub MakeIsoAxis(AChart As TChart)
Dim tmpX, tmpY, tmpZ, XRange, YRange, ZRange, Offset, XYScreen As Double
With AChart
If (.ChartHeight > 0) And (.ChartWidth > 0) Then
With .Axis.Bottom
XRange = .Maximum - .Minimum
End With
With .Axis.Left
YRange = .Maximum - .Minimum
End With
With .Axis.Depth
ZRange = .Maximum - .Minimum
End With
XYScreen = (GetDeviceCaps(.Canvas.HandleDC, HORZSIZE) / Screen.Width) / (GetDeviceCaps(.Canvas.HandleDC, VERTSIZE) / Screen.Height)
tmpX = (XRange / .ChartWidth)
tmpY = (YRange / .ChartHeight) * XYScreen
tmpZ = (ZRange / (.Axis.Depth.IEndPos - .Axis.Depth.IStartPos)) * XYScreen / 2
If tmpX > tmpY And tmpX > tmpZ Then
If tmpY <> 0 Then
Offset = ((YRange * tmpX / tmpY) - YRange) / 2
With .Axis.Left
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
If tmpZ <> 0 Then
Offset = ((ZRange * tmpX / tmpZ) - ZRange)
With .Axis.Depth
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
Else
If tmpY > tmpX And tmpY > tmpZ Then
If tmpX <> 0 Then
Offset = ((XRange * tmpY / tmpX) - XRange) / 2
With .Axis.Bottom
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
If tmpZ <> 0 Then
Offset = ((ZRange * tmpY / tmpZ) - ZRange)
With .Axis.Depth
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
Else
If tmpX <> 0 Then
Offset = ((XRange * tmpZ / tmpX) - XRange) / 2
With .Axis.Bottom
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
If tmpY <> 0 Then
Offset = ((YRange * tmpZ / tmpY) - YRange) / 2
With .Axis.Left
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
End If
End If
End If
End With
End Sub
Private Sub addPoint3DSeries(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 drawThebox(Largo, Ancho, Alto)
Dim newSeries As Integer
Dim btapa As Single
'---
' bTapa=ancho de la hoja que forma la tapa
'---
btapa = Ancho / 2
With TChart1
'--- Plano Largo-Alto (0). Cara larga del frente
addPoint3DSeries TChart1, newSeries
.Series(newSeries).asPoint3D.AddXYZ 0, 0, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, 0, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, 0, 0, "", clTeeColor
'--- Plano Largo-Alto (0). Tapa del frente
addPoint3DSeries TChart1, newSeries
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, Alto - Cos(45 * pi / 180) * btapa, -btapa, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto - Cos(45 * pi / 180) * btapa, -btapa, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, 0, "", clTeeColor
'--- Plano Largo-Alto (1). Cara larga del fondo
addPoint3DSeries TChart1, newSeries
.Series(newSeries).asPoint3D.AddXYZ 0, 0, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, 0, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, 0, Ancho, "", clTeeColor
'--- Plano Largo-Alto (1). Tapa del fondo
addPoint3DSeries TChart1, newSeries
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, Alto + btapa, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto + btapa, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, Ancho, "", clTeeColor
'--- Plano Ancho-Alto (0). Cara izquierda
addPoint3DSeries TChart1, newSeries
.Series(newSeries).asPoint3D.AddXYZ 0, 0, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, 0, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, 0, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, 0, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, 0, 0, "", clTeeColor
'--- Plano Ancho-Alto (0). Tapa de la izquierda
addPoint3DSeries TChart1, newSeries
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, Alto + btapa, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, Alto + btapa, Ancho, "", clTeeColor
'--- Plano Ancho-Alto (1). Cara derecha
addPoint3DSeries TChart1, newSeries
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, 0, "", clTeeColor
'--- Plano Ancho-Alto (1). Tapa derecha
addPoint3DSeries TChart1, newSeries
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo + Cos(45 * pi / 180) * btapa, Alto - Cos(45 * pi / 180) * btapa, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo + Cos(45 * pi / 180) * btapa, Alto - Cos(45 * pi / 180) * btapa, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, Ancho, "", clTeeColor
End With
End Sub
Code: Select all
Option Explicit
Const pi = 3.14159265358979
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Const HORZSIZE = 4
Private Const VERTSIZE = 6
Private Sub Command1_Click()
MakeIsoAxis TChart1
End Sub
Private Sub Form_Load()
Dim X, z As Integer
TeeCommander1.Chart = TChart1
ScaleMode = vbPixels
TChart1.Aspect.Zoom = 70
TChart1.Aspect.Orthogonal = False
TChart1.Aspect.Chart3DPercent = 100
TChart1.Legend.Visible = False
TChart1.Axis.Left.Increment = 5
TChart1.Axis.Bottom.Increment = 5
TChart1.Axis.Depth.Visible = True
TChart1.Axis.Depth.Increment = 5
TChart1.AddSeries scPoint3D
For X = 1 To 49
For z = 1 To 49
TChart1.Series(0).asPoint3D.AddXYZ X, Rnd * 24, z, "", clTeeColor
Next z
Next X
TChart1.Series(0).asPoint3D.AddXYZ 1, 49, 1, "", clTeeColor
TChart1.Series(0).SetNull TChart1.Series(0).Count - 1 'point added to redimension to show the whole box
TChart1.Environment.InternalRepaint
drawThebox 50, 50, 25
MakeIsoAxis TChart1
End Sub
Private Sub MakeIsoAxis(AChart As TChart)
Dim tmpX, tmpY, tmpZ, XRange, YRange, ZRange, Offset, XYScreen As Double
With AChart
.Axis.Bottom.Automatic = False
.Axis.Left.Automatic = False
.Axis.Depth.Automatic = False
If (.ChartHeight > 0) And (.ChartWidth > 0) Then
With .Axis.Bottom
XRange = .Maximum - .Minimum
End With
With .Axis.Left
YRange = .Maximum - .Minimum
End With
With .Axis.Depth
ZRange = .Maximum - .Minimum
End With
XYScreen = (GetDeviceCaps(.Canvas.HandleDC, HORZSIZE) / Screen.Width) / (GetDeviceCaps(.Canvas.HandleDC, VERTSIZE) / Screen.Height)
tmpX = (XRange / .ChartWidth)
tmpY = (YRange / .ChartHeight) * XYScreen
tmpZ = (ZRange / (.Axis.Depth.IEndPos - .Axis.Depth.IStartPos)) * XYScreen
If tmpX > tmpY And tmpX > tmpZ Then
If tmpY <> 0 Then
Offset = ((YRange * tmpX / tmpY) - YRange) / 2
With .Axis.Left
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
If tmpZ <> 0 Then
Offset = ((ZRange * tmpX / tmpZ) - ZRange) / 2
With .Axis.Depth
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
End If
If tmpY > tmpX And tmpY > tmpZ Then
If tmpX <> 0 Then
Offset = ((XRange * tmpY / tmpX) - XRange) / 2
With .Axis.Bottom
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
If tmpZ <> 0 Then
Offset = ((ZRange * tmpY / tmpZ) - ZRange) / 2
With .Axis.Depth
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
End If
If tmpZ > tmpX And tmpZ > tmpY Then
If tmpX <> 0 Then
Offset = ((XRange * tmpZ / tmpX) - XRange) / 2
With .Axis.Bottom
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
If tmpY <> 0 Then
Offset = ((YRange * tmpZ / tmpY) - YRange) / 2
With .Axis.Left
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
End If
End If
End With
End Sub
Private Sub addPoint3DSeries(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 drawThebox(Largo, Ancho, Alto)
Dim newSeries As Integer
Dim btapa As Single
'---
' bTapa=ancho de la hoja que forma la tapa
'---
btapa = Ancho / 2
With TChart1
'--- Plano Largo-Alto (0). Cara larga del frente
addPoint3DSeries TChart1, newSeries
.Series(newSeries).asPoint3D.AddXYZ 0, 0, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, 0, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, 0, 0, "", clTeeColor
'--- Plano Largo-Alto (0). Tapa del frente
addPoint3DSeries TChart1, newSeries
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, Alto - Cos(45 * pi / 180) * btapa, -btapa, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto - Cos(45 * pi / 180) * btapa, -btapa, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, 0, "", clTeeColor
'--- Plano Largo-Alto (1). Cara larga del fondo
addPoint3DSeries TChart1, newSeries
.Series(newSeries).asPoint3D.AddXYZ 0, 0, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, 0, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, 0, Ancho, "", clTeeColor
'--- Plano Largo-Alto (1). Tapa del fondo
addPoint3DSeries TChart1, newSeries
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, Alto + btapa, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto + btapa, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, Ancho, "", clTeeColor
'--- Plano Ancho-Alto (0). Cara izquierda
addPoint3DSeries TChart1, newSeries
.Series(newSeries).asPoint3D.AddXYZ 0, 0, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, 0, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, 0, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, 0, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, 0, 0, "", clTeeColor
'--- Plano Ancho-Alto (0). Tapa de la izquierda
addPoint3DSeries TChart1, newSeries
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, Alto + btapa, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, Alto + btapa, Ancho, "", clTeeColor
'--- Plano Ancho-Alto (1). Cara derecha
addPoint3DSeries TChart1, newSeries
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, 0, "", clTeeColor
'--- Plano Ancho-Alto (1). Tapa derecha
addPoint3DSeries TChart1, newSeries
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo + Cos(45 * pi / 180) * btapa, Alto - Cos(45 * pi / 180) * btapa, 0, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo + Cos(45 * pi / 180) * btapa, Alto - Cos(45 * pi / 180) * btapa, Ancho, "", clTeeColor
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, Ancho, "", clTeeColor
End With
End Sub
Code: Select all
Private Sub TChart1_OnAfterDraw()
If TChart1.SeriesCount = 9 Then
With TChart1
.Canvas.Brush.Color = vbWhite
.Canvas.Brush.Style = bsSolid
.Canvas.BackMode = cbmOpaque
.Canvas.PlaneFour3D .Series(1).CalcXPos(3), .Series(1).CalcYPos(3), _
.Series(1).CalcXPos(0), .Series(1).CalcYPos(0), _
.Series(1).CalcXPos(1), .Series(1).CalcYPos(1), _
.Series(1).CalcXPos(2), .Series(1).CalcYPos(2), _
.Series(1).asPoint3D.CalcZPos(3), .Series(1).asPoint3D.CalcZPos(3)
.Canvas.Plane3D .Series(1).CalcXPos(3), .Series(1).CalcYPos(3), _
.Series(2).CalcXPos(2), .Series(2).CalcYPos(2), _
.Series(1).asPoint3D.CalcZPos(3), .Series(2).asPoint3D.CalcZPos(2)
End With
End If
End Sub
Code: Select all
Option Explicit
Const pi = 3.14159265358979
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Const HORZSIZE = 4
Private Const VERTSIZE = 6
Dim Largo, Ancho, Alto
Dim RADS
Private Sub Form_Load()
TeeCommander1.Chart = TChart2
' ChartGrid1.Chart = TChart2
ScaleMode = vbPixels
aNGLE = 45
drawBox3d
End Sub
Private Sub makeIsoAxisBis(AChart As TChart)
Dim tmpX, tmpY, tmpZ, XRange, YRange, ZRange, Offset, XYScreen As Double
On Error Resume Next
With AChart
.Axis.Bottom.Automatic = False
.Axis.Left.Automatic = False
.Axis.Depth.Automatic = False
If (.ChartHeight > 0) And (.ChartWidth > 0) Then
With .Axis.Bottom
XRange = .Maximum - .Minimum
End With
With .Axis.Left
YRange = .Maximum - .Minimum
End With
With .Axis.Depth
ZRange = .Maximum - .Minimum
End With
XYScreen = (GetDeviceCaps(.Canvas.HandleDC, HORZSIZE) / Screen.Width) / (GetDeviceCaps(.Canvas.HandleDC, VERTSIZE) / Screen.Height)
tmpX = (XRange / .ChartWidth)
tmpY = (YRange / .ChartHeight) * XYScreen
tmpZ = (ZRange / (.Axis.Depth.IEndPos - .Axis.Depth.IStartPos)) * XYScreen
If tmpX > tmpY And tmpX > tmpZ Then
If tmpY <> 0 Then
Offset = ((YRange * tmpX / tmpY) - YRange) / 2
With .Axis.Left
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
If tmpZ <> 0 Then
Offset = ((ZRange * tmpX / tmpZ) - ZRange) / 2
With .Axis.Depth
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
End If
If tmpY > tmpX And tmpY > tmpZ Then
If tmpX <> 0 Then
Offset = ((XRange * tmpY / tmpX) - XRange) / 2
With .Axis.Bottom
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
If tmpZ <> 0 Then
Offset = ((ZRange * tmpY / tmpZ) - ZRange) / 2
With .Axis.Depth
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
End If
If tmpZ > tmpX And tmpZ > tmpY Then
If tmpX <> 0 Then
Offset = ((XRange * tmpZ / tmpX) - XRange) / 2
With .Axis.Bottom
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
If tmpY <> 0 Then
Offset = ((YRange * tmpZ / tmpY) - YRange) / 2
With .Axis.Left
.SetMinMax .Minimum - Offset, .Maximum + Offset
End With
End If
End If
End If
End With
On Error GoTo 0
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 = True
.Series(lastSeriesPointer).Pen.Width = 2
End With
End Sub
Private Sub drawBox3d()
Dim newSeries As Integer
Dim X, z As Integer
TChart2.RemoveAllSeries
TChart2.Aspect.Zoom = 30
TChart2.Aspect.Orthogonal = False
TChart2.Aspect.Chart3DPercent = 100
TChart2.Legend.Visible = False
TChart2.Axis.Left.Visible = True
TChart2.Axis.Bottom.Visible = False
TChart2.Axis.Depth.Visible = False
TChart2.Walls.Visible = False
TChart2.AddSeries scPoint3D
Largo = 75
Ancho = 50
Alto = 25
For X = 1 To Largo - 1
For z = 1 To Ancho - 1
TChart2.Series(0).asPoint3D.AddXYZ X, Rnd * (Alto + 0.5 * Ancho - 1), z, "", clTeeColor
Next z
Next X
TChart2.Series(0).asPoint3D.AddXYZ 1, Ancho / 2 + Alto - 1, 1, "", clTeeColor
TChart2.Series(0).SetNull TChart2.Series(0).Count - 1 'point added to redimension to show the whole box
TChart2.Environment.InternalRepaint
TChart2.Series(0).Active = False
addpoint3dSeriesBis TChart2, newSeries 'Serie 1
With TChart2
RADS = Val(aNGLE) * pi / 180
.Series(newSeries).asPoint3D.AddXYZ 0, 0, 0, "", clTeeColor 'Punto 0
.Series(newSeries).asPoint3D.AddXYZ Largo, 0, 0, "", clTeeColor ' Punto 1
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, 0, "", clTeeColor ' Punto 2
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, 0, "", clTeeColor ' Punto 3
.Series(newSeries).asPoint3D.AddXYZ 0, 0, 0, "", clTeeColor ' punto 4
.Series(newSeries).asPoint3D.AddXYZ 0, 0, Ancho, "", clTeeColor 'Punto 5
.Series(newSeries).asPoint3D.AddXYZ Largo, 0, Ancho, "", clTeeColor ' Punto 6
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, Ancho, "", clTeeColor ' Punto 7
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, Ancho, "", clTeeColor ' Punto 8
.Series(newSeries).asPoint3D.AddXYZ 0, 0, Ancho, "", clTeeColor ' Punto 9
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, Ancho, "", clTeeColor ' punto 10
.Series(newSeries).asPoint3D.AddXYZ 0, Alto + 0.5 * Ancho * Sin(RADS), Ancho + 0.5 * Ancho * Cos(RADS), "", clTeeColor ' punto 11
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto + 0.5 * Ancho * Sin(RADS), Ancho + 0.5 * Ancho * Cos(RADS), "", clTeeColor ' punto 12
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, Ancho, "", clTeeColor ' punto 13
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, Ancho, "", clTeeColor ' punto 14
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, 0, "", clTeeColor ' punto 14
.Series(newSeries).asPoint3D.AddXYZ 0, Alto + 0.5 * Ancho, 0, "", clTeeColor ' punto 15
.Series(newSeries).asPoint3D.AddXYZ 0, Alto + 0.5 * Ancho, Ancho, "", clTeeColor ' punto 16
.Series(newSeries).asPoint3D.AddXYZ 0, Alto, 0, "17", clTeeColor ' punto 17
.Series(newSeries).asPoint3D.AddXYZ 0, Alto - 0.5 * Ancho * Sin(RADS), -0.5 * Ancho * Cos(RADS), "18", vbRed ' punto 18
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto - 0.5 * Ancho * Sin(RADS), -0.5 * Ancho * Cos(RADS), "19", clTeeColor ' punto 19
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, 0, "20", clTeeColor ' punto 20
.Series(newSeries).asPoint3D.AddXYZ Largo + 0.5 * Ancho * Cos(RADS), Alto - 0.5 * Ancho * Sin(RADS), 0, "21", clTeeColor ' punto 21
.Series(newSeries).asPoint3D.AddXYZ Largo + 0.5 * Ancho * Cos(RADS), Alto - 0.5 * Ancho * Sin(RADS), Ancho, "22", clTeeColor ' punto 22
.Series(newSeries).asPoint3D.AddXYZ Largo, Alto, Ancho, "23", clTeeColor ' punto 23
End With
makeIsoAxisBis TChart2
TChart2.Aspect.OpenGL.Active = True
' TChart2.Series(1).Marks.Visible = True
' TChart2.Series(1).Marks.Font.Size = 30
End Sub
Private Sub Slider1_Change()
aNGLE = Slider1.Value
drawBox3d
End Sub
Private Sub tchart2_OnAfterDraw()
If TChart2.SeriesCount = 2 Then
With TChart2
.Canvas.Brush.Color = vbCyan
.Canvas.Brush.Style = bsSolid
.Canvas.BackMode = cbmOpaque
.Canvas.PlaneFour3D .Series(1).CalcXPos(0), .Series(1).CalcYPos(0), _
.Series(1).CalcXPos(1), .Series(1).CalcYPos(1), _
.Series(1).CalcXPos(2), .Series(1).CalcYPos(2), _
.Series(1).CalcXPos(3), .Series(1).CalcYPos(3), _
.Series(1).asPoint3D.CalcZPos(3), .Series(1).asPoint3D.CalcZPos(3)
.Canvas.RectangleWithZ .Series(1).CalcXPos(0), .Series(1).CalcYPos(1), .Series(1).CalcXPos(2), .Series(1).CalcYPos(3), .Series(1).asPoint3D.CalcZPos(0)
.Canvas.RectangleWithZ .Series(1).CalcXPos(5), .Series(1).CalcYPos(6), .Series(1).CalcXPos(7), .Series(1).CalcYPos(8), .Series(1).asPoint3D.CalcZPos(5)
.Canvas.RectangleY .Series(1).CalcXPos(0), .Series(1).CalcYPos(0), .Series(1).CalcXPos(2), .Series(1).asPoint3D.CalcZPos(0), .Series(1).asPoint3D.CalcZPos(5)
.Canvas.Plane3D .Series(1).CalcXPos(0), .Series(1).CalcYPos(0), .Series(1).CalcXPos(8), .Series(1).CalcYPos(8), .Series(1).asPoint3D.CalcZPos(0), .Series(1).asPoint3D.CalcZPos(8)
.Canvas.Plane3D .Series(1).CalcXPos(1), .Series(1).CalcYPos(1), .Series(1).CalcXPos(7), .Series(1).CalcYPos(7), .Series(1).asPoint3D.CalcZPos(1), .Series(1).asPoint3D.CalcZPos(7)
.Canvas.RectangleWithZ .Series(1).CalcXPos(10), .Series(1).CalcYPos(11), .Series(1).CalcXPos(12), .Series(1).CalcYPos(13), .Series(1).asPoint3D.CalcZPos(10)
.Canvas.Plane3D .Series(1).CalcXPos(14), .Series(1).CalcYPos(14), .Series(1).CalcXPos(16), .Series(1).CalcYPos(16), .Series(1).asPoint3D.CalcZPos(14), .Series(1).asPoint3D.CalcZPos(16)
.Canvas.Plane3D .Series(1).CalcXPos(18), .Series(1).CalcYPos(18), .Series(1).CalcXPos(20), .Series(1).CalcYPos(20), .Series(1).asPoint3D.CalcZPos(18), .Series(1).asPoint3D.CalcZPos(20)
End With
End If
End Sub
Private Sub tchart2_OnClickSeries(ByVal SeriesIndex As Long, ByVal ValueIndex As Long, ByVal Button As TeeChart.EMouseButton, ByVal Shift As TeeChart.EShiftState, ByVal X As Long, ByVal Y As Long)
TChart2.StopMouse
End Sub
Code: Select all
Private Sub TChart1_OnAfterDraw()
Dim Ancho, Largo, Alto, InicioX, InicioY, InicioZ, FinX, FinY, FinZ, btapa
Ancho = 50
Largo = 50
Alto = 25
btapa = Ancho / 2
With TChart1.Canvas
.Brush.Color = vbWhite
.Brush.Style = bsSolid
.BackMode = cbmOpaque
End With
'--- Plano Largo-Alto (0). Cara larga del frente
With TChart1.Axis
InicioX = .Bottom.CalcXPosValue(0)
InicioY = .Left.CalcYPosValue(0)
InicioZ = .Depth.CalcPosPoint(0)
FinX = .Bottom.CalcXPosValue(Largo)
FinY = .Left.CalcYPosValue(Alto)
FinZ = .Depth.CalcPosPoint(Ancho)
End With
With TChart1.Canvas
.PlaneFour3D InicioX, InicioY, _
InicioX, FinY, _
FinX, FinY, _
FinX, InicioY, _
InicioZ, FinZ
End With
'--- Plano Largo-Alto (0). Tapa del frente
With TChart1.Axis
InicioX = .Bottom.CalcXPosValue(0)
InicioY = .Left.CalcYPosValue(Alto)
InicioZ = .Depth.CalcPosPoint(0)
FinX = .Bottom.CalcXPosValue(Largo)
FinY = .Left.CalcYPosValue(Alto - Cos(45 * pi / 180) * btapa)
FinZ = .Depth.CalcXPosValue(-btapa)
End With
With TChart1.Canvas
.PlaneFour3D InicioX, InicioY, _
FinX, InicioY, _
FinX, FinY, _
InicioX, FinY, _
InicioZ, FinZ
End With
End Sub