第三幅图的,矩形的相对位置关系略有问题,你可以自己调一下
Option Explicit
Public Sub huitu3()
' 该示例在模型空间中创建圆弧。
Dim arcObj1 As AcadArc
Dim arcObj2 As AcadArc
Dim centerPoint1(0 To 2) As Double
Dim centerPoint2(0 To 2) As Double
Dim radius1 As Double
Dim radius2 As Double
Dim startAngleInDegree1 As Double
Dim startAngleInDegree2 As Double
Dim endAngleInDegree1 As Double
Dim endAngleInDegree2 As Double
' 定义圆
centerPoint1(0) = 0#: centerPoint1(1) = 0#: centerPoint1(2) = 0#
centerPoint2(0) = -95#: centerPoint2(1) = 65#: centerPoint2(2) = 0#
radius1 = 5#
radius2 = 60#
startAngleInDegree1 = 0#
endAngleInDegree1 = 90#
startAngleInDegree2 = 0#
endAngleInDegree2 = 90#
' 转换度数表示的角度为弧度表示的角度
Dim startAngleInRadian1 As Double
Dim startAngleInRadian2 As Double
Dim endAngleInRadian1 As Double
Dim endAngleInRadian2 As Double
startAngleInRadian1 = startAngleInDegree1 * 3.1415926 / 180#
endAngleInRadian1 = endAngleInDegree1 * 3.1415926 / 180#
startAngleInRadian2 = startAngleInDegree2 * 3.1415926 / 180#
endAngleInRadian2 = endAngleInDegree2 * 3.1415926 / 180#
' 在模型空间中创建圆弧对象
Set arcObj1 = ThisDrawing.ModelSpace.AddArc(centerPoint1, radius1, startAngleInRadian1, endAngleInRadian1)
Set arcObj2 = ThisDrawing.ModelSpace.AddArc(centerPoint2, radius2, startAngleInRadian2, endAngleInRadian2)
' 开始倒圆角
Dim myr As Double
myr = 30
ThisDrawing.SendCommand "_fillet" & vbCr & "r" & vbCr & myr & vbCr
ThisDrawing.SendCommand "_fillet" & vbCr & "0,5,0" & vbCr & "-35,65,0" & vbCr
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim p3(0 To 2) As Double
Dim line1 As AcadLine
Dim line2 As AcadLine
p1(0) = 5: p1(1) = 0: p1(2) = 0
p2(0) = 5: p2(1) = -40: p2(2) = 0
p3(0) = -95: p3(1) = -40: p3(2) = 0
Set line1 = ThisDrawing.ModelSpace.AddLine(p1, p2)
Set line2 = ThisDrawing.ModelSpace.AddLine(p2, p3)
'镜像所绘制图形
'镜像轴线
Dim p4(0 To 2) As Double
Dim p5(0 To 2) As Double
Dim ent As AcadEntity
p4(0) = -95: p4(1) = 135: p4(2) = 0
p5(0) = -95: p5(1) = -50: p5(2) = 0
For Each ent In ThisDrawing.ModelSpace '所有模型空间的对象进行一次循环
ent.Mirror p4, p5 '镜像
Next ent
'绘制小圆
Dim circle1 As AcadCircle
Dim radius3 As Double
radius3 = 30
'绘制小矩形
Dim p6(0 To 2) As Double
Dim p7(0 To 2) As Double
p6(0) = -125: p6(1) = -20: p6(2) = 0
p7(0) = -65: p7(1) = 0: p7(2) = 0
Call drawbox(p6, p7)
Set circle1 = ThisDrawing.ModelSpace.AddCircle(centerPoint2, radius3)
ZoomAll
End Sub
Private Sub drawbox(p1, p2) '根据对角线坐标画矩形的子程序
Dim boxp(0 To 14) As Double
boxp(0) = p1(0)
boxp(1) = p1(1)
boxp(3) = p1(0)
boxp(4) = p2(1)
boxp(6) = p2(0)
boxp(7) = p2(1)
boxp(9) = p2(0)
boxp(10) = p1(1)
boxp(12) = p1(0)
boxp(13) = p1(1)
Call ThisDrawing.ModelSpace.AddPolyline(boxp)
End Sub