明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 3306|回复: 18

按照版主要求,重新写了一些提示.帮我分析用VBA编的凸轮参数式绘制程序。。我不能自

  [复制链接]
发表于 2002-12-13 14:10:00 | 显示全部楼层 |阅读模式
本帖最后由 leeyeafu 于 2002-12-13 14:10:10 编辑

按照版主要求,重新写了一些提示.帮我分析用VBA编的凸轮参数式绘制程序。。我不能自己修改成功。请教高手-->leeyeafu转移[br]’该程序是绘制一偏置移动从动件盘型凸轮机构的用VBA编制的程序,有关参数说明在程序中。
Option Explicit

Private Sub CommandButton1_Click()
UserForm1.Hide
Dim s, u, u1, u2, u3, u4, h, e, ro, rt, incrim, s0, beta0, beta, rou, ceta As Double             's为从动件位移 ,u为凸轮转角,u1为升程运动角,u2为远休止角,u3为回程运动角,u4为近休止角,h为升程,e为偏距,ro为基圆半径,rt为滚子半径,incrim为精度
Dim i As Integer
Dim ptpnts() As Double
Dim pt As Variant
Dim bp As Variant
Dim circleobj As AcadCircle
Dim objpoly As AcadLWPolyline
Dim objline As AcadLine
Dim pt0 As Double
Dim firstpt As Double

Const pi = 3.1415926
u1 = Val(TextBox1.Text)      ’读取参数
u2 = Val(TextBox2.Text)
u3 = Val(TextBox3.Text)
u4 = Val(TextBox4.Text)
h = Val(TextBox5.Text)
e = Val(TextBox6.Text)
ro = Val(TextBox7.Text)
rt = Val(TextBox8.Text)
incrim = Val(TextBox9.Text)
i = UserForm1.ComboBox1.ListIndex

bp = ThisDrawing.Utility.GetPoint(, "请输入凸轮基圆中心:")


Set circleobj = ThisDrawing.ModelSpace.AddCircle(bp, ro)  ‘绘制基圆

u = 0#


Do Until u <= 360#        ‘选择运动规律
   If u <= u1 Then
      Select Case i
         Case 0
           Call isovelocity_up
         Case 1
           Call isoacceleration_up
         Case 2
           Call libration_up
       End Select
      s0 = Sqr((ro ^ 2) - (e ^ 2))  ’这里开始都是有关凸轮极坐标计算公式
      beta0 = Atn(e / s0)
      beta = Atn(e / (s0 + s))
      rou = Sqr((s + s0) ^ 2 + e ^ 2)
      ceta = u * pi / 180# + beta - beta0
      pt = ThisDrawing.Utility.PolarPoint(bp, ceta, rou)
   ElseIf u > u1 And u <= (u1 + u2) Then
      s = h
      s0 = Sqr(ro ^ 2 - e ^ 2)
      beta0 = Atn(e / s0)
      beta = Atn(e / (s0 + s))
      rou = Sqr((s + s0) ^ 2 + e ^ 2)
      ceta = u * pi / 180# + beta - beta0
      pt = ThisDrawing.Utility.PolarPoint(bp, ceta, rou)
   ElseIf u > (u1 + u2) And u <= (u1 + u2 + u3) Then
        Select Case i
          Case 0
            Call isovelocity_down
          Case 1
            Call isoacceleration_down
          Case 2
            Call libration_down
         End Select
       s0 = Sqr(ro ^ 2 - e ^ 2)
       beta0 = Atn(e / s0)
       beta = Atn(e / (s0 + s))
       rou = Sqr((s + s0) ^ 2 + e ^ 2)
       ceta = u * pi / 180# + beta - beta0
       pt = ThisDrawing.Utility.PolarPoint(bp, ceta, rou)
   ElseIf u > (u1 + u2 + u3) Then
       s = 0
       beta0 = Atn(e / s0)
       beta = Atn(e / (s0 + s))
       rou = Sqr((s + s0) ^ 2 + e ^ 2)
       ceta = u * pi / 180# + beta - beta0
       pt = ThisDrawing.Utility.PolarPoint(bp, ceta, rou)
   End If
   
If (firstpt <> "") Then

   Set objline = ThisDrawing.ModelSpace.AddLine(pt0, pt)
ElseIf (firstpt = "") Then
   firstpt = pt
End If
   
  pt0 = pt
。。。。
我对这一段不知该怎样处理?
。。
If u <= u1 Then
      Select Case i
         Case 0
           Call isovelocity_up
         Case 1
           Call isoacceleration_up
         Case 2
           Call libration_up
       End Select
      s0 = Sqr((ro ^ 2) - (e ^ 2))
。。。这一段也不会
改怎样处理?

  u = u + incrim
   
Loop
End Sub

Private Sub UserForm_Initialize()
UserForm1.ComboBox1.AddItem "等速运动", 0
UserForm1.ComboBox1.AddItem "等加速和等减速运动", 1
UserForm1.ComboBox1.AddItem "简谐运动", 2
UserForm1.ComboBox1.ListIndex = 0
UserForm1.TextBox1.SetFocus
End Sub

Public Sub isovelocity_up()  ‘匀速运动升程
s = h * u / u1
End Sub
Public Sub isoacceleration_up()  ’等加速等减速升程
  If u < ui / 2 Then
     s = 2 * h * u ^ 2 / u1 ^ 2
  Else
     s = h - 2 * h * ((u - u1) ^ 2) / (u1 ^ 2)
  End If
End Sub
Public Sub isovelocity_down()  ‘匀速回程
s = h * (1 - u / u3)
End Sub

Public Sub isoacceleration_down()  ’等加速等减速回程
  If u < u3 / 2 Then
     s = h - 2 * h * u62 / u3 ^ 2
  Else
     s = 2 * h * ((u - u3) ^ 2) / (u3 ^ 2)
  End If
End Sub
Public Sub libration_up()  ‘简谐运动升程
s = h * (1 - Cos(pi * u / u1))
End Sub
Public Sub libration_down()  ’简谐回程
s = h * (1 + Cos(pi * u / u3)) / 2
End Sub


[此贴子已经被作者于2002-12-6 22:49:59编辑过]
 楼主| 发表于 2002-12-30 21:31:00 | 显示全部楼层

李版主:这些公式很多是无法几句话就能说清的,我尽量试着解释清楚

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
 楼主| 发表于 2002-12-30 21:48:00 | 显示全部楼层

明总还给我调好程序啦?

发表于 2002-12-6 09:48:00 | 显示全部楼层

提个小要求

你的程序是做什么的?你使用了用户窗体,里面的每个控件起什么作用?
另外,尽可能详细地给出程序必要的注释,这是对你自己负责,也是对帮助你分析程序的人负责。
发表于 2002-12-13 14:18:00 | 显示全部楼层

顶一下,这个帖子涉及机械专业知识,李某不才,无力解决,希望有人出手

发表于 2002-12-13 19:33:00 | 显示全部楼层

最好能把程序压缩后上传,因为带有窗体

 楼主| 发表于 2002-12-13 22:20:00 | 显示全部楼层

压缩文件已上传啦。帮我!!!

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
 楼主| 发表于 2002-12-24 22:09:00 | 显示全部楼层

传了怎么也没有人告诉我该怎么做????

发表于 2002-12-25 19:57:00 | 显示全部楼层

从程序方面解答(呵,最好给组合理的参数来调试程序)

1.Do Until 是否应改为 Do While,因为按写法,但一个Do Until已经跳出了程序了。
2.pt0和firstpt是否应改为变体(Variant),因为它要保存的是点坐标,而不是双精度值。
3. If firstpt<>"" Then是否应改为 If IsArray(firstpt) Then,因为如果该变量保存的是点坐标时,它就成为数组了。
4.再接下来的ElseIf first = "" Then就有点多余了,改为Else就可以。
5.既然你调用的isovelocity_up()等几个过程都要使用到CommandButton1_Click()中的变量,那些要使用到的变量就不应该在CommandButton1_Click()中定义成私有变量了,而应设为公有变量,或定义在模块中。

改完了以上这些,程序应该可以运行了,运行出来的结果正不正确,就看你写的程序了。
 楼主| 发表于 2002-12-27 15:36:00 | 显示全部楼层

明总总算百忙之中给我回答啦!谢谢。我这儿提供啦参数,不知明总能有空继续帮我看看

明总总算百忙之中给我回答啦!谢谢。我这儿提供啦参数,不知明总能有空继续帮我看看吗?[br]明总总算百忙之中给我回答啦!谢谢。我这儿提供啦参数,不知明总能有空继续帮我看看吗?
升程运动角:80
远休止角:60
回程运动角:100
近休止角:120
升程:100
偏距:10
基圆半径:120
滚子半径:10
精度:5
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-28 20:34 , Processed in 0.180829 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表