|
|
Public Sub CreateLeader()
ThisDrawing.ActiveTextStyle.fontFile = "c:\windows\fonts\simsun.ttf"
Dim leaderObj As AcadLeader
Dim points(0 To 8) As Double
Dim xPnt As Variant, I As Integer
Dim leaderType As Integer
Dim annotation As AcadObject
'选择用来确定引线的点数组
xPnt = ThisDrawing.Utility.GetPoint(, " 选择第 1个点： ")
points(0) = xPnt(0): points(1) = xPnt(1): points(2) = xPnt(2)
For I = 1 To 2
xPnt = ThisDrawing.Utility.GetPoint _
(xPnt, "选择第" & I + 1 & "点： ")
points(3 * I) = xPnt(0)
points(3 * I + 1) = xPnt(1)
points(3 * I + 2) = xPnt(2)
Next
'定义引线的形式
leaderType = acLineWithArrow '带箭头的直线段
'leaderType = acSplineWithArrow
'不使用标注注释
'Set annotation = Nothing
'在模型空间创建引线标注
Set leaderObj = ThisDrawing.ModelSpace.AddLeader _
(points, annotation, leaderType)
'---------------------------------------------------------
Dim mtxtObj As AcadMText
Dim Width As Double
Dim mtxtStr As String
Dim inspnt1(0 To 2) As Double
Dim inspnt2 As Variant
'确定多行文字的书写宽度
Width = ThisDrawing.Utility.GetReal("选择文字书写宽度: ")
'从的命令行输入文字
mtxtStr = ThisDrawing.Utility.GetString(True, "输入标注文字: ")
'On Error Resume Next
'inspnt2 = ThisDrawing.Utility.GetPoint(xPnt, "选择文字插入点：")
'If Err 0 Then
' inspnt1(0) = xPnt(0): inspnt1(1) = xPnt(1) + 3.5: inspnt1(2) = xPnt(2)
' Set mtxtObj = ThisDrawing.ModelSpace.AddMText(inspnt1, Width, mtxtStr)
'Else
' Set mtxtObj = ThisDrawing.ModelSpace.AddMText(inspnt2, Width, mtxtStr)
'End If
'mtxtObj.Height = 7
'创建多行文字对象
'Dim insertPnt(0 To 2) As Double
'insertPnt(0) = xPnt(0): insertPnt(1) = xPnt(1) + 3.5: insertPnt(2) = xPnt(2)
xPnt(1) = xPnt(1) + 3.5
Set annotation = ThisDrawing.ModelSpace.AddMText _
(xPnt, Width, mtxtStr)
'设置多行文字的高度
annotation.Height = 7
'insPnt = annotation.insertionPoint
'insPnt(1) = insPnt(1) + 3.5
'annotation.insertionPoint = insPnt
'ZoomAll
'-----------------------------------------------------------
'leaderObj.ArrowheadType = acArrowOpen
'leaderObj.TextGap = 3
'leaderObj.TextHeight = 7 不支持该属性
leaderObj.ArrowheadSize = 10 '设置箭头的尺寸
'leaderObj.VerticalTextPosition = acVertCentered
End Sub |
|
置顶卡
