Private Sub DrawAllMap_Click()
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set acadApp = CreateObject("AutoCAD.Application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
'MsgBox "现在运行"+acadApp.Name+"版本号"+acadApp.Version
acadApp.Visible = True
acadApp.Left = 0
acadApp.Top = 0
acadApp.Width = 1000
acadApp.Height = 700
'Dim acadDoc AS acadDocument
Set acadDoc = acadApp.activeDocument '设定当前文档为活动文档
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''以上为启动AuotCAD绘图软件
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const Pi = 3.1415926
'定义X,X1,..X8,定义Y,Y1,...Y9,定义R1,...R2,定义a1,a2,...,a4
Dim X As Double
Dim X1 As Double
Dim X2 As Double
Dim X3 As Double
Dim X4 As Double
Dim X5 As Double
Dim X6 As Double
Dim X7 As Double
Dim X8 As Double
Dim M As Double
'以上为定义X轴方向几何尺寸
Dim Y As Double
Dim Y1 As Double
Dim Y2 As Double
Dim Y3 As Double
Dim Y4 As Double
Dim Y5 As Double
Dim Y6 As Double
Dim Y7 As Double
Dim Y8 As Double
Dim Y9 As Double
'以上为定义Y轴方向几何尺寸
Dim R1 As Double
Dim R2 As Double
'以上为定义半径尺寸
Dim a1 As Double
Dim a2 As Double
Dim a3 As Double
Dim a4 As Double
Dim IP1 As PD '定义俯视图的绘图基点(InsertPoint=IP
Dim IP2 As PD '定义主视图的绘图基点
IP1.X = X
IP1.Y = Y
IP2.X = X
IP2.Y = Y + Y1 / 2 + Y2 + Y3 + 30
'IP1,IP2为俯视图和主视图的绘图基点
Dim P1 As PD
Dim P2 As PD
P1.X = IP1.X - X1 / 2
P1.Y = IP1.Y + Y1 / 2
P2.X = IP1.X + X1 / 2
P2.Y = IP1.Y + Y1 / 2
Dim P3 As PD
Dim P4 As PD
P3.X = IP1.X - X1 / 2
P3.Y = IP1.Y + Y1 / 2 + Y2
P4.X = IP1.X + X1 / 2
P4.Y = IP1.Y + Y1 / 2 + Y2
Dim P5 As PD
Dim P6 As PD
P5.X = IP1.X - X2 / 2
P5.Y = IP1.Y + Y1 / 2 + Y2
P6.X = IP1.X + X2 / 2
P6.Y = P5.Y
Dim P7 As PD
Dim P8 As PD
P7.X = P5.X
P7.Y = P5.Y + Y3
P8.X = P6.X
P8.Y = P7.Y