CAD 线性标注 vba

Sub KUANGAOBZ()
    Dim D(0 To 2) As Double
    Dim YD(0 To 2) As Double
    Dim ZD(0 To 2) As Double '极坐标半径中点
    Dim ptText&, ptText1&
    ptText = KuanTB.text
    D(0) = Val(TextBox5.text): D(1) = Val(TextBox6.text) - Val(GaoTB.text) - 200: D(2) = 0
    YD(0) = Val(TextBox5.text) + Val(KuanTB.text): YD(1) = Val(TextBox6.text) - Val(GaoTB.text) - 200: YD(2) = 0
     '计算中点坐标
    ZD(0) = (D(0) + YD(0)) / 2
    ZD(1) = (D(1) + YD(1)) / 2
    ZD(2) = (D(2) + YD(2)) / 2
   AddDimRotatedCTxt D, YD, ZD, 0
     Dim D1(0 To 2) As Double
    Dim YD1(0 To 2) As Double
    Dim ZD1(0 To 2) As Double '极坐标半径中点

ptText1 = GaoTB.text
    D1(0) = Val(TextBox5.text) + Val(KuanTB.text) + 200: D1(1) = Val(TextBox6.text) - Val(GaoTB.text): D1(2) = 0
    YD1(0) = Val(TextBox5.text) + Val(KuanTB.text) + 200: YD1(1) = Val(TextBox6.text): YD1(2) = 0
     '计算中点坐标
    ZD1(0) = (D1(0) + YD1(0)) / 2
    ZD1(1) = (D1(1) + YD1(1)) / 2
    ZD1(2) = (D1(2) + YD1(2)) / 2
   AddDimRotatedCTxt D1, YD1, ZD1, 90 * 3.141592 / 180#
   
End Sub
Public Function AddDimRotated(ByVal pt1 As Variant, ByVal pt2 As Variant, ByVal pt3 As Variant, ByVal pt4 As Variant) As AcadDimAligned
    Set AdimObj = ThisDrawing.ModelSpace.AddDimRotated(pt1, pt2, pt3, pt4)
      AdimObj.color = acGreen '标注颜色
      AdimObj.ArrowheadSize = 50 '标注箭头、引线箭头和钩线的尺寸
      AdimObj.TextHeight = 120 '指定标注或公差的文字高度
      AdimObj.ExtensionLineExtend= 50 '尺寸界线超出尺寸线的距离。
      AdimObj.ExtensionLineOffset = 100 '尺寸界线偏移起点的距离
End Function
Public Function AddDimRotatedCTxt(ByVal pt1 As Variant, ByVal pt2 As Variant, ByVal pt3 As Variant, ByVal pt4 As Variant) As AcadDimAligned
    Dim dimObj As AcadDimRotated
    Set dimObj = AddDimRotated(pt1, pt2, pt3, pt4)
End Function

*--------------------------------------------------------

 

 

'Sub biaozhu()
' Dim dimObj As AcadDimRotated
'Set dimObj = ThisDrawing.ModelSpace.AddDimRotated(D, YD, ZD, 0)
'       dimObj.color = acGreen '标注颜色
'       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
'End Sub

*--------------------------------

'Sub Example_AddDimRotated()
'    ' 该示例在模型空间中创建水平和垂直标注。
'    Dim LineObj As AcadLine
'    Dim point1(0 To 2) As Double
'    Dim point2(0 To 2) As Double
'    Dim location(0 To 2) As Double
'    Dim rotAngle As Double
'    ' 定义标注
'    point1(0) = 0#: point1(1) = 0#: point1(2) = 0#
'    point2(0) = 5#: point2(1) = 5#: point2(2) = 0#
'    location(0) = 0#: location(1) = 0#: location(2) = 0#
'    '绘制直线
'    Set LineObj = ThisDrawing.ModelSpace.AddLine(point1, point2)
'    LineObj.color = acRed
'    ' 在模型空间中创建水平标注
'    rotAngle = 0
'    rotAngle = rotAngle * 3.141592 / 180#       ' 转换为弧度
'    Set dimObj = ThisDrawing.ModelSpace.AddDimRotated(point1, point2, location, rotAngle)
'    dimObj.color = acGreen
'    ' 在模型空间中创建垂直标注
'    rotAngle = 90
'    rotAngle = rotAngle * 3.141592 / 180#        ' 转换为弧度
'    Set dimObj = ThisDrawing.ModelSpace.AddDimRotated(point1, point2, location, rotAngle)
'    dimObj.color = acGreen
'    ThisDrawing.Application.ZoomExtents
'End Sub