如何解决使用 TChart activex 在 VBA Excel 中以 3D 形式绘制不透明表面的奇怪行为
我正在尝试使用 VBA EXCEL 中的 tee Chart 2021 在 3D 中绘制框。 壁箱有 3 个尺寸，高度、宽度和厚度。我正在做 仙女到现在为止。但我面临一个问题。我正在使用画布 on_afterdraw 方法 使墙壁表面不透明，但我的代码不能完全正常工作。
用同样的代码画两面平行的墙，其中之一画得很完美， 所有的表面（6 个面）都绘制为不透明的。另一个，六个中只有五个 脸被绘制为不透明的。我很困惑。
我附上了一些来自不同地点的图片 这样你就可以看到我的代码的奇怪行为。我也复制了 下面的代码。要运行它，您必须在 VBA Exel 中插入一个用户表单和一个实例 tChart 控件，并运行它。
为了简单起见，我已经注释掉了一些说明，所以只是墙壁平行于 绘制左下平面。
teeCommander 链接到图表，因此您可以移动、旋转、缩放它
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,eCaja
'makeIsoAxisBis TChart1
notFinished = False
End Sub
Private Sub drawBox3d(theChart As TChart,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,"XY",eCaja
drawSolidWall theChart,Ancho - eCaja,eCaja
' drawSolidWall theChart,"XZ",eCaja
' drawSolidWall theChart,Alto - eCaja,"YZ",Largo - eCaja,eCaja
End Sub
Private Sub drawSolidWall(theChart As TChart,x0,plane,wLargo,wAlto,wEspesor)
Select Case UCase(plane)
Case "XY"
makeXYPlane theChart,x0 + wLargo,y0 + wAlto,z0
makeXYPlane theChart,z0 + wEspesor
makeYZPlane theChart,z0 + wEspesor
makeXZPlane theChart,z0 + wEspesor
Case "XZ"
makeXYPlane theChart,y0 + wEspesor,z0 + wAlto
makeYZPlane theChart,z0 + wAlto
makeXZPlane theChart,z0 + wAlto
Case "YZ"
makeXYPlane theChart,x0 + wEspesor,z0 + wLargo
makeYZPlane theChart,z0 + wLargo
makeXZPlane theChart,z0 + wLargo
End Select
End Sub
Private Sub makeXYPlane(theChart As TChart,z1)
addpoint3dSeriesBis theChart,newSeries
With theChart
.Series(newSeries).asPoint3D.AddXYZ x0,z1,"0",clTeeColor 'Punto 0
.Series(newSeries).asPoint3D.AddXYZ x1,"1",clTeeColor ' Punto 1
.Series(newSeries).asPoint3D.AddXYZ x1,"2",clTeeColor ' Punto 2
.Series(newSeries).asPoint3D.AddXYZ x0,"3",clTeeColor ' Punto 3
.Series(newSeries).asPoint3D.AddXYZ x0,"4",clTeeColor ' Punto 4
End With
planeType(newSeries) = "XY"
End Sub
Private Sub makeYZPlane(theChart As TChart,newSeries
With theChart
.Series(newSeries).asPoint3D.AddXYZ x1,clTeeColor ' Punto 2
.Series(newSeries).asPoint3D.AddXYZ x1,clTeeColor ' Punto 3
.Series(newSeries).asPoint3D.AddXYZ x1,clTeeColor ' Punto 4
End With
planeType(newSeries) = "YZ"
End Sub
Private Sub makeXZPlane(theChart As TChart,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).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).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
The bottom cube has one of its faces missing or transparend
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。