zoukankan      html  css  js  c++  java
  • AutoCAD VBA创建圆

    AutoCAD VBA创建圆,包括利用圆心半径、圆心直径、两点法和三点发四种方式,代码如下。

    Public Function AddCircle(ByVal ptCen As Variant, ByVal radius As Variant) As Variant
    Dim objCir As AcadCircle
    Set objCir = ThisDrawing.ModelSpace.AddCircle(ptCen, radius)
    Set AddCircle = objCir
    End Function
    Public Function AddCircleCD(ByVal ptCen As Variant, ByVal diameter As Variant) As AcadCircle
    Dim objCir As AcadCircle
    Set objCir = ThisDrawing.ModelSpace.AddCircle(ptCen, diameter / 2)
    Set AddCircleCD = objCir
    End Function
    Public Function AddCircle2P(ByVal pt1 As Variant, ByVal pt2 As Variant) As AcadCircle
    Dim ptCen(0 To 2) As Double
    Dim objCir As AcadCircle
    Dim diateter As Double
    ptCen(0) = (pt1(0) + pt2(0)) / 2
    ptCen(1) = (pt1(1) + pt2(2)) / 2
    ptCen(2) = 0
    diameter = Sqr((pt2(0) - pt1(0)) ^ 2 + (pt2(1) - pt1(1)) ^ 2)
    Set objCir = ThisDrawing.ModelSpace.AddCircle(ptCen, diameter / 2)
    Set AddCircle2P = objCir
    End Function
    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.addcir(ptCen, radius)
    Set AddCircle3P = objCir
    End Function
    Public Sub TestCircle()
    Dim pt1, pt2, pt3 As Variant
    Dim radius As Double
    pt1 = ThisDrawing.Utility.GetPoint(, "指定圆心:")
    radius = ThisDrawing.Utility.GetReal("输入半径:")
    AddCircle pt1, radius
    pt1 = ThisDrawing.Utility.GetPoint(, "指定圆心:")
    radius = ThisDrawing.Utility.GetReal("输入直径:")
    AddCircleCD pt1, radius
    pt1 = ThisDrawing.Utility.GetPoint(, "输入第一点:")
    pt2 = ThisDrawing.Utility.GetPoint(pt1, "输入第二点:")
    AddCircle2P pt1, pt2
    pt1 = ThisDrawing.Utility.GetPoint(, "输入第一点:")
    pt2 = ThisDrawing.Utility.GetPoint(pt1, "输入第二点:")
    pt3 = ThisDrawing.Utility.GetPoint(pt2, "输入第三点:")
    AddCircle3P pt1, pt2, pt3
    End Sub

    代码完。

    最后一种方式错误提示:对象不支持该属性或方法。

    作者:codee
    文章千古事,得失寸心知。


  • 相关阅读:
    vnc安装
    centos下安装图形界面
    granfana telegraf influx安装与使用
    jenkins安装与使用
    yum使用手册
    Python模块--并发相关threading、multiprocessing、Queue、gevent
    Python模块--logging
    Python模块--psutil
    python模块--Beautifulsoup
    Python模块--Pexpect
  • 原文地址:https://www.cnblogs.com/bimgoo/p/2502911.html
Copyright © 2011-2022 走看看