[例程]使用尺寸--几何公差

mccad

Public Sub CreateTolereance()

    '用3个点创建标注引线
   
    Dim leaderObj As AcadLeader
    Dim points(0 To 8) As Double
    Dim xPnt As Variant, I As Integer
    Dim leaderType As Integer
    Dim annotationObject As AcadObject
   
    xPnt = ThisDrawing.Utility.GetPoint(, " 选择第 1个点： ")
    points(0) = xPnt(0): points(1) = xPnt(1): points(2) = xPnt(2)
    For I = 1 To 2
        xPnt = ThisDrawing.Utility.GetPoint(xPnt, "选择第" & I + 1 & "点： ")
        points(3 * I) = xPnt(0)
        points(3 * I + 1) = xPnt(1)
        points(3 * I + 2) = xPnt(2)
    Next
    leaderType = acLineWithArrow
'-----------------------------------------------
    '创建几何公差标注的主体
   
    Dim tolObj As AcadTolerance
    Dim txtStr As String
    'Dim insPnt(0 To 2) As Double
    Dim direction(0 To 2) As Double
   
    'insPnt = ThisDrawing.Utility.GetPoint(, "选择插入点：")
    '确定插入点
    'insPnt(0) = 100: insPnt(1) = 180: insPnt(2) = 0
    '定义几何公差的标注文字
    txtStr = "{\Fgdt;r}%%v{\Fgdt;n}0.12{\Fgdt;l}%%v%%vA" & _
             "{\Fgdt;m}%%vB{\Fgdt;l}%%vC{\Fgdt;s}"
   
    '确定标注文字的显示方向为平行于X轴方向
    direction(0) = 1
    direction(1) = 0
    direction(2) = 0
   
    '在模型空间创建几何公差标注对象
    Set tolObj = ThisDrawing.ModelSpace. _
        AddTolerance(txtStr, xPnt, direction)
   
    '定义标注文字的高度
    tolObj.TextHeight = 7
'------------------------------------------------
    '使用几何公差对象来创建标注引线
    Set leaderObj = ThisDrawing.ModelSpace.AddLeader _
                    (points, tolObj, leaderType)
    '定义引线的的箭头尺寸
    leaderObj.ArrowheadSize = 5
   
    'ZoomAll

    'Dim newDirection As Variant
    'newDirection = ThisDrawing.Utility.GetPoint(xPnt, "选择新的方向：")
    'tolObj.DirectionVector = newDirection
   
End Sub

Public Sub CreateSymbole()

    Dim tolObj As AcadObject
    Dim txtStr As String
    Dim insPnt(0 To 2) As Double
    Dim direction(0 To 2) As Double
    Dim I As Integer
   
    direction(0) = 1
    direction(1) = 0
    direction(2) = 0
    insPnt(0) = 100
    insPnt(2) = 0
   
    insPnt(1) = 280
    txtStr = "{\Fgdt;j}"
    Set tolObj = ThisDrawing.ModelSpace. _
        AddTolerance(txtStr, insPnt, direction)
    tolObj.TextHeight = 7

    insPnt(1) = 280 - 13
    txtStr = "{\Fgdt;r}"
    Set tolObj = ThisDrawing.ModelSpace. _
        AddTolerance(txtStr, insPnt, direction)
    tolObj.TextHeight = 7

    insPnt(1) = 280 - 2 * 13
    txtStr = "{\Fgdt;i}"
    Set tolObj = ThisDrawing.ModelSpace. _
        AddTolerance(txtStr, insPnt, direction)
    tolObj.TextHeight = 7

    insPnt(1) = 280 - 3 * 13
    txtStr = "{\Fgdt;f}"
    Set tolObj = ThisDrawing.ModelSpace. _
        AddTolerance(txtStr, insPnt, direction)
    tolObj.TextHeight = 7

    insPnt(1) = 280 - 4 * 13
    txtStr = "{\Fgdt;b}"
    Set tolObj = ThisDrawing.ModelSpace. _
        AddTolerance(txtStr, insPnt, direction)
    tolObj.TextHeight = 7

    insPnt(1) = 280 - 5 * 13
    txtStr = "{\Fgdt;a}"
    Set tolObj = ThisDrawing.ModelSpace. _
        AddTolerance(txtStr, insPnt, direction)
    tolObj.TextHeight = 7

    insPnt(1) = 280 - 6 * 13
    txtStr = "{\Fgdt;g}"
    Set tolObj = ThisDrawing.ModelSpace. _
        AddTolerance(txtStr, insPnt, direction)
    tolObj.TextHeight = 7

    insPnt(1) = 280 - 7 * 13
    txtStr = "{\Fgdt;c}"
    Set tolObj = ThisDrawing.ModelSpace. _
        AddTolerance(txtStr, insPnt, direction)
    tolObj.TextHeight = 7

    insPnt(1) = 280 - 8 * 13
    txtStr = "{\Fgdt;e}"
    Set tolObj = ThisDrawing.ModelSpace. _
        AddTolerance(txtStr, insPnt, direction)
    tolObj.TextHeight = 7

    insPnt(1) = 280 - 9 * 13
    txtStr = "{\Fgdt;u}"
    Set tolObj = ThisDrawing.ModelSpace. _
        AddTolerance(txtStr, insPnt, direction)
    tolObj.TextHeight = 7

    insPnt(1) = 280 - 10 * 13
    txtStr = "{\Fgdt;d}"
    Set tolObj = ThisDrawing.ModelSpace. _
        AddTolerance(txtStr, insPnt, direction)
    tolObj.TextHeight = 7

    insPnt(1) = 280 - 11 * 13
    txtStr = "{\Fgdt;k}"
    Set tolObj = ThisDrawing.ModelSpace. _
        AddTolerance(txtStr, insPnt, direction)
    tolObj.TextHeight = 7

    insPnt(1) = 280 - 12 * 13
    txtStr = "{\Fgdt;h}"
    Set tolObj = ThisDrawing.ModelSpace. _
        AddTolerance(txtStr, insPnt, direction)
    tolObj.TextHeight = 7

    insPnt(1) = 280 - 13 * 13
    txtStr = "{\Fgdt;t}"
    Set tolObj = ThisDrawing.ModelSpace. _
        AddTolerance(txtStr, insPnt, direction)
    tolObj.TextHeight = 7

    insPnt(1) = 280 - 14 * 13
    txtStr = "{\Fgdt;n}"
    Set tolObj = ThisDrawing.ModelSpace. _
        AddTolerance(txtStr, insPnt, direction)
    tolObj.TextHeight = 7

End Sub

Public Sub ModifyDirection()

    Dim tolObj As AcadTolerance
    Dim pickPnt As Variant
    Dim curDirection As Variant
    Dim newDirection(0 To 2) As Double
   
    '选择几何公差标注对象
    ThisDrawing.Utility.GetEntity tolObj, pickPnt
   
    '获得当前几何公差标注的方向矢量
    curDirection = tolObj.DirectionVector
   
    '选择新的方向矢量
    On Error Resume Next
    newDirection(0) = ThisDrawing.Utility.GetReal("选择X方向分量： ")
    newDirection(1) = ThisDrawing.Utility.GetReal("选择Y方向分量： ")
    newDirection(2) = ThisDrawing.Utility.GetReal("选择Z方向分量： ")
   
    If Err <> 0 Then              '如果没有选择新的方向矢量
        tolObj.DirectionVector = curDirection
    Else                          '如果选择了新的方向矢量
        tolObj.DirectionVector = newDirection
    End If
   
    tolObj.Update
   
End Sub

兰州人

吃透mccad的好东东,肯定是高手.