《辅助设计学习笔记.docx》由会员分享，可在线阅读，更多相关《辅助设计学习笔记.docx（2页珍藏版）》请在三一文库上搜索。
1、学习好资料欢迎下载添加第一个类AddTextPublic Function AddText(ByValtextString As String, ByValinsertString As Variant, ByVal height AsDouble) As AcadTextDebug.Assert (VarType(insertPoint) = vbArray + vbDouble)Debug.Assert (UBound(insertPoint) = 2)Set AddText = ThisDrawing.ModelSpace.AddText(insertPoint, Width, text
2、String)End Function添加第二个类AddMTextPublic Function AddMText(ByValinsertPoint As Variant, ByVal Width As Double, ByValtextString AsString) As AcadMTextDebug.Assert (VarType(insertPoint) = vbArray + vbDouble)Debug.Assert (UBound(insertPoint) = 2)Set AddMText = ThisDrawing.ModelSpace.AddMText(insertPoint
3、, Width, textString)End Function添加第三个类AddTextInRectanglePublic Function AddTextInRectangle(ByVal point1 As Variant, ByVal point2 As Variant,ByValtextString As String, Optional ratio As Double = 0.7) As AcadTextDebug.Assert (VarType(point1) = vbArray + vbDouble)Debug.Assert (UBound(point1) = 2)Debug.
4、Assert (VarType(point2) = vbArray + vbDouble)Debug.Assert (UBound(point2) = 2)计算矩形的宽、高和中心点Dim rectHeight As Double, rectWidth As Double, centerPoint As VariantrectHeight = Abs(point1(1) - point2(1)rectWidth = Abs(point1(0) - point2(0)centerPoint = Math.GetMiddlePointBetween2Point(point1, point2)创建文字
5、，计算其高宽比Dim text As AcadTextSet text = AddText(textString, centerPoint, rectHeight)Dim minPoint As Variant, maxPoint As Varianttext.GetBoundingBoxminPoint, maxPointDim textHeight As Double, TextWidthAs DoubletextHeight = Abs(minPoint(1) - maxPoint)TextWidth = Abs(minPoint(0) - maxPoint(0)根据矩形的宽、高和文字的
6、容纳比例确定文字的高或宽Dim heightRatio As DoubleheightRatio = textHeight / TextWidthIf (heightRatio rectHeight / rectWidth) Then textHeight = rectHeight * ratioElseTextWidth = rectWidth * ratiotextHeight = TextWidth * heightRatioEnd If缩放和移动文字text.Alignment = acAlignmentBottomCentertext.AlignmentPoint = centerP
7、ointtext.height = textHeightSet AddTextInRectangle = textEnd Function主函数程序：Public Sub CreateText()Dim point1(0 To 2) As Double, point2(0 To 2) As DoubleSetPoint3d pointl, 0, 0, 0SetPoint3d point2, 20, 5, 0Dim mSpace As New clsModelSpacemSpace.AddTextInRectangle pointl, point2, cadhelpmSpace.AddRectangle pointl, point2End Sub