VBA二次开发.docx

1、VBA二次开发The Report of Parametric DesignName: Student No.: Expecting Score: 901. The Object of Design:My design is a program , which is writed by VBA,to drawing a screw bolt .In my design,users can creat a screw bolt just by typing the parameters of the bolt.So ,I design a form,which display the param

2、eters the user should typing in.and then ,users can specify a point as the first point P0,then click “OK ”; a screw bolt is ceated.2. The original picture:The parameters of the screw bolt is like the picture as follow:3. Program: Firstly ,designing the form: Secondly，designing functions of the form

3、above-mentioned:Dim PX As Double 定义存储点的变量 Dim PY As Double Dim P2 As Variant Sub CommandButton1_Click() 将控制权交给AutoCAD UserForm1.Hide 获取点的位置 P2 = ThisDrawing.Utility.GetPoint(, 指定点:) PX = P2(0) PY = P2(1) TextBox13 = P2(0) TextBox14 = P2(1) 返回对话框 UserForm1.ShowEnd SubPrivate Sub quxiao_Click()ZoomExt

4、entsEndEnd SubSub yes_Click() 定义所需要的变量 Dim dk As Double Dim n As Double Dim k As Double Dim t As Double Dim L As Double Dim L1 As Double Dim d As Double Dim plineObj(0 To 9, 0 To 2) As AcadLine 定义一个二维数组，存储所画的直线 Dim i As Integer 定义循环控制变量 Dim j As Integer Dim P0(0 To 2) As Double Dim P1(0 To 2) As Dou

5、ble 初始化 dk = TextBox1 n = TextBox2 k = TextBox12 t = TextBox9 L = TextBox8 L1 = TextBox11 d = TextBox10 P0(0) = PX P0(1) = PY P1(0) = PXP1(1) = PY 开始计算绘图 画中心线 On Error Resume Next ThisDrawing.Linetypes.Load CENTER, acad.lin ThisDrawing.ActiveLinetype = ThisDrawing.Linetypes.Item(CENTER) Set plineObj

6、(0, 0) = AddLineReXY(P0, 1.3 * L, 0) Set plineObj(0, 1) = AddLineReXY(P0, -0.2 * L, 0) (1) On Error Resume Next ThisDrawing.Linetypes.Load CONTINUOUS, acad.lin ThisDrawing.ActiveLinetype = ThisDrawing.Linetypes.Item(CONTINUOUS) Set plineObj(1, 0) = AddLineReXY(P0, 0, n / 2) Set plineObj(1, 1) = AddL

7、ineReXY(P1, 0, -n / 2) P0(1) = P0(1) + n / 2 P1(1) = P1(1) - n / 2 (2) Set plineObj(2, 0) = AddLineReXY(P0, -k, 0) P0(0) = P0(0) - k Set plineObj(2, 1) = AddLineReXY(P1, -k, 0) P1(0) = P1(0) - k (3) Set plineObj(3, 0) = AddLineReXY(P0, 0, (dk / 2 - n / 2) P0(1) = P0(1) + (dk / 2 - n / 2) Set plineOb

8、j(3, 1) = AddLineReXY(P1, 0, -(dk / 2 - n / 2) P1(1) = P1(1) - (dk / 2 - n / 2) (4) Set plineObj(4, 0) = AddLineReXY(P0, t, 0) P0(0) = P0(0) + t Set plineObj(4, 1) = AddLineReXY(P1, t, 0) P1(0) = P1(0) + t (5) Set plineObj(5, 0) = AddLineReXY(P0, 0, -dk / 2) P0(1) = P0(1) + (d / 2 - dk / 2) Set plin

9、eObj(5, 1) = AddLineReXY(P1, 0, dk / 2) P1(1) = P1(1) - (d / 2 - dk / 2) (6) Set plineObj(6, 0) = AddLineReXY(P0, L, 0) P0(0) = P0(0) + L Set plineObj(6, 1) = AddLineReXY(P1, L, 0) P1(0) = P1(0) + L (7) Set plineObj(7, 0) = AddLineReXY(P0, 0, -d / 2) P0(1) = P0(1) - d / 2 P0(0) = P0(0) - L1 Set plin

10、eObj(7, 1) = AddLineReXY(P1, 0, d / 2) P1(1) = P1(1) + d / 2 P1(0) = P1(0) - L1 (8) Set plineObj(8, 0) = AddLineReXY(P0, 0, d / 2) P0(1) = P0(1) + d / 2 - 1 Set plineObj(8, 1) = AddLineReXY(P0, L1, 0) Set plineObj(9, 0) = AddLineReXY(P1, 0, -d / 2) P1(1) = P1(1) - d / 2 + 1 Set plineObj(9, 1) = AddL

11、ineReXY(P1, L1, 0) plineObj(0, 0).Lineweight = acLnWt009 plineObj(0, 1).Lineweight = acLnWt009 plineObj(0, 0).ScaleEntity P2, suofang plineObj(0, 0).Update plineObj(0, 1).ScaleEntity P2, suofang plineObj(0, 1).Update plineObj(0, 1).color = zs 指定中心线的颜色 zs 代表中心线颜色 plineObj(0, 0).color = zs 指定中心线的颜色 Fo

12、r i = 1 To 10 Step 1 循环对螺钉直线进行操作，两层循环 For j = 0 To 1 Step 1 plineObj(i, j).Lineweight = acLnWt030 指定螺钉线宽 plineObj(i, j).color = ls 指定螺钉线的颜色 ls代表螺钉线颜色 plineObj(i, j).ScaleEntity P2, suofang 指定螺钉缩放比例 plineObj(i, j).Update Next j Next i ZoomExtentsEnd Sub Finally，designing a module ，this module contain

13、s required function.Option ExplicitPublic Sub Alternation() 创建显示窗口和隐藏窗口的函数 UserForm1.Hind UserForm1.ShowEnd Sub创建直线的基准函数Public Function AddLine(ByVal ptSt As Variant, ByVal ptEn As Variant) As AcadLine Set AddLine = ThisDrawing.ModelSpace.AddLine(ptSt, ptEn)End Function根据另一点的相对直角坐标创建直线Public Functio

14、n AddLineReXY(ByVal ptSt As Variant, ByVal x As Double, ByVal y As Double) As AcadLine 定义终点 Dim ptEn As Variant ptEn = GetPoint(ptSt, x, y) Set AddLineReXY = AddLine(ptSt, ptEn)End Function获得相对已经点偏移一定距离的点Public Function GetPoint(pt As Variant, x As Double, y As Double) As Variant Dim ptTarget(0 To 2

15、) As Double ptTarget(0) = pt(0) + x ptTarget(1) = pt(1) + y ptTarget(2) = 0 GetPoint = ptTargetEnd Function4. Running results: Load the project Run this project，typing the Parameters of the bolt as follow Pick a point as the first point Click 确定 Click 取消 退出程序 Different typings lead to different result