[例程]使用尺寸--线性标注
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
[讨论]
假如标注多条线，而有三种标注样式，每次标注后都要对标注的属性修改吗能不能直接定义标注样式呢？
页:
[1]