[例程]使用尺寸--几何公差
Public Sub CreateTolereance()'用3个点创建标注引线
Dim leaderObj As AcadLeader
Dim points(0 To 8) As Double
Dim xPnt As Variant, I As Integer
Dim leaderType As Integer
Dim annotationObject 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
'-----------------------------------------------
'创建几何公差标注的主体
Dim tolObj As AcadTolerance
Dim txtStr As String
'Dim insPnt(0 To 2) As Double
Dim direction(0 To 2) As Double
'insPnt = ThisDrawing.Utility.GetPoint(, "选择插入点：")
'确定插入点
'insPnt(0) = 100: insPnt(1) = 180: insPnt(2) = 0
'定义几何公差的标注文字
txtStr = "{\Fgdt;r}%%v{\Fgdt;n}0.12{\Fgdt;l}%%v%%vA" & _
"{\Fgdt;m}%%vB{\Fgdt;l}%%vC{\Fgdt;s}"
'确定标注文字的显示方向为平行于X轴方向
direction(0) = 1
direction(1) = 0
direction(2) = 0
'在模型空间创建几何公差标注对象
Set tolObj = ThisDrawing.ModelSpace. _
AddTolerance(txtStr, xPnt, direction)
'定义标注文字的高度
tolObj.TextHeight = 7
'------------------------------------------------
'使用几何公差对象来创建标注引线
Set leaderObj = ThisDrawing.ModelSpace.AddLeader _
(points, tolObj, leaderType)
'定义引线的的箭头尺寸
leaderObj.ArrowheadSize = 5
'ZoomAll
'Dim newDirection As Variant
'newDirection = ThisDrawing.Utility.GetPoint(xPnt, "选择新的方向：")
'tolObj.DirectionVector = newDirection
End Sub
Public Sub CreateSymbole()
Dim tolObj As AcadObject
Dim txtStr As String
Dim insPnt(0 To 2) As Double
Dim direction(0 To 2) As Double
Dim I As Integer
direction(0) = 1
direction(1) = 0
direction(2) = 0
insPnt(0) = 100
insPnt(2) = 0
insPnt(1) = 280
txtStr = "{\Fgdt;j}"
Set tolObj = ThisDrawing.ModelSpace. _
AddTolerance(txtStr, insPnt, direction)
tolObj.TextHeight = 7
insPnt(1) = 280 - 13
txtStr = "{\Fgdt;r}"
Set tolObj = ThisDrawing.ModelSpace. _
AddTolerance(txtStr, insPnt, direction)
tolObj.TextHeight = 7
insPnt(1) = 280 - 2 * 13
txtStr = "{\Fgdt;i}"
Set tolObj = ThisDrawing.ModelSpace. _
AddTolerance(txtStr, insPnt, direction)
tolObj.TextHeight = 7
insPnt(1) = 280 - 3 * 13
txtStr = "{\Fgdt;f}"
Set tolObj = ThisDrawing.ModelSpace. _
AddTolerance(txtStr, insPnt, direction)
tolObj.TextHeight = 7
insPnt(1) = 280 - 4 * 13
txtStr = "{\Fgdt;b}"
Set tolObj = ThisDrawing.ModelSpace. _
AddTolerance(txtStr, insPnt, direction)
tolObj.TextHeight = 7
insPnt(1) = 280 - 5 * 13
txtStr = "{\Fgdt;a}"
Set tolObj = ThisDrawing.ModelSpace. _
AddTolerance(txtStr, insPnt, direction)
tolObj.TextHeight = 7
insPnt(1) = 280 - 6 * 13
txtStr = "{\Fgdt;g}"
Set tolObj = ThisDrawing.ModelSpace. _
AddTolerance(txtStr, insPnt, direction)
tolObj.TextHeight = 7
insPnt(1) = 280 - 7 * 13
txtStr = "{\Fgdt;c}"
Set tolObj = ThisDrawing.ModelSpace. _
AddTolerance(txtStr, insPnt, direction)
tolObj.TextHeight = 7
insPnt(1) = 280 - 8 * 13
txtStr = "{\Fgdt;e}"
Set tolObj = ThisDrawing.ModelSpace. _
AddTolerance(txtStr, insPnt, direction)
tolObj.TextHeight = 7
insPnt(1) = 280 - 9 * 13
txtStr = "{\Fgdt;u}"
Set tolObj = ThisDrawing.ModelSpace. _
AddTolerance(txtStr, insPnt, direction)
tolObj.TextHeight = 7
insPnt(1) = 280 - 10 * 13
txtStr = "{\Fgdt;d}"
Set tolObj = ThisDrawing.ModelSpace. _
AddTolerance(txtStr, insPnt, direction)
tolObj.TextHeight = 7
insPnt(1) = 280 - 11 * 13
txtStr = "{\Fgdt;k}"
Set tolObj = ThisDrawing.ModelSpace. _
AddTolerance(txtStr, insPnt, direction)
tolObj.TextHeight = 7
insPnt(1) = 280 - 12 * 13
txtStr = "{\Fgdt;h}"
Set tolObj = ThisDrawing.ModelSpace. _
AddTolerance(txtStr, insPnt, direction)
tolObj.TextHeight = 7
insPnt(1) = 280 - 13 * 13
txtStr = "{\Fgdt;t}"
Set tolObj = ThisDrawing.ModelSpace. _
AddTolerance(txtStr, insPnt, direction)
tolObj.TextHeight = 7
insPnt(1) = 280 - 14 * 13
txtStr = "{\Fgdt;n}"
Set tolObj = ThisDrawing.ModelSpace. _
AddTolerance(txtStr, insPnt, direction)
tolObj.TextHeight = 7
End Sub
Public Sub ModifyDirection()
Dim tolObj As AcadTolerance
Dim pickPnt As Variant
Dim curDirection As Variant
Dim newDirection(0 To 2) As Double
'选择几何公差标注对象
ThisDrawing.Utility.GetEntity tolObj, pickPnt
'获得当前几何公差标注的方向矢量
curDirection = tolObj.DirectionVector
'选择新的方向矢量
On Error Resume Next
newDirection(0) = ThisDrawing.Utility.GetReal("选择X方向分量： ")
newDirection(1) = ThisDrawing.Utility.GetReal("选择Y方向分量： ")
newDirection(2) = ThisDrawing.Utility.GetReal("选择Z方向分量： ")
If Err <> 0 Then '如果没有选择新的方向矢量
tolObj.DirectionVector = curDirection
Else '如果选择了新的方向矢量
tolObj.DirectionVector = newDirection
End If
tolObj.Update
End Sub 吃透mccad的好东东,肯定是高手.
页:
[1]