(请各位高手帮忙)关于公差自动标注的源码

luckyliya

下面是关于公差自动标注的源码,运行没有达到预期效果,请各位高手指点

Function Tolerance()

Dim entry As AcadEntity
Dim returnObj As AcadObject
Dim Objname As String
Dim AlignedObj As AcadDimAligned
Dim OrdinateOb As AcadDimOrdinate
Dim rotateobj As AcadDimRotated
Dim NL As String
NL = Chr(13) & Chr(10)
On Error Resume Next
RETRY:
ThisDrawing.Utility.GetEntity returnObj, basepnt, NL & "请选择一个标注对象:"
Set entry = returnObj
Objname = entry.ObjectName
If Err <> 0 Then
  Err.Clear
MsgBox "没按提示操作,现在退出!", vbOKOnly + vbCritical, "操作错误"
 Exit Function
 ElseIf Right(Objname, 9) <> "Dimension" Then
 MsgBox "选择的对象不是一个标注,请重新选择!", 0 + 48, "对象选错"
 GoTo RETRY
 End If
 Select Case Objname
 Case "AcDbAlignedDimension"
 Set AlignedObj = entry
 UserForm7.Label1.Caption = "基本尺寸=" & Format(Val(AlignedObj.Measurement), "###0.00")
 
 Case "AcDbRotatedDimension"
 Set rotateobj = entry
 UserForm7.Label1.Caption = "基本尺寸=" & Format(Val(RotatedObj.Measurement), "###0.00")
  MsgBox RotatedObj.Measurement

 Case "AcDbOrdinateDimension"
 Set ordinageobj = entry
 UserForm7.Label1.Caption = "基本尺寸=" & Format(Val(OrdinateObj.Measurement), "###0.00")

 End Select
 UserForm7.Show
 AlignedObj.TextOverride = "\H2.0x;" + "\S" + UserForm7.TextBox1.Text + "^" + UserForm7.TextBox2.Text
 
 AlignedObj.Update
 End Function