基于VB&AutoCAD的螺旋面的绘制(原代码)

fff

Private Sub Command1_Click()

Dim theta, r1, r2, h1, h0, l

l = Val(Me.Text1)

theta = Val(Me.Text2) / 180 * 3.1415

r1 = Val(Me.Text3)

r2 = Val(Me.Text4)

ActiveDocument.SendCommand "_shademode" + vbCr + "_G" + vbCr

Dim center_point(0 To 2) As Double

center_point(0) = 0: center_point(1) = 0: center_point(2) = 0

Dim lines(0 To 0) As AcadCircle

Set lines(0) = ActiveDocument.ModelSpace.AddCircle(center_point, r2)

Dim region As Variant

region = ActiveDocument.ModelSpace.AddRegion(lines)

Dim base As Acad3DSolid

h = 5 * l

Set base = ActiveDocument.ModelSpace.AddExtrudedSolid(region(0), h, 0)

base.Color = acBlue

Dim ptcontrol() As Double

Dim ptcontrol1() As Double

Dim k As Integer

Dim liness(0 To 700) As AcadLine

k = 700

ReDim ptcontrol(3 * k + 2) As Double

ReDim ptcontrol1(3 * k + 2) As Double

Dim stpt(0 To 2) As Double

Dim etpt(0 To 2) As Double

For i = 0 To k Step 1

ptcontrol(3 * i) = r2 * Cos(2 * 3.1415926 * i / 180)

ptcontrol(3 * i + 1) = r2 * Sin(2 * 3.1415926 * i / 180)

ptcontrol(3 * i + 2) = l / (2 * 3.1415) * (2 * 3.1415926 * i / 180) + r2 * Tan(theta) - 5

stpt(0) = ptcontrol(3 * i): stpt(1) = ptcontrol(3 * i + 1): stpt(2) = ptcontrol(3 * i + 2)

ptcontrol1(3 * i) = r1 * Cos(2 * 3.1415926 * i / 180)

ptcontrol1(3 * i + 1) = r1 * Sin(2 * 3.1415926 * i / 180)

ptcontrol1(3 * i + 2) = l / (2 * 3.1415) * (2 * 3.1415926 * i / 180) + r1 * Tan(theta) - 5

etpt(0) = ptcontrol1(3 * i): etpt(1) = ptcontrol1(3 * i + 1): etpt(2) = ptcontrol1(3 * i + 2)

Set liness(i) = ActiveDocument.ModelSpace.AddLine(stpt, etpt)

liness(i).Color = acRed

Next i

Dim luo As Acad3DPolyline

Set luo = ActiveDocument.ModelSpace.Add3DPoly(ptcontrol1)

luo.Color = acGreen

Dim wailuo As Acad3DPolyline

Set wailuo = ActiveDocument.ModelSpace.Add3DPoly(ptcontrol)

wailuo.Color = acYellow

End Sub

Private Sub Command2_Click()

End

End Sub

17857226504

这是什么东东