社区 › VBA/VB/ActiveX/API 编程技术 › 学习VBA开发发生了一些问题，新人求教

cadlearner 发表于 2020-9-2 10:40:49

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

本人在学习《AutoCADVBA＆VB.NET开发基础与实例教程》一书中编写代码实现有一点问题。关键对于动态数组的实现有一点问题，图形的实现效果也与书中不同，本人希望能得到大佬的指点一下。因书中的模块都会在后面用到，所以希望能解决一下。attach://110663.dvb

cadlearner 发表于 2020-9-7 10:03:12

本帖最后由 cadlearner 于 2020-9-7 10:29 编辑

sgwsssxm 发表于 2020-9-7 00:18
If i Mod 2 = 0 Then
    point(0) = centerpoint(0) + radius * Sin((i / 2) * sideAngle)
    verts. ...
好的，问题现在已解决，多谢帮助。

sgwsssxm 发表于 2020-9-7 10:23:32

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

cadlearner 发表于 2020-9-4 13:30:04

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 发表于 2020-9-4 13:26:20

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 发表于 2020-9-3 09:49:35

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

cadlearner 发表于 2020-9-4 10:24:32

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 发表于 2020-9-4 10:25:12

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 发表于 2020-9-4 13:29:07

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 发表于 2020-9-4 13:29:34

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 发表于 2020-9-7 00:18:34

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 发表于 2020-9-7 00:26:46

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 删除，全局变量要放在公共的位置，局部变量就算命名一样，也是互相独立、互不影响的。

查看完整版本: 学习VBA开发发生了一些问题，新人求教