|
|
我初学VBA，想通过把以前的一些简单的LISP程序编成VBA，进行学习。
以下是lisp程序，《分别捕捉三条直线上的切点，画出切圆》很好用，但如何用VBA实现它呢？
(defun c:c3 ()
(setq p1 (getpoint "\n第一点切点：")
p2 (getpoint "\n第二点切点：")
p3 (getpoint "\n第三点切点：")
)
(command "circle" "3p" "_tan" p1 "_tan" p2 "_tan" p3)
)
以上程序可以在捕捉P1 P2 P3点时，显示出切点的自动捕捉标记。
而我尝试的VBA程序如下：
Option Explicit
Public Sub TestCircle()
Dim pt1 As Variant, pt2, pt3
Dim obj As AcadCircle
Dim os As Integer, os_value
os_value = 256
os = ThisDrawing.GetVariable("osmode")
ThisDrawing.SetVariable "osmode", os_value
pt1 = ThisDrawing.Utility.GetPoint(, "请指定第一点:")
pt2 = ThisDrawing.Utility.GetPoint(, "请指定第二点:")
pt3 = ThisDrawing.Utility.GetPoint(, "请指定第三点:")
AddCircle3P pt1, pt2, pt3
ThisDrawing.SetVariable "osmode", os
End Sub
Option Explicit
Public Function AddCircle3P(ByVal pt1 As Variant, ByVal pt2 As Variant, ByVal pt3 As Variant) As AcadCircle
Dim xysm, xyse, xy As Double
Dim ptCen(0 To 2) As Double
Dim radius As Double
Dim objCir As AcadCircle
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
Set objCir = ThisDrawing.ModelSpace.AddCircle(ptCen, radius)
'由于返回值是对象，必须加上set
Set AddCircle3P = objCir
End Function
'AddCircle3P函数摘自MCCAD的《 vba开发精彩实例》
问题的关键是ThisDrawing.Utility.GetPoint不考虑osmode，请问如何解决呢？
|
|
置顶卡
