|
|
我试做的一个粗糙度标注，有几个问题，1，不能附着在直线上，人家做的能附着，且拖出直线时会添加一条线，很方便。2，旋转时，当转到下方时，属性会倒放。我也做不起。
Public Sub ccd()
Dim blockobj As AcadBlock
Dim pt1(0 To 2) As Double '块的插入点，指定块上的一点，就是符号下面的交点
产品图.ccd.show
RETRY:
If Err 0 Then
Err.Clear
Exit Sub
End If
Dim I As Integer
For I = 0 To ThisDrawing.Blocks.Count - 1
Set blockobj = ThisDrawing.Block
If blockobj.Name = "ccdname" Then
GoTo fff
End If
Next I
pt1(0) = 0: pt1(1) = 0: pt1(2) = 0
Set blockobj = ThisDrawing.Blocks.add(pt1, "ccdname") '创建块
Dim lineobj As AcadLine '块中要画的直线
Dim startpt(0 To 2) As Double '画线要用的点
Dim endpt(0 To 2) As Double '
Dim dimscal As Double '这个变量用于存放标注的缩放比例
Dim height As Double '块属性的高度
Dim mode As Long '模式
Dim prompt As String '提示
Dim tag As String '标志
Dim value As String '值
Dim insertPt(0 To 2) As Double
dimscal = ActiveDocument.GetVariable("DIMSCALE") '
startpt(0) = -2.8: startpt(1) = 4.8: startpt(2) = 0
endpt(0) = 2.8: endpt(1) = 4.8: endpt(2) = 0
'横线
Set lineobj = blockobj.AddLine(startpt, endpt) '
endpt(0) = 0: endpt(1) = 0: endpt(2) = 0
Set lineobj = blockobj.AddLine(startpt, endpt) '
startpt(0) = 5.6 * dimscal: startpt(1) = 9.6 * dimscal: startpt(2) = 0
Set lineobj = blockobj.AddLine(startpt, endpt) '
'acHorizontalAlignmentLeft 水平左对齐acHorizontalAlignmentCenter 水平中间对齐acHorizontalAlignmentRight水平右对齐
'acHorizontalAlignmentAligned水平分散对齐acHorizontalAlignmentMiddle居中acHorizontalAlignmentFit合适的
'acVerticalAlignmentBaseline垂直基于底线acVerticalAlignmentBottom底部acVerticalAlignmentMiddle中间acVerticalAlignmentTop顶部
Dim attributeObj As AcadAttribute
height = 3.5
mode = acAttributeModeVerify
prompt = "粗糙度"
insertPt(0) = 2: insertPt(1) = 3: insertPt(2) = 0
tag = "粗糙度"
value = ccdz
Set attributeObj = blockobj.AddAttribute(height, mode, prompt, insertPt, tag, value)
'acAttributeModeInvisible,不可见的；acAttributeModeConstant，常量；acAttributeModeVerify，要验证的；acAttributeModePreset预先设定的
'
attributeObj.HorizontalAlignment = acHorizontalAlignmentRight
attributeObj.VerticalAlignment = acVerticalAlignmentBottom
fff:
Dim pt2 As Variant
Dim angle As Double
pt2 = ThisDrawing.Utility.GetPoint(, "选择插入点")
Dim blockRefObj As AcadBlockReference
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(pt2, "ccdname", dimscal, dimscal, dimscal, 0)
angle = ThisDrawing.Utility.GetAngle(pt2, "选择插入的角度")
blockRefObj.Rotate = angle
GoTo RETRY
End Sub |
|
置顶卡
