creation.cls

《AutoCAD VBA开发技术》一书的源代码。对从事AutoCAD二次开发的朋友参考价值极高。

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Creation"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'计算两点之间距离
Public Function GetDistance(sp As Variant, ep As Variant) As Double
    Dim x As Double
    Dim y As Double
    Dim z As Double
    
    x = sp(0) - ep(0)
    y = sp(1) - ep(1)
    z = sp(2) - ep(2)
    
    GetDistance = Sqr((x ^ 2) + (y ^ 2) + (z ^ 2))
End Function

'获得相对已经点偏移一定距离的点
Public Function GetPoint(pt As Variant, x As Double, y As Double) As Variant
    Dim ptTarget As Variant
    
    ptTarget(0) = pt(0) + x
    ptTarget(1) = pt(1) + y
    ptTarget(2) = 0
    
    GetPoint = ptTarget
End Function

'获得与已知点具有相同Y坐标的一点
Public Function GetPointAtX(pt As Variant, x As Double) As Variant
    GetPointAtX = GetPoint(pt, x, 0)
End Function

'获得与已知点具有相同X坐标的一点
Public Function GetPointAtY(pt As Variant, y As Double) As Variant
    GetPointAtY = GetPoint(pt, 0, y)
End Function

'获得两点的中点
Public Function GetMidPt(pt1 As Variant, pt2 As Variant) As Variant
    Dim ptMid As Variant
    
    ptMid(0) = (pt1(0) + pt2(0)) / 2
    ptMid(1) = (pt1(1) + pt2(1)) / 2
    ptMid(0) = 0
    
    GetMidPt = ptMid
End Function

'计算三点确定的圆形的圆心和半径
Public Function GetCenOf3Pt(pt1 As Variant, pt2 As Variant, pt3 As Variant, _
    ByRef radius As Double) As Variant
    
    Dim xysm, xyse, xy As Double
    Dim ptCen(2) As Double
    
    xy = pt1(0) ^ 2 + pt1(1) ^ 2
    xyse = xy - pt3(0) ^ 2 - pt3(1) ^ 2
    xysm = xy - pt2(0) ^ 2 - pt2(1) ^ 2
    xy = (pt1(0) - pt2(0)) * (pt1(1) - pt3(1)) - (pt1(0) - pt3(0)) * (pt1(1) - pt2(1))
    
    '判断参数有效性
    If Abs(xy) < 0.000001 Then
        MsgBox "所输入的参数无法创建圆形！"
        Exit Function
    End If
    
    '获得圆心和半径
    ptCen(0) = (xysm * (pt1(1) - pt3(1)) - xyse * (pt1(1) - pt2(1))) / (2 * xy)
    ptCen(1) = (xyse * (pt1(0) - pt2(0)) - xysm * (pt1(0) - pt3(0))) / (2 * xy)
    ptCen(2) = 0
    radius = Sqr((pt1(0) - ptCen(0)) * (pt1(0) - ptCen(0)) + (pt1(1) - ptCen(1)) * (pt1(1) - ptCen(1)))
    
    If radius < 0.000001 Then
        MsgBox "半径过小！"
        Exit Function
    End If
    
    '函数返回圆心的位置，而半径则在参数中通过引用方式返回
    GetCenOf3Pt = ptCen
End Function