学习VBA开发发生了一些问题，新人求教

cadlearner

本人在学习《AutoCADVBA＆VB.NET开发基础与实例教程》一书中编写代码实现有一点问题。关键对于动态数组的实现有一点问题，图形的实现效果也与书中不同，本人希望能得到大佬的指点一下。因书中的模块都会在后面用到，所以希望能解决一下。http://bbs.mjtd.com/forum.php?mod=attachment&aid=MTEwNjYzfGE4ZGIxYzk4ODA4MjJlYjExYjhmZmExYjlkYjAzYmE5fDE3MzI0ODE5NDg%3D&request=yes&_f=.dvb

cadlearner

sgwsssxm 发表于 2020-9-7 00:18
If i Mod 2 = 0 Then
    point(0) = centerpoint(0) + radius * Sin((i / 2) * sideAngle)
    verts. ...

好的，问题现在已解决，多谢帮助。

sgwsssxm

这就是m_bFirstItem的问题了，我说的两个地方都改了，最后显示效果才能对上。

cadlearner

Option Explicit
Private m_verts() As Double

Private Sub Class_Initialize()
ReDim m_verts(1)

Dim m_bFirstItem As Boolean
m_bFirstItem = True
End Sub


Public Function Append(ByVal point As Variant)
Debug.Assert (VarType(point) = vbArray + vbDouble)
Debug.Assert (UBound(point) >= 1)
Dim m_bFirstItem As Boolean
If (m_bFirstItem) Then
        m_bFirstItem = False
Else
ReDim Preserve m_verts(UBound(m_verts) + 2)
End If
m_verts(UBound(m_verts) - 1) = point(0)
m_verts(UBound(m_verts)) = point(1)

End Function
Public Function InsertAt(ByVal i As Integer, ByVal point As Variant) As Boolean
Debug.Assert (VarType(point) = vbArray + vbDouble)
Debug.Assert (UBound(point) >= 1)
Dim m_bFirstItem As Boolean
If (m_bFirstItem) Then
    If (i = 0) Then
        m_verts(0) = point(0)
        m_verts(1) = point(1)
        m_bFirstItem = False
    Else
        InsertAt = False
        Exit Function
    End If
Else
    If (i < 0 Or i > GetCount()) Then
        InsertAt = False
        Exit Function
    Else
        ReDim Preserve m_verts(UBound(m_verts) + 2)
        If (i <> GetCount()) Then
            Dim j As Integer
            For j = UBound(m_verts) To (i + 1) * 2 Step -1
                m_verts(j) = m_verts(j - 2)
            Next j
        End If
        
        m_verts(i * 2) = point(0)
        m_verts(i * 2 + 1) = point(1)

        InsertAt = True
    End If
End If
End Function
Public Function GetCount() As Integer
    Dim m_bFirstItem As Boolean
    If (m_bFirstItem) Then
        GetCount = 0
    Else
        GetCount = (UBound(m_verts) + 1) / 2
    End If
End Function

Public Function RemoveLast() As Boolean
    Dim m_bFirstItem As Boolean
    If (GetCount() > 1) Then
        ReDim Preserve m_verts(UBound(m_verts) - 2)
        RemoveLast = True
   ElseIf (GetCount() = 1) Then
   
        m_verts(0) = 0
        m_verts(1) = 0
        RemoveLast = True
        m_bFirstItem = True
    Else
        RemoveLast = True
    End If
End Function

Public Function RemoveAt(ByVal i As Integer) As Boolean
    If (i < 0 Or i > GetCount() - 1) Then
        RemoveAt = False
        Exit Function
    Else
        If (i <> GetCount() - 1) Then
            Dim j As Integer
            For j = i * 2 To UBound(m_verts) - 2
                m_verts(j) = m_verts(j + 2)
            Next j
        End If
        
        If (GetCount() = 1) Then
            m_verts(0) = 0
            m_verts(1) = 0
            m_bFirstItem = True
        Else
            ReDim Preserve m_verts(UBound(m_verts) - 2)
        End If
    End If
End Function

Public Function SetPoints(ByVal points As Variant) As Boolean
    Debug.Assert (VarType(points) = vbArray + vbDouble)
    Debug.Assert (UBound(points) Mod 2 = 1)
    ReDim m_verts(UBound(points))
    Dim i As Integer
    For i = 0 To UBound(points)
        m_verts(i) = points(i)
    Next i
End Function

Public Function GetAt(ByVal i As Integer, ByRef point As Variant) As Boolean
    If (i < 0 Or i > GetCount() - 1) Then
        GetAt = False
        Exit Function
    Else
        Dim vert(0 To 1) As Double
        SetPoint2d vert, m_verts(i * 2), m_verts(i * 2 + 1)
        point = vert
        GetAt = True
    End If
End Function

Public Function SetAt(ByVal i As Integer, ByVal point As Variant) As Boolean
    Debug.Assert (VarType(point) = vbArray + vbDouble)
    Debug.Assert (UBound(point) = 1)
    If (GetCount() = 0) Then
        SetAt = False
        Exit Function
    Else
        If (i < 0 Or i > GetCount() - 1) Then
            SetAt = False
            Exit Function
        Else
            m_verts(i * 2) = point(0)
            m_verts(i * 2 + 1) = point(1)
        End If
    End If
End Function

Public Function ToArray() As Variant
    ToArray = m_verts
End Function

cadlearner

Public Function AddPolygon(ByVal centerpoint As Variant, ByVal sideCount As Double, ByVal radius As Double, Optional width As Double = 0, Optional angle As Double = 0) As AcadLWPolyline
    Dim math As New clsmath
    Dim sideAngle As Double
        sideAngle = (2 * math.PI()) / sideCount
   
    Dim verts As New cls2dPointArray
    Dim i As Integer
    Dim point(0 To 1) As Double
    For i = 0 To 2 * (sideCount - 1)
        
        If i Mod 2 = 0 Then
            point(0) = centerpoint(0) + radius * Sin((i / 2) * sideAngle)
            verts.Append point
        Else
            point(1) = centerpoint(1) + radius * Cos((i / 2) * sideAngle)
            
        End If
    Next i
    Set AddPolygon = AddLWPolyline(verts.ToArray(), True, width)
    AddPolygon.Rotate centerpoint, angle
    AddPolygon.Update
End Function

mikewolf2k

这个代码应该相当简单，请直接把代码以代码方式贴出来方便别人查看。
回到问题本身，这个程序相当简单，既然是图形错误，估计就是坐标错误导致，自己先检查下坐标值。

cadlearner

Public Sub CreatePolygon()
    Dim centerpoint(0 To 2) As Double
    SetPoint3d centerpoint, 0, 0, 0
   
    Dim mSpace As New clsModelSpace
    mSpace.AddPolygon centerpoint, 6, 50
End Sub

cadlearner

Public Function SetPoint3d(ByRef point As Variant, ByVal x As Double, ByVal y As Double, ByVal z As Double)
    Debug.Assert (VarType(point) = vbArray + vbDouble)
    Debug.Assert (LBound(point) = 0 And UBound(point) = 2)
    point(0) = x
    point(1) = y
    point(2) = z
End Function

cadlearner

Public Function AddLeaderByPolyline(ByVal startPoint As Variant, ByVal endPoint As Variant, Optional widthScale As Double = 0.3) As AcadLWPolyline
    Debug.Assert (VarType(startPoint) = vbArray + vbDouble)
    Debug.Assert (VarType(endPoint) = vbArray + vbDouble)
    Debug.Assert (UBound(startPoint) = 1)
    Debug.Assert (UBound(endPoint) = 1)
   
    Dim verts As New cls2dPointArray
    verts.Append startPoint
    verts.Append endPoint
   
    Set AddLeaderByPolyline = AddLWPolyline(verts.ToArray())
   
    Dim length As Double
    Dim math As New clsmath
    length = math.GetDistanceBetween2Point(startPoint, endPoint)
    AddLeaderByPolyline.SetWidth 0, length * widthScale, 0
   
End Function

cadlearner

Public Function AddLWPolyline(ByVal verts As Variant, Optional closed As Boolean = False, Optional width As Double = 0) As AcadLWPolyline
    Debug.Assert (VarType(verts) = vbArray + vbDouble)
   Debug.Assert (UBound(verts) > 2 And UBound(verts) Mod 2 = 1)
    Set AddLWPolyline = ThisDrawing.ModelSpace.AddLightWeightPolyline(verts)
    If (closed) Then
        AddLWPolyline.closed = True
    End If
    AddLWPolyline.ConstantWidth = width

End Function

sgwsssxm

cadlearner 发表于 2020-9-4 13:26
Public Function AddPolygon(ByVal centerpoint As Variant, ByVal sideCount As Double, ByVal radius A ...

If i Mod 2 = 0 Then
    point(0) = centerpoint(0) + radius * Sin((i / 2) * sideAngle)
    verts.Append point
Else
    point(1) = centerpoint(1) + radius * Cos((i / 2) * sideAngle)
End If
改成
If i Mod 2 = 0 Then
    point(0) = centerpoint(0) + radius * Cos((i / 2) * sideAngle)
    point(1) = centerpoint(1) + radius * Sin((i / 2) * sideAngle)
    verts.Append point
End If
你的 Sin 和 Cos 弄反了，至于你为什么用 i Mod 2 = 0 取偶数，再把 i/2 就看不出来你要干什么了。

sgwsssxm

cadlearner 发表于 2020-9-4 13:30
Option Explicit
Private m_verts() As Double

Private m_verts() As Double
下面加一行
Private m_bFirstItem As Boolean
再把所有 Dim m_bFirstItem As Boolean 删除，全局变量要放在公共的位置，局部变量就算命名一样，也是互相独立、互不影响的。