[例程]使用尺寸--线性标注

mccad

Public Sub UseDimAligned()

    Dim dimObj As AcadDimAligned     '声明对齐尺寸对象变量
    Dim point1(0 To 2) As Double
    Dim point2(0 To 2) As Double
    Dim location(0 To 2) As Double
   
    '设定第1个界线原点坐标
    point1(0) = 100: point1(1) = 125: point1(2) = 0
    '设定第2个界线原点坐标
    point2(0) = 200.289: point2(1) = 125: point2(2) = 0
    '设定标注文字的位置坐标
    location(0) = 100: location(1) = 165: location(2) = 0
   
    '设定第1个界线原点坐标
    'point1(0) = 4: point1(1) = 5: point1(2) = 0
    '设定第2个界线原点坐标
    'point2(0) = 4.8: point2(1) = 5: point2(2) = 0
    '设定标注文字的位置坐标
    'location(0) = 4: location(1) = 6.5: location(2) = 0
   
    '在模型空间中创建对齐尺寸标注对象
    Set dimObj = ThisDrawing.ModelSpace.AddDimAligned(point1, point2, location)
   
    ZoomAll

    dimObj.ArrowheadSize = 8
    dimObj.TextHeight = 7
    dimObj.DecimalSeparator = "."
    'dimObj.UnitsFormat = acDimLScientific
    'dimObj.FractionFormat = acDiagonal
    'dimObj.FractionFormat = acHorizontal
    'dimObj.FractionFormat = acNotStacked
    'dimObj.TextOverride = "200"
    'dimObj.TextPrefix = "L-"
    'dimObj.TextSuffix = "长度"
    'dimObj.TextRotation = 3.14159 / 4
    'dimObj.Arrowhead1Block = "arrowBlk1"  '使用一个已定义的块取代第1个箭头
    'dimObj.Arrowhead1Type = acArrowDefault '定义箭头的显示形式
    'dimObj.Arrowhead2Type = acArrowNone
    'dimObj.DimLine1Suppress = True   '抑制第1个箭头的显示
    'dimObj.DimLine2Suppress = True  '不抑制第2个箭头的显示（默认）
    'dimObj.DimensionLineExtend = 30
    'dimObj.ExtensionLineExtend = 5
    'dimObj.TextGap = 3.5
    'dimObj.TextInsideAlign = True
    'dimObj.TextOutsideAlign = True
    'dimObj.TextInside = True
    'dimObj.TextMovement = acMoveTextAddLeader
    'dimObj.VerticalTextPosition = acVertCentered
    'dimObj.HorizontalTextPosition = acHorzCentered
    'dimObj.DimLineInside = True
    'dimObj.ForceLineInside = False
    'dimObj.LinearScaleFactor = 10
    'dimObj.ExtensionLineOffset = 10
    'dimObj.ToleranceJustification = acTolTop
    dimObj.ToleranceHeightScale = 0.9
    dimObj.TolerancePrecision = acDimPrecisionFour
    dimObj.ToleranceDisplay = acTolBasic
    dimObj.ToleranceUpperLimit = 0.002
    dimObj.ToleranceLowerLimit = 0.001
    'dimObj.ToleranceSuppressLeadingZeros = True
    'dimObj.ToleranceSuppressZeroInches = True
    'dimObj.ToleranceSuppressZeroFeet = True
    'dimObj.ExtLine1Suppress = True
    'dimObj.Arrowhead1Type = acArrowOpen90
    dimObj.Fit = acArrowsOnly
   
    ThisDrawing.Regen acActiveViewport
   
    'MsgBox "覆盖的尺寸标注值：" & dimObj.TextOverride
   
    'MsgBox "箭头块名为：" & dimObj.Arrowhead1Block
   
End Sub

Public Sub UseDimRotated()
    'AutoCAD的Linear标注，在ActiveX中归属于AcDbRotatedDimension类型
    '即都归在DimRotated对象中
   
    Dim dimObj As AcadDimRotated            '声明旋转尺寸标注对象变量
    Dim point1 As Variant
    Dim point2 As Variant
    Dim location As Variant
    Dim rotAngle As Double
   
    point1 = ThisDrawing.Utility.GetPoint(, "选择第1个界线原点： ")
    point2 = ThisDrawing.Utility.GetPoint(point1, "选择第2个界线原点： ")
    location = ThisDrawing.Utility.GetPoint(point2, "选择标注文字位置： ")
    rotAngle = ThisDrawing.Utility.GetReal("选择旋转角度： ")
    rotAngle = rotAngle * 3.141592 / 180#       '将输入的角度转化为弧度
   
    ' Create the rotated dimension in model space
    Set dimObj = ThisDrawing.ModelSpace.AddDimRotated _
                 (point1, point2, location, rotAngle)
   
    'ZoomAll

    '将十进制小数点符号由默认的“,”该为“.”
    dimObj.DecimalSeparator = "."
    dimObj.ArrowheadSize = 8
    dimObj.TextHeight = 7
    dimObj.TextGap = 2.5
    dimObj.ExtensionLineExtend = 3
    dimObj.ExtensionLineOffset = 5
    'dimObj.ToleranceHeightScale = 0.5
    'dimObj.ToleranceJustification = acTolBottom
    'dimObj.ToleranceDisplay = acTolDeviation
    'dimObj.ToleranceUpperLimit = 0.002
    'dimObj.ToleranceLowerLimit = 0.001
   
    'ThisDrawing.Regen True
   
    'MsgBox "尺寸标注为：" & dimObj.Measurement
   
End Sub

gzhycsu

假如标注多条线，而有三种标注样式，每次标注后都要对标注的属性修改吗  能不能直接定义标注样式呢？