高手求教

5007397

<RE>请问一下这个子函数怎么才能在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</PRE>

laoliu09

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

wyj7485

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

5007397

5007397发表于2005-12-7 9:56:00回复：（5007397）高手求教 请问一下这个子函数怎么才能在VB里面被调用 Public Function AddCir2P(ByVal pt1 As Variant, ByVal pt2 As Variant) As Aca...

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???????????????????