[分享]公差编辑工具

gzy 发表于 2003-11-2 21:36:00

由于AutoCAD的公差标注比较烦琐。所以做了一个，主要是参考一本机械方面的期刊（李忠群）做来的。做完后感觉进步较大，如有问题，欢迎提出批评和建议。
特此分享！

程序源码如下：
'2003.11.2
'by gzy
'e-mail:gzy@mjtd.com
Private Sub ComboBox1_Change()
Select Case UserForm.ComboBox1.Value
Case "无公差"
UserForm.TextBox1.Enabled = False
UserForm.TextBox2.Enabled = False
UserForm.TextBox3.Enabled = False
UserForm.TextBox3.BackColor = UserForm.BackColor
UserForm.TextBox1.BackColor = UserForm.BackColor
UserForm.TextBox2.BackColor = UserForm.BackColor
Case "对称公差"
UserForm.TextBox1.Enabled = False
UserForm.TextBox1.BackColor = UserForm.BackColor
UserForm.TextBox2.Enabled = True
UserForm.TextBox2.BackColor = UserForm.TextBox5.BackColor
UserForm.TextBox3.Enabled = False
UserForm.TextBox3.BackColor = UserForm.BackColor
Case "极限偏差"
UserForm.TextBox1.Enabled = False
UserForm.TextBox1.BackColor = UserForm.BackColor
UserForm.TextBox2.Enabled = True
UserForm.TextBox2.BackColor = UserForm.TextBox5.BackColor
UserForm.TextBox3.Enabled = True
UserForm.TextBox3.BackColor = UserForm.TextBox5.BackColor
Case "极限尺寸"
UserForm.TextBox1.Enabled = False
UserForm.TextBox1.BackColor = UserForm.BackColor
UserForm.TextBox2.Enabled = True
UserForm.TextBox2.BackColor = UserForm.TextBox5.BackColor
UserForm.TextBox3.Enabled = True
UserForm.TextBox3.BackColor = UserForm.TextBox5.BackColor
Case "基本偏差"
UserForm.TextBox1.Enabled = False
UserForm.TextBox1.BackColor = UserForm.BackColor
UserForm.TextBox2.Enabled = False
UserForm.TextBox2.BackColor = UserForm.BackColor
UserForm.TextBox3.Enabled = False
UserForm.TextBox3.BackColor = UserForm.BackColor
Case "用户定义"
UserForm.TextBox1.Enabled = True
UserForm.TextBox1.BackColor = UserForm.TextBox5.BackColor
UserForm.TextBox2.Enabled = True
UserForm.TextBox2.BackColor = UserForm.TextBox5.BackColor
UserForm.TextBox3.Enabled = True
UserForm.TextBox3.BackColor = UserForm.TextBox5.BackColor
End Select
End Sub
Private Sub CommandButton1_Click() '编辑完毕
UserForm.hide
End Sub
Private Sub CommandButton2_Click()
End
End Sub
Private Sub UserForm_initialize() '对话框初始化
UserForm.ComboBox1.AddItem "无公差", 0
UserForm.ComboBox1.AddItem "对称公差", 1
UserForm.ComboBox1.AddItem "极限偏差", 2
UserForm.ComboBox1.AddItem "极限尺寸", 3
UserForm.ComboBox1.AddItem "基本尺寸", 4
UserForm.ComboBox1.AddItem "用户定义", 5
UserForm.ComboBox1.Value = "无公差"
UserForm.TextBox1.Enabled = False
UserForm.TextBox1.BackColor = UserForm.BackColor
UserForm.TextBox2.Enabled = False
UserForm.TextBox2.BackColor = UserForm.BackColor
UserForm.TextBox3.Enabled = False
UserForm.TextBox3.BackColor = UserForm.BackColor
End Sub
Public Function simplify(dimtext, dstyle) '按系统设置的精度要求，对标注尺寸进行处理
If dstyle = 4 Then
dimdec = ThisDrawing.GetVariable("dimadec")
Else
dimdec = ThisDrawing.GetVariable("dimdec")
End If
seyle = "."
If dimdec > 0 Then
   Do While dimdec > 0
   style = style + "#"
   dimdec = dimdec - 1
   Loop
   simplify = Format(dimtext, style)
Else
   simplify = CInt(dimtext)
End If
End Function
Public Function detol(dimnm, dimtp, dimtm, textpre, textsuf) '分解公差各部分
dimnm = Left(dimnm, Len(dimnm) - Len(textsuf))
dimnm = Right(dimnm, Len(dimnm) - Len(textsuf))
If InStr(dimnm, "%%p") <> 0 Then '采用对称公差标注时
dimnum = Left(dimnm, InStr(dimnm, "%%p") - 1)
Else
   pos1 = InStr(dimnm, "{")
   If pos1 > 0 Then
      dimnm = Left(dimnm, pos1 - 1)
   End If
End If
   detol = dimnm
End Function
Public Function gentol(Text, tp, tm, prefix, profix, code) '将名义尺寸、上、下偏差等组合出公差
Dim obj1 As AcadEntity
textsize = ThisDrawing.GetVariable("dimtxt")
tolsize = 0.6 * textsize
Text = prefix + Text
If Abs(tp) = Abs(tm) Then
If tp = 0 Then'没有公差时
gentol = Text
Else
   If Abs(tp) < 1 Then
   gentol = Text + "%%p0" + Trim(Str(Abs(tp)))
   Else: gentol = Text + "%%p" + Trim(Str(Abs(tp)))
End If
End If
Else
Select Case tp
Case ls > 0
If tp < 1 Then
   tp = "+0" + Trim(Str(tp))
   Else: tp = "" + Trim(Str(tp))
   End If
   Case ls = 0
   tp = "0"
   Case ls < 0
   If Abs(tp) < 1 Then
      tp = Trim(Str(Abs(tp)))
      tp = "-0" + tp
      Else: tp = Trim(Str(tp))
      End If
      End Select
Select Case tm
Case ls > 0
If tm < 1 Then
   tm = "+0" + Trim(Str(tm))
Else: tm = "+" + Trim(Str(tm))
End If
Case ls = 0
   tm = "0"
   Case ls < 0
   If Abs(tm) < 1 Then
      tm = Trim(Trim(Abs(tm)))
      tm = "-0" + tm
   Else: tm = Trim(Str(tm))
   End If
   End Select
   gentol = Text + "{\h" + tolsize + ";\s" + tp + "" + tm + ";}" + profix
End If
End Function
Public Sub dimedit() '公差编辑
   Dim obj1 As AcadEntity
   Dim curobj As AcadDimension
   Do While code = 0
   On Error Resume Next
   ThisDrawing.Utility.GetEntity obj1, pnt1, "请选择要标注的尺寸"
      If Err.Number = 0 Then
      Select Case obj1.ObjectName ' 判断标注类型
         Case "AcDbRotatedDimension"
         code = 1
         Case "AcDbAlignedDimension"
         code = 1
         Case "AcDbLinearDimension"
         code = 1
         Case "AcDbDiametricDimension"
         code = 2
         Case "AcDbRadialDimension"
         code = 3
      Case "AcDb2LineAngularDimension", "AcDb3PointAngularDimension"
         code = 4
      End Select
      Else
         Err.Clear
      End If
      Loop
      Set curobj = obj1
      UserForm.TextBox1.Text = simplify(curobj.Measurement, code)
      Select Case curobj.ToleranceDisplay
      Case "actolnone"
         UserForm.ComboBox1.Value = "无公差"
      Case "actolactollimitsdeviation"
         UserForm.ComboBox1.Value = "极限偏差"
      Case "actoactolimits"
         UserForm.ComboBox1.Value = "极限尺寸"
      Case "actolsymmetrical"
         UserForm.ComboBox1.Value = "对称公差"
      Case "actolbasic"
         UserForm.ComboBox1.Value = "基本尺寸"
      End Select
UserForm.TextBox2.Text = Format(curobj.ToleranceUpperLimit, "0.#")
UserForm.TextBox3.Text = Format(curobj.ToleranceLowerLimit, "0.#")
   UserForm.TextBox4.Text = curobj.TextPrefix
   UserForm.TextBox5.Text = curobj.TextSuffix
   If curobj.TextOverride = "" Then '未使用文字替代时，从测量标注测量值获得对话框初始值
   UserForm.TextBox1.Text = simplify(curobj.Measurement, code)
   If code = 4 Then UserForm.TextBox1.Text = simplify(curobj.Measurement * 180 / pi, code)
      Else '使用文字替代时，从替代字符串中分解出对话框初始值
      UserForm.ComboBox1.Value = "用户定义"
      temp = UCase(Trim(cruobj.TextOverride))
      UserForm.TextBox1.Text = detol(temp, UserForm.TextBox2.Text, UserForm.TextBox3. _
      Text, UserForm.TextBox4.Text, UserForm.TextBox5.Text)
   End If
   UserForm.Show
   If UserForm.TextBox4.Text = "" Then '去掉前缀和后缀
   curobj.TextPrefix = ""
   End If
   If UserForm.TextBox5.Text = "" Then
   curobj.TextSuffix = ""
   End If
   curobj.TextPrefix = UserForm.TextBox4.Text
   curobj.TextSuffix = UserForm.TextBox5.Text
   curobj.ToleranceUpperLimit = UserForm.TextBox2.Text
   curobj.ToleranceLowerLimit = UserForm.TextBox3.Text
   curobj.TextOverride = ""
   Select Case UserForm.ComboBox1.Value
   Case "无公差"
      curobj.ToleranceDisplay = acTolNone
   Case "极限偏差"
      curobj.ToleranceDisplay = acTolDeviation
   Case "极限尺寸"
      curobj.ToleranceDisplay = acTolLimits
   Case "对称公差"
      curobj.ToleranceDisplay = acTolSymmetrical
   Case "基本尺寸"
      curobj.ToleranceDisplay = acTolvasic
   Case "用户定义"
      curobj.TextOverride = gentol(UserForm.TextBox1.Text, _
      UserForm.TextBox2.Text, UserForm.TextBox3.Text, _
      UserForm.TextBox4.Text, UserForm.TextBox5.Text, code)
   End Select
   curobj.Update
   curobj.Visible = True
End Sub

大水瓢 发表于 2003-11-21 23:45:00

文件下载后怎么用呀？

zhangyujie 发表于 2003-11-22 13:45:00

如何使用！
谢谢！

yfy2003 发表于 2003-11-22 13:48:00

用VAB加载后运行

gzy 发表于 2003-11-30 13:51:00

在模块中加载

sxy 发表于 2003-12-1 12:09:00

怎么用?是什么命令?

SWAYWOOD 发表于 2003-12-6 23:10:00

斑竹，这个程序挺好，挺实用
如果能够自动将加入的公差文字的高度以尺寸文字高度的一定的比例（如0.6）显示就更好了
另外，修改过的尺寸如果也能用这个东东加公差的话那就更加妙了
最后请教斑竹一个问题：我怎么在Lisp程序中加载DVB文件，我现在是用手动加载，再运行宏
笨办法，呵呵
多谢！

super613 发表于 2003-12-30 17:05:00

實用工具可不能錯過啊^^_^

bluemoon 发表于 2003-12-30 20:28:00

能够自动将加入的公差文字的高度以尺寸文字高度的一定的比例的程序呵呵算是对楼主的补充啊不过没有楼主的那么全
希望大家批评指正啊

解压后打开cad把它加载到启动组中然后每次只要双击标注尺寸就可以了

SWAYWOOD 发表于 2004-1-5 12:21:00

修改过的尺寸用了后又返回真实值，如何解决？

页: [1] 2

明经CAD社区's Archiver

[分享]公差编辑工具