求大神帮忙用VBA编程画这几个图，急急急，先谢谢啦！！！！！！！ [复制链接]

图片:1.png

图片:2.png

图片:3.png

第一幅图的程序写好了，给你贴上去；
Sub huitu1()
Dim cir As AcadCircle
Dim cent1(0 To 2) As Double  ' 小圆圆心
Dim rr As Double '半径
Dim linep1(0 To 2) As Double '线条端点1
Dim linep2(0 To 2) As Double '线条端点1
Dim centerp As Variant '中心坐标
Dim retObj As Variant
Dim numberOfRows As Long
Dim numberOfColumns As Long
Dim numberOfLevels As Long
Dim distanceBwtnRows As Double
Dim distanceBwtnColumns As Double
Dim distanceBwtnLevels As Double
On Error Resume Next
kuan = ThisDrawing.Utility.GetReal("矩形宽度:")
chang = ThisDrawing.Utility.GetReal("矩形长度:")
rr = ThisDrawing.Utility.GetReal("请输入小圆半径:")
centerp = ThisDrawing.Utility.GetPoint(, "定位绘图中心:")
'绘制矩形
linep1(0) = centerp(0) + chang / 2
linep1(1) = centerp(1) + kuan / 2
linep2(0) = centerp(0) - chang / 2
linep2(1) = centerp(1) - kuan / 2
Call drawbox(linep1, linep2) '调用画矩形子程序
'绘小圆
cent1(0) = centerp(0) - 25
cent1(1) = centerp(1) - 16
Set cir = ThisDrawing.ModelSpace.AddCircle(cent1, rr)
numberOfRows = 2
numberOfColumns = 2
numberOfLevels = 1
distanceBwtnRows = 32
distanceBwtnColumns = 50
distanceBwtnLevels = 1
retObj = cir.ArrayRectangular(numberOfRows, numberOfColumns, numberOfLevels, distanceBwtnRows, distanceBwtnColumns, distanceBwtnLevels)
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

1楼的真行。
好人！

第二张图的程序：
Sub zhenlie()
Dim rr1 As Double '半径
Dim rr2 As Double
Dim rr3 As Double
Dim centerp As Variant '中心坐标
Dim zly As AcadCircle
On Error Resume Next
centerp = ThisDrawing.Utility.GetPoint(, "定位绘图中心:")
rr1 = ThisDrawing.Utility.GetReal("请输入内圆的半径:")
rr2 = ThisDrawing.Utility.GetReal("请输入外圆的半径:")
rr3 = ThisDrawing.Utility.GetReal("请输入阵列圆的半径:")
'绘小圆
Call Example_AddCircle(centerp, rr1) '调用画圆子程序
Call Example_AddCircle(centerp, rr2)
Set zly = ThisDrawing.ModelSpace.AddCircle(centerp, rr3)
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
Dim point3(0 To 2) As Double
Dim point4(0 To 2) As Double
Dim point5(0 To 2) As Double
Dim point6(0 To 2) As Double
point1(0) = centerp(0): point1(1) = centerp(1)
point2(0) = centerp(0) - (rr1 + rr2) / 2: point2(1) = centerp(1)
zly.Move point1, point2
zly.Update
point3(0) = centerp(0): point3(1) = centerp(1) + rr2 + 10
point4(0) = centerp(0): point4(1) = centerp(1) - rr2 - 10
point5(0) = centerp(0) - rr2 - 10: point5(1) = centerp(1)
point6(0) = centerp(0) + rr2 + 10: point6(1) = centerp(1)
Call ThisDrawing.ModelSpace.AddLine(point3, point4) '竖直中心线
Call ThisDrawing.ModelSpace.AddLine(point5, point6) '水平中心线
Dim noOfObjects As Integer
Dim angleToFill As Double
Dim basePnt(0 To 2) As Double
Dim retObj As Variant
noOfObjects = 8
angleToFill = 3.1415926 * 2        ' 360 degrees
basePnt(0) = centerp(0): basePnt(1) = centerp(1)
retObj = zly.ArrayPolar(noOfObjects, angleToFill, basePnt)
ZoomAll
End Sub
Private Sub Example_AddCircle(c0, rr) '根据圆心和半径绘制圆的子程序
Dim centerPoint As Variant
Dim radius As Double
'定义圆
centerPoint = c0
radius = rr
'在模型空间中创建圆对象
Call ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
End Sub

感谢解答，给您加分

高手啊  ，遇到这样的高手真是压力很大啊

第三幅图的，矩形的相对位置关系略有问题，你可以自己调一下
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

我写的程序比较繁琐，你可以优化一下

谢谢大神啊 您真是帮了大忙了

yjy4519 是真大神呀！

果真是牛B大神，膜拜

是真大神呀！