高手求教

5007397 · 发表于 2005-12-7 09:56:00

&ltRE>请问一下这个子函数怎么才能在VB里面被调用
Public Function AddCir2P(ByVal pt1 As Variant, ByVal pt2 As Variant) As AcadCircle
Dim ptCen(0 To 2) As Double
Dim objCir As AcadCircle
Dim diameter As Double

ptCen(0) = (pt1(0) + pt2(0)) / 2
ptCen(1) = (pt1(1) + pt2(1)) / 2
ptCen(2) = 0

diameter = Sqr((pt2(0) - pt1(0)) ^ 2 + (pt2(1) - pt1(1)) ^ 2) / 2

Set objCir = ThisDrawing.ModelSpace.AddCircle(ptCen, diameter / 2)

Set AddCir2P = objCir
End Function

laoliu09 · 发表于 2005-12-7 10:15:00

你要在VB里先引用CAD的类型库！！！！！！！

wyj7485 · 发表于 2005-12-7 10:17:00

AddCir2P ThisDrawing.Utility.GetPoint(, "点1"), ThisDrawing.Utility.GetPoint(, "点2")

5007397 · 发表于 2005-12-7 10:56:00

Private Sub Command1_Click()

Dim objControl As Control
For Each objControl In form1.Controls
      If TypeOf objControl Is TextBox Then
         If objControl.Text = "" Then
            MsgBox "缺少参数，无法计算！", vbCritical
            Exit Sub
         End If
      End If
Next
On Error Resume Next

Dim pt7(0 To 2) As Double, pt8(0 To 2) As Double

Dim acadApp As AcadApplication
Set acadApp = GetObject _
(, "AutoCAD.Application.16")
If Err Then
Err.Clear
Set acadApp = CreateObject _
("AutoCAD.Application.16")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
Dim acadDoc As AcadDocument
Set acadDoc = acadApp.ActiveDocument
Dim objLine3 As AcadLine
Dim objCircle3 As AcadCircle
   pt7(0) = 0
   pt7(1) = 0
   pt7(2) = 0
   pt8(0) = 1000
   pt8(1) = 0
   pt8(2) = 0

Set objLine3 = acadDoc.ModelSpace.AddLine(pt7, pt8)
Set objCircle3 = acadDoc.ModelSpace.AddCir2P(pt7, pt8)

ZoomAll
End Sub
怎么调用AddCir2P???????????????????

高手求教

发表回复

精选推荐