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