用Visual Basic二次开发AutoCAD的滚刀软件

一、程序软件

本软件的功能：

①可以设计标准剃前滚刀、非标剃前滚刀、标准渐开线花键滚刀、矩形花键滚刀、三角花键滚刀和链轮滚刀。

②可以通过摸拟的方式完成一些非标刀具的设计。

③可以实现工件摸拟滚刀、工件摸拟内外插齿刀、滚刀摸拟工件和内外插刀摸拟工件等。

以非标剃前滚刀设计为例介绍软件功能。工件参数：m2 z26 α30°，大径54.5mm，小径48.45～48.6mm，K=4W=21.35～21.4mm，修缘0.2mm。设计一把φ70mm×80mm，内孔27mm的修缘滚刀。

（1）输入参数。如图1所示，单击滚刀，再单击剃前滚刀，到图2所示下一界面输入工件的参数。

图　1

图　2

（2）输入参数后点击计算，计算结果会传输至CAD中，自动画出滚刀齿形图，如图3所示。

图3　滚刀图样

（3）验证滚刀齿形。用滚刀齿形图摸拟工件的形状，看看倒角是否合理。如图4所示依次单击滚刀摸拟、已知滚刀摸拟工件，或者点主界面的mini按键。摸拟结果如图5所示，验证结果显示滚刀齿形合格。

图　4

图5　滚刀摸拟工件结果

（4）验证滚刀外形。单击滚刀外形，在图6所示界面输入参数，单击Command1，后自动画出滚刀外形图如图7所示。

图　6

图7　滚刀外形

经验证合格，可以加工。如果不需要修改变量，重新生成，一把修缘渐开线花键滚刀就设计完成。

二、部分程序代码

（1）画滚刀外形图程序：

Private Sub Command1_Click()

De = Val(Combo1.Text)

re = Val(Text1.Text)

h = Val(Text2.Text)

R = Val(Text3.Text)

θ = Val(Text4.Text)

kong = Val(Combo2.Text)

z = Val(Text5.Text)

s1 = h * Tan(radians(re))

S2 = R / Tan(radians((90 – re) / 2))

xr = S2 – s1

yr = De / 2 – h + R ‘圆心坐标为xR,yR

xa = xr – R * Cos(radians(re))

ya = yr + R * Sin(radians(re))

xb = xr + R * Cos(radians(re + θ))

yb = yr – R * Sin(radians(re + θ))

ψ = radians(90 – re – θ)

K = Tan(ψ)

b = yb – xb / Tan(pi / 2 – ψ)

hc = De / 2 – yb

xc = (-2 * K * b + ((2 * K * b) ^ 2 – 4 * (K ^ 2 + 1) * (b ^ 2 – (De / 2)^ 2)) ^ 0.5) / 2 / (K ^ 2 + 1)

yc = K * xc + b

‘yc = DE / 2

‘xc = xb + HC / Tan(radians(90 – re – θ))

Call Ch2_addcir(0, 0, De / 2)

Call Ch2_addcir(0, 0, kong / 2)

‘A B C三点坐标

‘ Call Ch2_addline(0, DE / 2, XA, YA)

‘Call Ch2_addline(xB, yB, Xc, Yc)

‘Call Ch2_addarc(xR, yR, R, pi – re * pi / 180, (90 – re – θ) * pi / 180+ pi – re * pi / 180 + (90 + re) * pi / 180)

Dim AcadDoc As AcadDocument ‘定义CAD文件

Set AcadDoc = Acadapp.ActiveDocument

Dim lin1 As AcadLine ‘定义CAD线

Dim lin2 As AcadLine

Dim arc1 As AcadArc

Dim cPoint(0 To 2) As Double ‘定义起点

Dim EndPoint(0 To 2) As Double ‘定义终点

Dim cPoint1(0 To 2) As Double ‘定义起点

Dim EndPoint1(0 To 2) As Double ‘定义终点

Dim cPoint2(0 To 2) As Double ‘定义起点

Dim cPoint3(0 To 2) As Double ‘定义起点

cPoint(0) = 0

cPoint(1) = De / 2

cPoint(2) = 0

EndPoint(0) = xa

EndPoint(1) = ya

‘———————–

cPoint1(0) = xb

cPoint1(1) = yb

cPoint1(2) = 0

EndPoint1(0) = xc

EndPoint1(1) = yc

‘————————————–

cPoint2(0) = xr

cPoint2(1) = yr

cPoint2(2) = 0

‘———————

cPoint3(0) = 0

cPoint3(1) = 0

cPoint3(2) = 0

Dim linq As Variant

Dim linq2 As Variant

Dim linq3 As Variant

Set lin1 = AcadDoc.ModelSpace.AddLine(cPoint, EndPoint) ‘CAD画线

Set lin2 = AcadDoc.ModelSpace.AddLine(cPoint1, EndPoint1) ‘CAD画线

Set arc1 = AcadDoc.ModelSpace.AddArc(cPoint2, R, pi – re * pi / 180, (90- re – θ) * pi / 180 + pi – re * pi / 180 + (90 + re) * pi / 180) ‘CAD画线

linq = lin1.ArrayPolar(z + 1, pi * 2, cPoint3)

linq2 = lin2.ArrayPolar(z + 1, pi * 2, cPoint3)

linq3 = arc1.ArrayPolar(z + 1, pi * 2, cPoint3)

End Sub

（2）块的引用子程序：

Sub Ch2_addblock(a, b, c As String) ‘设定自定义函数

‘画线(相对坐标)a为X坐标,b为Y坐标,c,d为相对坐标

Dim AcadDoc As AcadDocument ‘定义CAD文件

Set AcadDoc = Acadapp.ActiveDocument

Dim blo As AcadBlock ‘定义CAD线

Dim cPoint(0 To 2) As Double ‘定义起点

Dim blockrefobj As AcadBlockReference

cPoint(0) = a

cPoint(1) = b

cPoint(2) = 0

Set blockrefobj = AcadDoc.ModelSpace.InsertBlock(cPoint, c, 1#, 1#, 1#,0)

End Sub ‘结束子程序