(请各位高手帮忙)关于公差自动标注的源码
<P>下面是关于公差自动标注的源码,运行没有达到预期效果,请各位高手指点</P><P>Function Tolerance()</P>
<P>Dim entry As AcadEntity<BR>Dim returnObj As AcadObject<BR>Dim Objname As String<BR>Dim AlignedObj As AcadDimAligned<BR>Dim OrdinateOb As AcadDimOrdinate<BR>Dim rotateobj As AcadDimRotated<BR>Dim NL As String<BR>NL = Chr(13) & Chr(10)<BR>On Error Resume Next<BR>RETRY:<BR>ThisDrawing.Utility.GetEntity returnObj, basepnt, NL & "请选择一个标注对象:"<BR>Set entry = returnObj<BR>Objname = entry.ObjectName<BR>If Err <> 0 Then<BR> Err.Clear<BR>MsgBox "没按提示操作,现在退出!", vbOKOnly + vbCritical, "操作错误"<BR> Exit Function<BR> ElseIf Right(Objname, 9) <> "Dimension" Then<BR> MsgBox "选择的对象不是一个标注,请重新选择!", 0 + 48, "对象选错"<BR> GoTo RETRY<BR> End If<BR> Select Case Objname<BR> Case "AcDbAlignedDimension"<BR> Set AlignedObj = entry<BR> UserForm7.Label1.Caption = "基本尺寸=" & Format(Val(AlignedObj.Measurement), "###0.00")<BR> <BR> Case "AcDbRotatedDimension"<BR> Set rotateobj = entry<BR> UserForm7.Label1.Caption = "基本尺寸=" & Format(Val(RotatedObj.Measurement), "###0.00")<BR> MsgBox RotatedObj.Measurement</P>
<P> Case "AcDbOrdinateDimension"<BR> Set ordinageobj = entry<BR> UserForm7.Label1.Caption = "基本尺寸=" & Format(Val(OrdinateObj.Measurement), "###0.00")</P>
<P> End Select<BR> UserForm7.Show<BR> AlignedObj.TextOverride = "\H2.0x;" + "\S" + UserForm7.TextBox1.Text + "^" + UserForm7.TextBox2.Text<BR> <BR> AlignedObj.Update<BR> End Function<BR> </P>
页:
[1]